diff options
| author | Michel Mauny <Michel.Mauny@ensta.fr> | 2004-05-19 11:06:51 +0000 |
|---|---|---|
| committer | Michel Mauny <Michel.Mauny@ensta.fr> | 2004-05-19 11:06:51 +0000 |
| commit | 47f4e123f0c00e79b58fc03a5b40037dc036ff48 (patch) | |
| tree | e30d7c5827767768b50203292107d549584a8c2d /camlp4/ocaml_src | |
| parent | 11570e23a3bfb07466b679b3a31d2c2f68d4a7ec (diff) | |
Fixed bug #2027
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@6309 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
Diffstat (limited to 'camlp4/ocaml_src')
| -rw-r--r-- | camlp4/ocaml_src/camlp4/ast2pt.ml | 31 |
1 files changed, 21 insertions, 10 deletions
diff --git a/camlp4/ocaml_src/camlp4/ast2pt.ml b/camlp4/ocaml_src/camlp4/ast2pt.ml index d3eb318e8..6866b5bde 100644 --- a/camlp4/ocaml_src/camlp4/ast2pt.ml +++ b/camlp4/ocaml_src/camlp4/ast2pt.ml @@ -131,19 +131,30 @@ let rec ctyp_fa al = | f -> f, al ;; -let rec ctyp_long_id = - function +let rec ctyp_long_id_prefix t = + match t with TyAcc (_, m, TyLid (_, s)) -> - let (is_cls, li) = ctyp_long_id m in is_cls, ldot li s + error (loc_of_ctyp t) "invalid path element in type name" | TyAcc (_, m, TyUid (_, s)) -> - let (is_cls, li) = ctyp_long_id m in is_cls, ldot li s + let (is_cls, li) = ctyp_long_id_prefix m in is_cls, ldot li s | TyApp (_, m1, m2) -> - let (is_cls, li1) = ctyp_long_id m1 in - let (_, li2) = ctyp_long_id m2 in is_cls, Lapply (li1, li2) + error (loc_of_ctyp t) "invalid path element in type name" | TyUid (_, s) -> false, lident s + | TyLid (_, s) -> error (loc_of_ctyp t) "invalid path element in type name" + | t -> error (loc_of_ctyp t) "invalid type" +;; + +let ctyp_long_id t = + match t with + TyAcc (_, m, TyLid (_, s)) -> + let (is_cls, li) = ctyp_long_id_prefix m in is_cls, ldot li s + | TyAcc (_, m, (TyUid (_, s) as t)) -> + error (loc_of_ctyp t) "type names cannot be capitalized" + | TyApp (_, m1, m2) -> error (loc_of_ctyp t) "expecting a type name" + | TyUid (_, s) -> error (loc_of_ctyp t) "type names cannot be capitalized" | TyLid (_, s) -> false, lident s | TyCls (loc, sl) -> true, long_id_of_string_list loc sl - | t -> error (loc_of_ctyp t) "incorrect type" + | t -> error (loc_of_ctyp t) "invalid type" ;; let rec ctyp = @@ -157,7 +168,7 @@ let rec ctyp = match t1, t2 with t, TyQuo (_, s) -> t, s | TyQuo (_, s), t -> t, s - | _ -> error loc "incorrect alias type" + | _ -> error loc "invalid alias type" in mktyp loc (Ptyp_alias (ctyp t, i)) | TyAny loc -> mktyp loc Ptyp_any @@ -184,7 +195,7 @@ let rec ctyp = | TyRec (loc, _, _) -> error loc "record type not allowed here" | TySum (loc, _, _) -> error loc "sum type not allowed here" | TyTup (loc, tl) -> mktyp loc (Ptyp_tuple (List.map ctyp tl)) - | TyUid (loc, s) -> mktyp loc (Ptyp_constr (lident s, [])) + | TyUid (loc, s) as t -> error (loc_of_ctyp t) "invalid type" | TyVrn (loc, catl, ool) -> let catl = List.map @@ -397,7 +408,7 @@ let rec patt = match p1, p2 with p, PaLid (_, s) -> p, s | PaLid (_, s), p -> p, s - | _ -> error loc "incorrect alias pattern" + | _ -> error loc "invalid alias pattern" in mkpat loc (Ppat_alias (patt p, i)) | PaAnt (_, p) -> patt p |