-

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

camlp4/camlp4/ast2pt.ml

@@ -388,6 +388,12 @@ value rec expr_fa al =
   | f -> (f, al) ]
 ;
 
+value rec class_expr_fa al =
+  fun
+  [ CeApp _ ce a -> class_expr_fa [a :: al] ce
+  | ce -> (ce, al) ]
+;
+
 value rec sep_expr_acc l =
   fun
   [ ExAcc _ e1 e2 -> sep_expr_acc (sep_expr_acc l e2) e1
@@ -665,7 +671,8 @@ and class_sig_item c l =
       [Pctf_virt (s, mkprivate b, ctyp t, mkloc loc) :: l] ]
 and class_expr =
   fun
-  [ CeApp loc ce el ->
+  [ CeApp loc _ _ as c ->
+      let (ce, el) = class_expr_fa [] c in
       let el = List.map label_expr el in
       mkpcl loc (Pcl_apply (class_expr ce) el)
   | CeCon loc id tl ->

camlp4/camlp4/mLast.mli

@@ -161,7 +161,7 @@ and class_sig_item =
   | CgVal of loc and string and bool and ctyp
   | CgVir of loc and string and bool and ctyp ]
 and class_expr =
-  [ CeApp of loc and class_expr and list expr
+  [ CeApp of loc and class_expr and expr
   | CeCon of loc and list string and list ctyp
   | CeFun of loc and patt and class_expr
   | CeLet of loc and bool and list (patt * expr) and class_expr

camlp4/camlp4/reloc.ml

@@ -244,8 +244,7 @@ and class_sig_item floc sh =
 and class_expr floc sh =
   self where rec self =
     fun
-    [ CeApp loc x1 x2 ->
-        CeApp (floc loc) (self x1) (List.map (expr floc sh) x2)
+    [ CeApp loc x1 x2 -> CeApp (floc loc) (self x1) (expr floc sh x2)
     | CeCon loc x1 x2 -> CeCon (floc loc) x1 (List.map (ctyp floc sh) x2)
     | CeFun loc x1 x2 -> CeFun (floc loc) (patt floc sh x1) (self x2)
     | CeLet loc x1 x2 x3 ->

camlp4/etc/pa_o.ml

@@ -928,8 +928,8 @@ EXTEND
         ce = SELF ->
           <:class_expr< let $rec:o2b rf$ $list:lb$ in $ce$ >> ]
     | "apply" NONA
-      [ ce = SELF; sel = LIST1 expr LEVEL "label" ->
-          <:class_expr< $ce$ $list:sel$ >> ]
+      [ ce = SELF; e = expr LEVEL "label" ->
+          <:class_expr< $ce$ $e$ >> ]
     | "simple"
       [ "["; ct = ctyp; ","; ctcl = LIST1 ctyp SEP ","; "]";
         ci = class_longident ->

camlp4/etc/pa_olabl.ml

@@ -1466,8 +1466,8 @@ EXTEND
         ce = SELF ->
           <:class_expr< let $rec:o2b rf$ $list:lb$ in $ce$ >> ]
     | "apply" NONA
-      [ ce = SELF; sel = LIST1 expr LEVEL "label" ->
-          <:class_expr< $ce$ $list:sel$ >> ]
+      [ ce = SELF; e = expr LEVEL "label" ->
+          <:class_expr< $ce$ $e$ >> ]
     | "simple"
       [ "["; ct = ctyp; ","; ctcl = LIST1 ctyp SEP ","; "]";
         ci = class_longident ->

camlp4/etc/pr_depend.ml

@@ -184,7 +184,7 @@ and str_item =
 and type_decl (_, _, t, _) = ctyp t
 and class_expr =
   fun
-  [ CeApp _ ce el -> do { class_expr ce; list expr el; }
+  [ CeApp _ ce e -> do { class_expr ce; expr e; }
   | CeCon _ li tl -> do { longident li; list ctyp tl; }
   | CeFun _ p ce -> do { patt p; class_expr ce; }
   | CeLet _ _ pel ce -> do { list let_binding pel; class_expr ce; }

camlp4/etc/pr_o.ml

@@ -691,8 +691,8 @@ and class_expr ce k =
   | ce -> class_expr1 ce k ]
 and class_expr1 ce k =
   match ce with
-  [ MLast.CeApp _ ce sel ->
-      HVbox [: `class_expr1 ce [: :]; list simple_expr sel "" k :]
+  [ MLast.CeApp _ ce e ->
+      HVbox [: `class_expr1 ce [: :]; `simple_expr e "" k :]
   | ce -> class_expr2 ce k ]
 and class_expr2 ce k =
   match ce with

camlp4/etc/pr_r.ml

@@ -680,8 +680,8 @@ and class_expr ce k =
   | ce -> class_expr1 ce k ]
 and class_expr1 ce k =
   match ce with
-  [ MLast.CeApp _ ce sel ->
-      HVbox [: `class_expr1 ce [: :]; list simple_expr sel k :]
+  [ MLast.CeApp _ ce e ->
+      HVbox [: `class_expr1 ce [: :]; `simple_expr e k :]
   | ce -> class_expr2 ce k ]
 and class_expr2 ce k =
   match ce with

camlp4/meta/pa_r.ml

@@ -607,8 +607,8 @@ EXTEND
         ce = SELF ->
           <:class_expr< let $rec:o2b rf$ $list:lb$ in $ce$ >> ]
     | "apply" NONA
-      [ ce = SELF; sel = LIST1 expr LEVEL "simple" ->
-          <:class_expr< $ce$ $list:sel$ >> ]
+      [ ce = SELF; e = expr LEVEL "simple" ->
+          <:class_expr< $ce$ $e$ >> ]
     | "simple"
       [ ci = class_longident; "["; ctcl = LIST0 ctyp SEP ","; "]" ->
           <:class_expr< $list:ci$ [ $list:ctcl$ ] >>

camlp4/meta/q_MLast.ml

@@ -664,8 +664,8 @@ EXTEND
         ce = SELF ->
           Node "CeLet" [rf; lb; ce] ]
     | "apply" NONA
-      [ ce = SELF; sel = SLIST1 (expr LEVEL "simple") ->
-          Node "CeApp" [ce; sel] ]
+      [ ce = SELF; e = expr LEVEL "simple" ->
+          Node "CeApp" [ce; e] ]
     | "simple"
       [ a = anti_ -> a
       | ci = class_longident; "["; ctcl = SLIST1 ctyp SEP ","; "]" ->

camlp4/ocaml_src/camlp4/ast2pt.ml

@@ -391,6 +391,12 @@ let rec expr_fa al =
   | f -> f, al
 ;;
 
+let rec class_expr_fa al =
+  function
+    CeApp (_, ce, a) -> class_expr_fa (a :: al) ce
+  | ce -> ce, al
+;;
+
 let rec sep_expr_acc l =
   function
     ExAcc (_, e1, e2) -> sep_expr_acc (sep_expr_acc l e2) e1
@@ -674,7 +680,8 @@ and class_sig_item c l =
   | CgVir (loc, s, b, t) -> Pctf_virt (s, mkprivate b, ctyp t, mkloc loc) :: l
 and class_expr =
   function
-    CeApp (loc, ce, el) ->
+    CeApp (loc, _, _) as c ->
+      let (ce, el) = class_expr_fa [] c in
       let el = List.map label_expr el in
       mkpcl loc (Pcl_apply (class_expr ce, el))
   | CeCon (loc, id, tl) ->

camlp4/ocaml_src/camlp4/mLast.mli

@@ -159,7 +159,7 @@ and class_sig_item =
   | CgVal of loc * string * bool * ctyp
   | CgVir of loc * string * bool * ctyp
 and class_expr =
-    CeApp of loc * class_expr * expr list
+    CeApp of loc * class_expr * expr
   | CeCon of loc * string list * ctyp list
   | CeFun of loc * patt * class_expr
   | CeLet of loc * bool * (patt * expr) list * class_expr

camlp4/ocaml_src/camlp4/reloc.ml

@@ -271,8 +271,7 @@ and class_sig_item floc sh =
 and class_expr floc sh =
   let rec self =
     function
-      CeApp (loc, x1, x2) ->
-        CeApp (floc loc, self x1, List.map (expr floc sh) x2)
+      CeApp (loc, x1, x2) -> CeApp (floc loc, self x1, expr floc sh x2)
     | CeCon (loc, x1, x2) -> CeCon (floc loc, x1, List.map (ctyp floc sh) x2)
     | CeFun (loc, x1, x2) -> CeFun (floc loc, patt floc sh x1, self x2)
     | CeLet (loc, x1, x2, x3) ->

camlp4/ocaml_src/meta/pa_r.ml

@@ -1724,12 +1724,11 @@ Grammar.extend
            (cfd : 'class_expr))];
      Some "apply", Some Gramext.NonA,
      [[Gramext.Sself;
-       Gramext.Slist1
-         (Gramext.Snterml
-            (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e), "simple"))],
+       Gramext.Snterml
+         (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e), "simple")],
       Gramext.action
-        (fun (sel : 'expr list) (ce : 'class_expr) (loc : int * int) ->
-           (MLast.CeApp (loc, ce, sel) : 'class_expr))];
+        (fun (e : 'expr) (ce : 'class_expr) (loc : int * int) ->
+           (MLast.CeApp (loc, ce, e) : 'class_expr))];
      Some "simple", None,
      [[Gramext.Stoken ("", "("); Gramext.Sself; Gramext.Stoken ("", ")")],
       Gramext.action

camlp4/ocaml_src/meta/q_MLast.ml

@@ -2518,20 +2518,11 @@ Grammar.extend
            (cfd : 'class_expr))];
      Some "apply", Some Gramext.NonA,
      [[Gramext.Sself;
-       Gramext.srules
-         [[Gramext.Slist1
-             (Gramext.Snterml
-                (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e),
-                 "simple"))],
-          Gramext.action
-            (fun (l : 'expr list) (loc : int * int) -> (list l : 'anti));
-          [Gramext.Snterm
-             (Grammar.Entry.obj (anti_list : 'anti_list Grammar.Entry.e))],
-          Gramext.action
-            (fun (a : 'anti_list) (loc : int * int) -> (a : 'anti))]],
+       Gramext.Snterml
+         (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e), "simple")],
       Gramext.action
-        (fun (sel : ast) (ce : 'class_expr) (loc : int * int) ->
-           (Node ("CeApp", [ce; sel]) : 'class_expr))];
+        (fun (e : 'expr) (ce : 'class_expr) (loc : int * int) ->
+           (Node ("CeApp", [ce; e]) : 'class_expr))];
      Some "simple", None,
      [[Gramext.Stoken ("", "("); Gramext.Sself; Gramext.Stoken ("", ")")],
       Gramext.action