From 86f1604d06e5791b2583c9cdc10482186c01994d Mon Sep 17 00:00:00 2001
From: Jacques Le Normand <rathereasy@gmail.com>
Date: Fri, 19 Nov 2010 08:28:32 +0000
Subject: undid all changes to camlp4
git-svn-id: http://caml.inria.fr/svn/ocaml/branches/gadts@10831 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
---
camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml | 17 +++++-----
camlp4/Camlp4Parsers/Camlp4OCamlRevisedParser.ml | 6 ----
camlp4/boot/Camlp4.ml | 32 +++++++++----------
camlp4/boot/camlp4boot.ml | 40 ------------------------
4 files changed, 26 insertions(+), 69 deletions(-)
(limited to 'camlp4')
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
@@ -4948,46 +4948,6 @@ Very old (no more supported) syntax:\n\
(fun (s : 'a_UIDENT) (_loc : Gram.Loc.t) ->
(Ast.TyId (_loc, (Ast.IdUid (_loc, s))) :
'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.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));
--
cgit v1.2.3-70-g09d2