diff options
| author | Jacques Le Normand <rathereasy@gmail.com> | 2010-11-19 08:28:32 +0000 |
|---|---|---|
| committer | Jacques Le Normand <rathereasy@gmail.com> | 2010-11-19 08:28:32 +0000 |
| commit | 86f1604d06e5791b2583c9cdc10482186c01994d (patch) | |
| tree | 2264ef879f8f964186ef8ea9f80edb659cb427d6 /camlp4 | |
| parent | 5a99cea6a3c83b2648e3550a61b2f5ef6d168dc4 (diff) | |
undid all changes to camlp4
git-svn-id: http://caml.inria.fr/svn/ocaml/branches/gadts@10831 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
Diffstat (limited to 'camlp4')
| -rw-r--r-- | camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml | 17 | ||||
| -rw-r--r-- | camlp4/Camlp4Parsers/Camlp4OCamlRevisedParser.ml | 6 | ||||
| -rw-r--r-- | camlp4/boot/Camlp4.ml | 32 | ||||
| -rw-r--r-- | camlp4/boot/camlp4boot.ml | 40 |
4 files changed, 26 insertions, 69 deletions
diff --git a/camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml b/camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml index a2f0239f8..e2008e70d 100644 --- a/camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml +++ b/camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml @@ -322,10 +322,6 @@ module Make (Ast : Sig.Camlp4Ast) = struct [ <:ctyp@loc< $uid:s$ >> -> (conv_con s, [], None, mkloc loc) | <:ctyp@loc< $uid:s$ of $t$ >> -> (conv_con s, List.map ctyp (list_of_ctyp t []), None, mkloc loc) - | <:ctyp@loc< $uid:s$ : $t1$ -> $t2$ >> -> - (conv_con s, List.map ctyp (list_of_ctyp t1 []), Some (ctyp t2),mkloc loc) - | <:ctyp@loc< $uid:s$ : $t$ >> -> - (conv_con s, [], Some (ctyp t), mkloc loc) | _ -> assert False (*FIXME*) ]; value rec type_decl tl cl loc m pflag = fun @@ -380,10 +376,17 @@ module Make (Ast : Sig.Camlp4Ast) = struct value rec type_parameters t acc = match t with [ <:ctyp< $t1$ $t2$ >> -> type_parameters t1 (type_parameters t2 acc) + | <:ctyp< +'$s$ >> -> [(s, (True, False)) :: acc] + | <:ctyp< -'$s$ >> -> [(s, (False, True)) :: acc] + | <:ctyp< '$s$ >> -> [(s, (False, False)) :: acc] + | _ -> assert False ]; + + value rec optional_type_parameters t acc = + match t with + [ <:ctyp< $t1$ $t2$ >> -> optional_type_parameters t1 (optional_type_parameters t2 acc) | <:ctyp< +'$s$ >> -> [(Some s, (True, False)) :: acc] | <:ctyp< -'$s$ >> -> [(Some s, (False, True)) :: acc] | <:ctyp< '$s$ >> -> [(Some s, (False, False)) :: acc] - | <:ctyp< _ >> -> [(None, (True, False)) :: acc] | _ -> assert False ]; value rec class_parameters t acc = @@ -398,7 +401,7 @@ module Make (Ast : Sig.Camlp4Ast) = struct match t with [ <:ctyp< $t1$ $t2$ >> -> type_parameters_and_type_name t1 - (type_parameters t2 acc) + (optional_type_parameters t2 acc) | <:ctyp< $id:i$ >> -> (ident i, acc) | _ -> assert False ]; @@ -850,7 +853,7 @@ module Make (Ast : Sig.Camlp4Ast) = struct (ctyp t1, ctyp t2, mkloc loc)) cl in - [(c, type_decl (List.fold_right type_parameters tl []) cl td) :: acc] + [(c, type_decl (List.fold_right optional_type_parameters tl []) cl td) :: acc] | _ -> assert False ] and module_type = fun diff --git a/camlp4/Camlp4Parsers/Camlp4OCamlRevisedParser.ml b/camlp4/Camlp4Parsers/Camlp4OCamlRevisedParser.ml index f32cf3b1b..fb467d836 100644 --- a/camlp4/Camlp4Parsers/Camlp4OCamlRevisedParser.ml +++ b/camlp4/Camlp4Parsers/Camlp4OCamlRevisedParser.ml @@ -1116,12 +1116,6 @@ Very old (no more supported) syntax:\n\ <:ctyp< $t1$ | $t2$ >> | s = a_UIDENT; "of"; t = constructor_arg_list -> <:ctyp< $uid:s$ of $t$ >> - | s = a_UIDENT; ":"; t = constructor_arg_list ; "->" ; ret = ctyp -> - <:ctyp< $uid:s$ : ($t$ -> $ret$) >> - | s = a_UIDENT; ":"; ret = constructor_arg_list -> - match Ast.list_of_ctyp ret [] with - [ [c] -> <:ctyp< $uid:s$ : $c$ >> - | _ -> raise (Stream.Error "invalid generalized constructor type") ] | s = a_UIDENT -> <:ctyp< $uid:s$ >> ] ] diff --git a/camlp4/boot/Camlp4.ml b/camlp4/boot/Camlp4.ml index 02b53045b..ec79f2117 100644 --- a/camlp4/boot/Camlp4.ml +++ b/camlp4/boot/Camlp4.ml @@ -14551,12 +14551,6 @@ 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)))), - (Ast.TyArr (_, t1, t2))) -> - ((conv_con s), (List.map ctyp (list_of_ctyp t1 [])), - (Some (ctyp t2)), (mkloc loc)) - | Ast.TyCol (loc, (Ast.TyId (_, (Ast.IdUid (_, s)))), t) -> - ((conv_con s), [], (Some (ctyp t)), (mkloc loc)) | _ -> assert false let rec type_decl tl cl loc m pflag = @@ -14618,10 +14612,18 @@ 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.TyAny _ -> (None, (true, false)) :: acc + | Ast.TyQuP (_, s) -> (s, (true, false)) :: acc + | Ast.TyQuM (_, s) -> (s, (false, true)) :: acc + | Ast.TyQuo (_, s) -> (s, (false, false)) :: acc + | _ -> assert false + + let rec optional_type_parameters t acc = + match t with + | Ast.TyApp (_, t1, t2) -> + optional_type_parameters t1 (optional_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 | _ -> assert false let rec class_parameters t acc = @@ -14636,7 +14638,7 @@ module Struct = let rec type_parameters_and_type_name t acc = match t with | Ast.TyApp (_, t1, t2) -> - type_parameters_and_type_name t1 (type_parameters t2 acc) + type_parameters_and_type_name t1 (optional_type_parameters t2 acc) | Ast.TyId (_, i) -> ((ident i), acc) | _ -> assert false @@ -14731,8 +14733,7 @@ module Struct = then mkpat loc (Ppat_construct (li, - (Some (mkpat loc (Ppat_tuple al))), true - )) + (Some (mkpat loc (Ppat_tuple al))), true)) else (let a = match al with @@ -14815,8 +14816,7 @@ module Struct = let is_closed = if wildcards = [] then Closed else Open in mkpat loc - (Ppat_record - (((List.map mklabpat ps), is_closed))) + (Ppat_record (((List.map mklabpat ps), is_closed))) | PaStr (loc, s) -> mkpat loc (Ppat_constant @@ -15208,7 +15208,7 @@ module Struct = cl in (c, - (type_decl (List.fold_right type_parameters tl []) cl td)) :: + (type_decl (List.fold_right optional_type_parameters tl []) cl td)) :: acc | _ -> assert false and module_type = diff --git a/camlp4/boot/camlp4boot.ml b/camlp4/boot/camlp4boot.ml index 08286b69d..20482abcb 100644 --- a/camlp4/boot/camlp4boot.ml +++ b/camlp4/boot/camlp4boot.ml @@ -4951,46 +4951,6 @@ 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 |