undid all changes to camlp4

git-svn-id: http://caml.inria.fr/svn/ocaml/branches/gadts@10831 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

4 files changed, 26 insertions, 69 deletions

diff --git a/camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml b/camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml
index a2f0239f89..e2008e70d1 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 f32cf3b1b2..fb467d8369 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 02b53045bd..ec79f21177 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 08286b69d6..20482abcb5 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