[camlp4] Merge 3.10 on trunk for camlp4/Camlp4Parsers

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

6 files changed, 86 insertions, 47 deletions

diff --git a/camlp4/Camlp4Parsers/Camlp4ListComprehension.ml b/camlp4/Camlp4Parsers/Camlp4ListComprehension.ml
index e74e734fc..39eccc2fd 100644
--- a/camlp4/Camlp4Parsers/Camlp4ListComprehension.ml
+++ b/camlp4/Camlp4Parsers/Camlp4ListComprehension.ml
@@ -49,7 +49,7 @@ module Make (Syntax : Sig.Camlp4Syntax) = struct
               skip_patt (ignore_upto ")" (n + 1) + 1)
           | Some (KEYWORD "{") -> 
               skip_patt (ignore_upto "}" (n + 1) + 1)
-          | Some (KEYWORD ("as" | "::" | ";" | "," | "_"))
+          | Some (KEYWORD ("as" | "::" | "," | "_"))
           | Some (LIDENT _ | UIDENT _) -> skip_patt (n + 1)
           | Some _ | None -> raise Stream.Failure ]
         and ignore_upto end_kwd n =
diff --git a/camlp4/Camlp4Parsers/Camlp4MacroParser.ml b/camlp4/Camlp4Parsers/Camlp4MacroParser.ml
index 33594fefb..f1cbe2679 100644
--- a/camlp4/Camlp4Parsers/Camlp4MacroParser.ml
+++ b/camlp4/Camlp4Parsers/Camlp4MacroParser.ml
@@ -139,7 +139,8 @@ module Make (Syntax : Sig.Camlp4Syntax) = struct
 
   class reloc _loc = object
     inherit Ast.map as super;
-    method _Loc_t _ = _loc;
+    method loc _ = _loc;
+    (* method _Loc_t _ = _loc; *)
   end;
 
   class subst _loc env = object
diff --git a/camlp4/Camlp4Parsers/Camlp4OCamlParser.ml b/camlp4/Camlp4Parsers/Camlp4OCamlParser.ml
index 9dba583f8..6b9380e24 100644
--- a/camlp4/Camlp4Parsers/Camlp4OCamlParser.ml
+++ b/camlp4/Camlp4Parsers/Camlp4OCamlParser.ml
@@ -198,7 +198,7 @@ module Make (Syntax : Sig.Camlp4Syntax) = struct
   DELETE_RULE Gram value_val: "value" END;
   DELETE_RULE Gram str_item: value_let; opt_rec; binding END;
   DELETE_RULE Gram module_type: "'"; a_ident END;
-  DELETE_RULE Gram module_type: SELF; SELF END;
+  DELETE_RULE Gram module_type: SELF; SELF; dummy END;
   DELETE_RULE Gram module_type: SELF; "."; SELF END;
   DELETE_RULE Gram label_expr: label_longident; fun_binding END;
   DELETE_RULE Gram expr: "let"; opt_rec; binding; "in"; SELF END;
@@ -244,6 +244,7 @@ module Make (Syntax : Sig.Camlp4Syntax) = struct
   clear star_ctyp;
   clear match_case;
   clear with_constr;
+  clear top_phrase;
 
   EXTEND Gram
     GLOBAL:
@@ -405,6 +406,7 @@ module Make (Syntax : Sig.Camlp4Syntax) = struct
         [ `ANTIQUOT (""|"pat"|"anti" as n) s ->
             <:patt< $anti:mk_anti ~c:"patt" n s$ >>
         | `ANTIQUOT ("tup" as n) s -> <:patt< ($tup:<:patt< $anti:mk_anti ~c:"patt" n s$ >>$) >>
+        | `ANTIQUOT ("`bool" as n) s -> <:patt< $anti:mk_anti n s$ >>
         | `QUOTATION x -> Quotation.expand _loc x Quotation.DynAst.patt_tag
         | i = ident -> <:patt< $id:i$ >>
         | s = a_INT -> <:patt< $int:s$ >>
@@ -607,6 +609,12 @@ module Make (Syntax : Sig.Camlp4Syntax) = struct
         | "{"; t = label_declaration; "}" ->
             <:ctyp< { $t$ } >> ] ]
     ;
+    module_expr: LEVEL "apply"
+      [ [ i = SELF; "("; j = SELF; ")" -> <:module_expr< $i$ $j$ >> ] ]
+    ;
+    ident_quot: LEVEL "apply"
+      [ [ i = SELF; "("; j = SELF; ")" -> <:ident< $i$ $j$ >> ] ]
+    ;
     module_longident_with_app: LEVEL "apply"
       [ [ i = SELF; "("; j = SELF; ")" -> <:ident< $i$ $j$ >> ] ]
     ;
@@ -682,10 +690,22 @@ module Make (Syntax : Sig.Camlp4Syntax) = struct
         | `UIDENT s -> s
       ] ]
     ;
+    top_phrase:
+      [ [ "#"; n = a_LIDENT; dp = opt_expr; ";;" ->
+            Some <:str_item< # $n$ $dp$ >>
+        | l = LIST1 str_item; ";;" -> Some (Ast.stSem_of_list l)
+        | `EOI -> None
+      ] ]
+    ;
   END;
 
   (* Some other DELETE_RULE are before the grammar *)
+  DELETE_RULE Gram module_longident_with_app: "("; SELF; ")" END;
+  DELETE_RULE Gram type_longident: "("; SELF; ")" END;
+  DELETE_RULE Gram ident_quot: "("; SELF; ")" END;
   DELETE_RULE Gram module_longident_with_app: SELF; SELF END;
   DELETE_RULE Gram type_longident: SELF; SELF END;
+  DELETE_RULE Gram ident_quot: SELF; SELF END;
+  DELETE_RULE Gram module_expr: SELF; SELF END;
 end;
 let module M = Register.OCamlSyntaxExtension Id Make in ();
diff --git a/camlp4/Camlp4Parsers/Camlp4OCamlRevisedParser.ml b/camlp4/Camlp4Parsers/Camlp4OCamlRevisedParser.ml
index 23fc58f1f..74583cbd2 100644
--- a/camlp4/Camlp4Parsers/Camlp4OCamlRevisedParser.ml
+++ b/camlp4/Camlp4Parsers/Camlp4OCamlRevisedParser.ml
@@ -19,7 +19,7 @@ open Camlp4;                                        (* -*- camlp4r -*- *)
  *)
 
 module Id = struct
-  value name = "Camlp4RevisedParserParser";
+  value name = "Camlp4RevisedParser";
   value version = "$Id$";
 end;
 
@@ -375,6 +375,19 @@ Very old (no more supported) syntax:
         <:expr< $lid:x$ >>)
   ;
 
+  value rec infix_kwds_filter =
+    parser
+    [ [: `((KEYWORD "(", _) as tok); xs :] ->
+        match xs with parser
+        [ [: `(KEYWORD ("mod"|"land"|"lor"|"lxor"|"lsl"|"lsr"|"asr" as i), _loc);
+             `(KEYWORD ")", _); xs :] ->
+                [: `(LIDENT i, _loc); infix_kwds_filter xs :]
+        | [: xs :] ->
+                [: `tok; infix_kwds_filter xs :] ]
+    | [: `x; xs :] -> [: `x; infix_kwds_filter xs :] ];
+
+  Token.Filter.define_filter (Gram.get_filter ())
+    (fun f strm -> infix_kwds_filter (f strm));
 
   (* transmit the context *)
   Gram.Entry.setup_parser sem_expr begin
@@ -426,12 +439,14 @@ Very old (no more supported) syntax:
       use_file val_longident value_let value_val with_constr with_constr_quot
       infixop0 infixop1 infixop2 infixop3 infixop4 do_sequence;
     module_expr:
-      [ [ "functor"; "("; i = a_UIDENT; ":"; t = module_type; ")"; "->";
+      [ "top"
+        [ "functor"; "("; i = a_UIDENT; ":"; t = module_type; ")"; "->";
           me = SELF ->
             <:module_expr< functor ( $i$ : $t$ ) -> $me$ >>
         | "struct"; st = str_items; "end" ->
             <:module_expr< struct $st$ end >> ]
-      | [ me1 = SELF; me2 = SELF -> <:module_expr< $me1$ $me2$ >> ]
+      | "apply"
+        [ me1 = SELF; me2 = SELF -> <:module_expr< $me1$ $me2$ >> ]
       | "simple"
         [ `ANTIQUOT (""|"mexp"|"anti"|"list" as n) s ->
             <:module_expr< $anti:mk_anti ~c:"module_expr" n s$ >>
@@ -493,13 +508,18 @@ Very old (no more supported) syntax:
             <:module_binding< $m$ : $mt$ = $me$ >> ] ]
     ;
     module_type:
-      [ [ "functor"; "("; i = a_UIDENT; ":"; t = SELF; ")"; "->"; mt = SELF ->
+      [ "top"
+        [ "functor"; "("; i = a_UIDENT; ":"; t = SELF; ")"; "->"; mt = SELF ->
             <:module_type< functor ( $i$ : $t$ ) -> $mt$ >> ]
-      | [ mt = SELF; "with"; wc = with_constr ->
+      | "with"
+        [ mt = SELF; "with"; wc = with_constr ->
             <:module_type< $mt$ with $wc$ >> ]
-      | [ mt1 = SELF; mt2 = SELF -> module_type_app mt1 mt2 ]
-      | [ mt1 = SELF; "."; mt2 = SELF -> module_type_acc mt1 mt2 ]
-      | [ "sig"; sg = sig_items; "end" ->
+      | "apply"
+        [ mt1 = SELF; mt2 = SELF; dummy -> module_type_app mt1 mt2 ]
+      | "."
+        [ mt1 = SELF; "."; mt2 = SELF -> module_type_acc mt1 mt2 ]
+      | "sig"
+        [ "sig"; sg = sig_items; "end" ->
             <:module_type< sig $sg$ end >> ]
       | "simple"
         [ `ANTIQUOT (""|"mtyp"|"anti"|"list" as n) s ->
@@ -713,13 +733,22 @@ Very old (no more supported) syntax:
     dummy:
       [ [ -> () ] ]
     ;
+    sequence':
+      [ [ -> fun e -> e
+        | ";" -> fun e -> e
+        | ";"; el = sequence -> fun e -> <:expr< $e$; $el$ >> ] ]
+    ;
     sequence:
-      [ [ "let"; rf = opt_rec; bi = binding; [ "in" | ";" ]; el = SELF ->
+      [ [ "let"; rf = opt_rec; bi = binding; "in"; e = expr; k = sequence' ->
+            k <:expr< let $rec:rf$ $bi$ in $e$ >>
+        | "let"; rf = opt_rec; bi = binding; ";"; el = SELF ->
             <:expr< let $rec:rf$ $bi$ in $mksequence _loc el$ >>
+        | "let"; "module"; m = a_UIDENT; mb = module_binding0; "in"; e = expr; k = sequence' ->
+            k <:expr< let module $m$ = $mb$ in $e$ >>
+        | "let"; "module"; m = a_UIDENT; mb = module_binding0; ";"; el = SELF ->
+            <:expr< let module $m$ = $mb$ in $mksequence _loc el$ >>
         | `ANTIQUOT ("list" as n) s -> <:expr< $anti:mk_anti ~c:"expr;" n s$ >>
-        | e = expr; ";"; el = SELF -> <:expr< $e$; $el$ >>
-        | e = expr; ";" -> e
-        | e = expr -> e ] ]
+        | e = expr; k = sequence' -> k e ] ]
     ;
     binding:
       [ LEFTA
@@ -787,16 +816,17 @@ Very old (no more supported) syntax:
         | "->"; e = expr -> e ] ]
     ;
     patt:
-      [ LEFTA
+      [ "|" LEFTA
         [ p1 = SELF; "|"; p2 = SELF -> <:patt< $p1$ | $p2$ >> ]
-      | NONA
+      | ".." NONA
         [ p1 = SELF; ".."; p2 = SELF -> <:patt< $p1$ .. $p2$ >> ]
-      | LEFTA
+      | "apply" LEFTA
         [ p1 = SELF; p2 = SELF -> <:patt< $p1$ $p2$ >> ]
       | "simple"
         [ `ANTIQUOT (""|"pat"|"anti" as n) s ->
             <:patt< $anti:mk_anti ~c:"patt" n s$ >>
         | `ANTIQUOT ("tup" as n) s -> <:patt< ($tup:<:patt< $anti:mk_anti ~c:"patt" n s$ >>$) >>
+        | `ANTIQUOT ("`bool" as n) s -> <:patt< $anti:mk_anti n s$ >>
         | i = ident -> <:patt< $id:i$ >>
         | s = a_INT -> <:patt< $int:s$ >>
         | s = a_INT32 -> <:patt< $int32:s$ >>
@@ -877,6 +907,7 @@ Very old (no more supported) syntax:
             <:patt< $anti:mk_anti ~c:"patt" n s$ >>
         | `ANTIQUOT ("tup" as n) s ->
             <:patt< ($tup:<:patt< $anti:mk_anti ~c:"patt" n s$ >>$) >>
+        | `ANTIQUOT ("`bool" as n) s -> <:patt< $anti:mk_anti n s$ >>
         | `QUOTATION x -> Quotation.expand _loc x Quotation.DynAst.patt_tag
         | "("; ")" -> <:patt< () >>
         | "("; p = SELF; ")" -> p
@@ -948,13 +979,13 @@ Very old (no more supported) syntax:
         | "-"; "'"; i = a_ident -> <:ctyp< -'$lid:i$ >> ] ]
     ;
     ctyp:
-      [ LEFTA
+      [ "==" LEFTA
         [ t1 = SELF; "=="; t2 = SELF -> <:ctyp< $t1$ == $t2$ >> ]
-      | NONA
+      | "private" NONA
         [ "private"; t = ctyp LEVEL "alias" -> <:ctyp< private $t$ >> ]
       | "alias" LEFTA
         [ t1 = SELF; "as"; t2 = SELF -> <:ctyp< $t1$ as $t2$ >> ]
-      | LEFTA
+      | "forall" LEFTA
         [ "!"; t1 = typevars; "."; t2 = ctyp -> <:ctyp< ! $t1$ . $t2$ >> ]
       | "arrow" RIGHTA
         [ t1 = SELF; "->"; t2 = SELF -> <:ctyp< $t1$ -> $t2$ >> ]
@@ -963,12 +994,12 @@ Very old (no more supported) syntax:
         | i = a_LABEL; t =  SELF  -> <:ctyp< ~ $i$ : $t$ >>
         | "?"; i = a_LIDENT; ":"; t = SELF -> <:ctyp< ? $i$ : $t$ >>
         | i = a_OPTLABEL; t = SELF -> <:ctyp< ? $i$ : $t$ >> ]
-      | LEFTA
+      | "apply" LEFTA
         [ t1 = SELF; t2 = SELF ->
             let t = <:ctyp< $t1$ $t2$ >> in
             try <:ctyp< $id:Ast.ident_of_ctyp t$ >>
             with [ Invalid_argument _ -> t ] ]
-      | LEFTA
+      | "." LEFTA
         [ t1 = SELF; "."; t2 = SELF ->
             try <:ctyp< $id:Ast.ident_of_ctyp t1$.$id:Ast.ident_of_ctyp t2$ >>
             with [ Invalid_argument s -> raise (Stream.Error s) ] ]
@@ -1230,7 +1261,7 @@ Very old (no more supported) syntax:
         | "method"; pf = opt_private; l = label; topt = opt_polyt;
           e = fun_binding ->
             <:class_str_item< method $private:pf$ $l$ : $topt$ = $e$ >>
-        | "type"; t1 = ctyp; "="; t2 = ctyp ->
+        | type_constraint; t1 = ctyp; "="; t2 = ctyp ->
             <:class_str_item< type $t1$ = $t2$ >>
         | "initializer"; se = expr -> <:class_str_item< initializer $se$ >> ] ]
     ;
@@ -1326,7 +1357,7 @@ Very old (no more supported) syntax:
             <:rec_binding< $anti:mk_anti ~c:"rec_binding" n s$ >>
         | `ANTIQUOT ("list" as n) s ->
             <:rec_binding< $anti:mk_anti ~c:"rec_binding" n s$ >>
-        | l = label; "="; e = expr -> <:rec_binding< $lid:l$ = $e$ >> ] ]
+        | l = label; "="; e = expr LEVEL "top" -> <:rec_binding< $lid:l$ = $e$ >> ] ]
     ;
     meth_list:
       [ LEFTA
@@ -1654,9 +1685,12 @@ Very old (no more supported) syntax:
       ] ]
     ;
     ident_quot:
-      [ [ i = SELF; j = SELF -> <:ident< $i$ $j$ >> ]
-      | [ i = SELF; "."; j = SELF -> <:ident< $i$.$j$ >> ]
-      | [ `ANTIQUOT (""|"id"|"anti"|"list" as n) s ->
+      [ "apply"
+        [ i = SELF; j = SELF -> <:ident< $i$ $j$ >> ]
+      | "."
+        [ i = SELF; "."; j = SELF -> <:ident< $i$.$j$ >> ]
+      | "simple"
+        [ `ANTIQUOT (""|"id"|"anti"|"list" as n) s ->
             <:ident< $anti:mk_anti ~c:"ident" n s$ >>
         | i = a_UIDENT -> <:ident< $uid:i$ >>
         | i = a_LIDENT -> <:ident< $lid:i$ >>
diff --git a/camlp4/Camlp4Parsers/Camlp4OCamlRevisedParserParser.ml b/camlp4/Camlp4Parsers/Camlp4OCamlRevisedParserParser.ml
index 103519c99..fcd022bd5 100644
--- a/camlp4/Camlp4Parsers/Camlp4OCamlRevisedParserParser.ml
+++ b/camlp4/Camlp4Parsers/Camlp4OCamlRevisedParserParser.ml
@@ -384,24 +384,9 @@ module Make (Syntax : Sig.Camlp4Syntax) = struct
         | se = stream_expr_comp -> [se] ] ]
     ;
     stream_expr_comp:
-      [ [ stream_quot; e = stream_expr -> SeTrm _loc e | e = stream_expr -> SeNtr _loc e ] ]
+      [ [ stream_quot; e = stream_expr -> SeTrm _loc e
+        | e = stream_expr -> SeNtr _loc e ] ]
     ;
-    (*
-    Gram.Entry.clear stream_expr;
-    Gram.Entry.clear stream_expr;
-    stream_expr:
-      [ [ e = expr LEVEL "stream_expr" -> e ] ]
-    ;
-    stream_begin:
-      [ [ "[<" -> () ] ]
-    ;
-    stream_end:
-      [ [ ">]" -> () ] ]
-    ;
-    stream_quot:
-      [ [ "'" -> () ] ]
-    ;
-    *)
   END;
 
 end;
diff --git a/camlp4/Camlp4Parsers/Camlp4QuotationCommon.ml b/camlp4/Camlp4Parsers/Camlp4QuotationCommon.ml
index 28e9bf6bf..2c0861438 100644
--- a/camlp4/Camlp4Parsers/Camlp4QuotationCommon.ml
+++ b/camlp4/Camlp4Parsers/Camlp4QuotationCommon.ml
@@ -23,8 +23,7 @@ module Id = struct
 end;
 
 module Make (Syntax : Sig.Camlp4Syntax)
-            (TheAntiquotSyntax : Sig.AntiquotSyntax
-                                  with module Ast = Sig.Camlp4AstToAst Syntax.Ast)
+            (TheAntiquotSyntax : (Sig.Parser Syntax.Ast).SIMPLE)
 = struct
   open Sig;
   include Syntax; (* Be careful an AntiquotSyntax module appears here *)