diff options
| author | Jacques Le Normand <rathereasy@gmail.com> | 2010-11-12 11:33:41 +0000 |
|---|---|---|
| committer | Jacques Le Normand <rathereasy@gmail.com> | 2010-11-12 11:33:41 +0000 |
| commit | f24d678e39ac5574b6226f1a6aaa6de9c2ccccc9 (patch) | |
| tree | 2bca8b2d4daeebc3153fbd602b6b4ed398066c60 /camlp4/boot | |
| parent | d2fedeb703120030ff3c204630e1d20e89bf591c (diff) | |
bootstrapped camlp4 gadts extension
git-svn-id: http://caml.inria.fr/svn/ocaml/branches/gadts@10798 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
Diffstat (limited to 'camlp4/boot')
| -rw-r--r-- | camlp4/boot/Camlp4.ml | 32 | ||||
| -rw-r--r-- | camlp4/boot/camlp4boot.ml | 40 |
2 files changed, 54 insertions, 18 deletions
diff --git a/camlp4/boot/Camlp4.ml b/camlp4/boot/Camlp4.ml index 1eab63ebf..5212d8f39 100644 --- a/camlp4/boot/Camlp4.ml +++ b/camlp4/boot/Camlp4.ml @@ -14543,7 +14543,7 @@ module Struct = | Ast.TyCol (loc, (Ast.TyId (_, (Ast.IdLid (_, s)))), t) -> (s, Immutable, (mkpolytype (ctyp t)), (mkloc loc)) | _ -> assert false - + let mkvariant = function | Ast.TyId (loc, (Ast.IdUid (_, s))) -> @@ -14551,13 +14551,13 @@ module Struct = | Ast.TyOf (loc, (Ast.TyId (_, (Ast.IdUid (_, s)))), t) -> ((conv_con s), (List.map ctyp (list_of_ctyp t [])), None, (mkloc loc)) - | Ast.TyCol (loc, (Ast.TyId (_, (Ast.IdUid (_, s)))), TyArr(_,t1,t2)) -> + | Ast.TyCol (loc, (Ast.TyId (_, (Ast.IdUid (_, s)))), + (Ast.TyArr (_, t1, t2))) -> ((conv_con s), (List.map ctyp (list_of_ctyp t1 [])), - Some (ctyp t2),(mkloc loc)) + (Some (ctyp t2)), (mkloc loc)) | Ast.TyCol (loc, (Ast.TyId (_, (Ast.IdUid (_, s)))), t) -> - ((conv_con s), [], Some (ctyp t), - (mkloc loc)) - | _ -> assert false + ((conv_con s), [], (Some (ctyp t)), (mkloc loc)) + | _ -> assert false let rec type_decl tl cl loc m pflag = function @@ -14599,7 +14599,6 @@ module Struct = | Ast.MuMutable -> Mutable | Ast.MuNil -> Immutable | _ -> assert false - let paolab lab p = match (lab, p) with @@ -14619,10 +14618,10 @@ module Struct = match t with | Ast.TyApp (_, t1, t2) -> type_parameters t1 (type_parameters t2 acc) - | Ast.TyQuP (_, s) -> (Some s, (true, false)) :: acc - | Ast.TyQuM (_, s) -> (Some s, (false, true)) :: acc - | Ast.TyQuo (_, s) -> (Some s, (false, false)) :: acc - | Ast.TyNil _ -> (None, (true, false)) :: acc + | Ast.TyQuP (_, s) -> ((Some s), (true, false)) :: acc + | Ast.TyQuM (_, s) -> ((Some s), (false, true)) :: acc + | Ast.TyQuo (_, s) -> ((Some s), (false, false)) :: acc + | Ast.TyAny _ -> (None, (true, false)) :: acc | _ -> assert false let rec class_parameters t acc = @@ -14640,12 +14639,7 @@ module Struct = type_parameters_and_type_name t1 (type_parameters t2 acc) | Ast.TyId (_, i) -> ((ident i), acc) | _ -> assert false - - - - - let mkwithtyp pwith_type loc id_tpl ct = let (id, tpl) = type_parameters_and_type_name id_tpl [] in let (params, variance) = List.split tpl in @@ -14737,7 +14731,8 @@ module Struct = then mkpat loc (Ppat_construct (li, - (Some (mkpat loc (Ppat_tuple al))), true, None)) + (Some (mkpat loc (Ppat_tuple al))), true, + None)) else (let a = match al with @@ -14820,7 +14815,8 @@ module Struct = let is_closed = if wildcards = [] then Closed else Open in mkpat loc - (Ppat_record (((List.map mklabpat ps), is_closed, None))) + (Ppat_record + (((List.map mklabpat ps), is_closed, None))) | PaStr (loc, s) -> mkpat loc (Ppat_constant diff --git a/camlp4/boot/camlp4boot.ml b/camlp4/boot/camlp4boot.ml index 20482abcb..08286b69d 100644 --- a/camlp4/boot/camlp4boot.ml +++ b/camlp4/boot/camlp4boot.ml @@ -4951,6 +4951,46 @@ Very old (no more supported) syntax:\n\ ([ Gram.Snterm (Gram.Entry.obj (a_UIDENT : 'a_UIDENT Gram.Entry.t)); + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj + (constructor_arg_list : + 'constructor_arg_list Gram.Entry.t)) ], + (Gram.Action.mk + (fun (ret : 'constructor_arg_list) _ + (s : 'a_UIDENT) (_loc : Gram.Loc.t) -> + (match Ast.list_of_ctyp ret [] with + | [ c ] -> + Ast.TyCol (_loc, + (Ast.TyId (_loc, + (Ast.IdUid (_loc, s)))), + c) + | _ -> + raise + (Stream.Error + "invalid generalized constructor type") : + 'constructor_declarations)))); + ([ Gram.Snterm + (Gram.Entry.obj + (a_UIDENT : 'a_UIDENT Gram.Entry.t)); + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj + (constructor_arg_list : + 'constructor_arg_list Gram.Entry.t)); + Gram.Skeyword "->"; + Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)) ], + (Gram.Action.mk + (fun (ret : 'ctyp) _ (t : 'constructor_arg_list) + _ (s : 'a_UIDENT) (_loc : Gram.Loc.t) -> + (Ast.TyCol (_loc, + (Ast.TyId (_loc, (Ast.IdUid (_loc, s)))), + (Ast.TyArr (_loc, t, ret))) : + 'constructor_declarations)))); + ([ Gram.Snterm + (Gram.Entry.obj + (a_UIDENT : 'a_UIDENT Gram.Entry.t)); Gram.Skeyword "of"; Gram.Snterm (Gram.Entry.obj |