Adding metadata to expressions in parsetree.metadata

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

6 files changed, 45 insertions, 24 deletions

diff --git a/parsing/parser.mly b/parsing/parser.mly
index 43a6a4c5cf..72e35b4e71 100644
--- a/parsing/parser.mly
+++ b/parsing/parser.mly
@@ -25,7 +25,7 @@ let mktyp d =
 let mkpat d =
   { ppat_desc = d; ppat_loc = symbol_rloc(); ppat_metadata = [] }
 let mkexp d =
-  { pexp_desc = d; pexp_loc = symbol_rloc() }
+  { pexp_desc = d; pexp_loc = symbol_rloc(); pexp_metadata = []  }
 let mkmty d =
   { pmty_desc = d; pmty_loc = symbol_rloc() }
 let mksig d =
@@ -45,7 +45,7 @@ let reloc_pat x = { x with ppat_loc = symbol_rloc () };;
 let reloc_exp x = { x with pexp_loc = symbol_rloc () };;
 
 let mkoperator name pos =
-  { pexp_desc = Pexp_ident(Lident name); pexp_loc = rhs_loc pos }
+  { pexp_desc = Pexp_ident(Lident name); pexp_loc = rhs_loc pos; pexp_metadata = []  }
 
 (*
   Ghost expressions and patterns:
@@ -64,7 +64,7 @@ let mkoperator name pos =
   AST node, then the location must be real; in all other cases,
   it must be ghost.
 *)
-let ghexp d = { pexp_desc = d; pexp_loc = symbol_gloc () };;
+let ghexp d = { pexp_desc = d; pexp_loc = symbol_gloc (); pexp_metadata = [] };;
 let ghpat d = { ppat_desc = d; ppat_loc = symbol_gloc (); ppat_metadata = [] };;
 let ghtyp d = { ptyp_desc = d; ptyp_loc = symbol_gloc () };;
 
@@ -113,8 +113,8 @@ let rec mktailexp = function
                loc_end = exp_el.pexp_loc.loc_end;
                loc_ghost = true}
       in
-      let arg = {pexp_desc = Pexp_tuple [e1; exp_el]; pexp_loc = l} in
-      {pexp_desc = Pexp_construct(Lident "::", Some arg, false); pexp_loc = l}
+      let arg = {pexp_desc = Pexp_tuple [e1; exp_el]; pexp_loc = l; pexp_metadata = [] } in
+      {pexp_desc = Pexp_construct(Lident "::", Some arg, false); pexp_loc = l; pexp_metadata = [] }
 
 let rec mktailpat = function
     [] ->
@@ -1025,6 +1025,7 @@ simple_expr:
       { mkexp(Pexp_send($1, $3)) }
   | LPAREN MODULE module_expr COLON package_type RPAREN
       { mkexp (Pexp_pack ($3, $5)) }
+  | LPAREN BACKQUOTE STRING expr RPAREN { let p = $4 in {p with pexp_metadata = $3 :: p.pexp_metadata} }
 ;
 simple_labeled_expr_list:
     labeled_simple_expr
@@ -1236,7 +1237,6 @@ simple_pattern:
       { mkpat(Ppat_constraint($2, $4)) }
   | LPAREN pattern COLON core_type error
       { unclosed "(" 1 ")" 5 }
-/*  | LPAREN simple_pattern AMPERSAND metadata RPAREN { let p = $2 in {p with ppat_metadata = p.ppat_metadata @ $4 } } */
   | LPAREN BACKQUOTE STRING pattern RPAREN { let p = $4 in {p with ppat_metadata = $3 :: p.ppat_metadata} }
 ;
 
diff --git a/parsing/parsetree.mli b/parsing/parsetree.mli
index 130cb0dab7..e41d7b6cda 100644
--- a/parsing/parsetree.mli
+++ b/parsing/parsetree.mli
@@ -84,7 +84,9 @@ and pattern_desc =
 
 type expression =
   { pexp_desc: expression_desc;
-    pexp_loc: Location.t }
+    pexp_loc: Location.t;
+    pexp_metadata: metadata;
+   }
 
 and expression_desc =
     Pexp_ident of Longident.t
diff --git a/typing/typeclass.ml b/typing/typeclass.ml
index 44dc776b50..0c7e5a8f79 100644
--- a/typing/typeclass.ml
+++ b/typing/typeclass.ml
@@ -323,7 +323,9 @@ let make_method cl_num expr =
                      [mkpat (Ppat_alias (mkpat(Ppat_var "self-*"),
                                          "self-" ^ cl_num)),
                       expr]);
-    pexp_loc = expr.pexp_loc }
+    pexp_loc = expr.pexp_loc;
+    pexp_metadata =[];
+   }
 
 (*******************************)
 
@@ -594,7 +596,9 @@ let rec class_field cl_num self_type meths vars
              let expr =
                Typecore.type_exp val_env
                  {pexp_desc = Pexp_ident (Longident.Lident (Ident.name id));
-                  pexp_loc = Location.none}
+                  pexp_loc = Location.none;
+                  pexp_metadata = [];
+                 }
              in
              let desc =
                {val_type = expr.exp_type;
@@ -792,7 +796,9 @@ and class_expr cl_num val_env met_env scl =
                          false);
           ppat_metadata = [];
          },
-         {pexp_loc = loc; pexp_desc = Pexp_ident(Longident.Lident"*sth*")};
+         {pexp_loc = loc; pexp_desc = Pexp_ident(Longident.Lident"*sth*");
+          pexp_metadata = [];
+         };
          {ppat_loc = loc;
           ppat_desc = Ppat_construct(Longident.Lident"None", None, false);
           ppat_metadata = [];
@@ -800,9 +806,12 @@ and class_expr cl_num val_env met_env scl =
          default] in
       let smatch =
         {pexp_loc = loc; pexp_desc =
-         Pexp_match({pexp_loc = loc; pexp_desc =
-                     Pexp_ident(Longident.Lident"*opt*")},
-                    scases)} in
+         Pexp_match({pexp_loc = loc; pexp_desc = Pexp_ident(Longident.Lident"*opt*");
+                     pexp_metadata = [];
+                    },
+                    scases);
+         pexp_metadata = [];
+        } in
       let sfun =
         {pcl_loc = scl.pcl_loc; pcl_desc =
          Pcl_fun(l, None, {ppat_loc = loc;
@@ -828,7 +837,9 @@ and class_expr cl_num val_env met_env scl =
             (id,
              Typecore.type_exp val_env'
                {pexp_desc = Pexp_ident (Longident.Lident (Ident.name id));
-                pexp_loc = Location.none}))
+                pexp_loc = Location.none;
+                pexp_metadata = [];
+               }))
           pv
       in
       let rec not_function = function
@@ -954,7 +965,9 @@ and class_expr cl_num val_env met_env scl =
              let expr =
                Typecore.type_exp val_env
                  {pexp_desc = Pexp_ident (Longident.Lident (Ident.name id));
-                  pexp_loc = Location.none}
+                  pexp_loc = Location.none;
+                  pexp_metadata = [];
+                 }
              in
              Ctype.end_def ();
              Ctype.generalize expr.exp_type;
diff --git a/typing/typecore.ml b/typing/typecore.ml
index ff297a1093..68ddcc5f36 100644
--- a/typing/typecore.ml
+++ b/typing/typecore.ml
@@ -2049,7 +2049,9 @@ and type_expect ?in_function env sexp ty_expected =
           ppat_metadata = [];
          },
          {pexp_loc = default_loc;
-          pexp_desc = Pexp_ident(Longident.Lident "*sth*")};
+          pexp_desc = Pexp_ident(Longident.Lident "*sth*");
+          pexp_metadata = [];
+         };
          {ppat_loc = default_loc;
           ppat_desc = Ppat_construct(Longident.Lident "None", None, false);
           ppat_metadata = [];
@@ -2061,11 +2063,12 @@ and type_expect ?in_function env sexp ty_expected =
         pexp_desc =
           Pexp_match ({
             pexp_loc = loc;
-            pexp_desc =
-              Pexp_ident(Longident.Lident "*opt*")
+            pexp_desc = Pexp_ident(Longident.Lident "*opt*");
+            pexp_metadata = [];
             },
             scases
-          )
+          );
+        pexp_metadata = [];
       } in
       let sfun = {
         pexp_loc = loc;
@@ -2078,11 +2081,12 @@ and type_expect ?in_function env sexp ty_expected =
               ppat_metadata = [];
              },
              {pexp_loc = loc;
-              pexp_desc =
-                Pexp_let(Default, [spat, smatch], sbody);
+              pexp_desc = Pexp_let(Default, [spat, smatch], sbody);
+              pexp_metadata = [];
              }
            ]
-         )
+         );
+        pexp_metadata = [];
       } in
       type_expect ?in_function env sfun ty_expected
   | Pexp_function (l, _, caselist) ->
diff --git a/typing/typedtree.ml b/typing/typedtree.ml
index e2b7e285e9..ca21119726 100644
--- a/typing/typedtree.ml
+++ b/typing/typedtree.ml
@@ -46,7 +46,8 @@ type expression =
   { exp_desc: expression_desc;
     exp_loc: Location.t;
     exp_type: type_expr;
-    exp_env: Env.t }
+    exp_env: Env.t;
+   }
 
 and expression_desc =
     Texp_ident of Path.t * value_description
diff --git a/typing/typedtree.mli b/typing/typedtree.mli
index eb64937cfe..44ffba69d7 100644
--- a/typing/typedtree.mli
+++ b/typing/typedtree.mli
@@ -45,7 +45,8 @@ type expression =
   { exp_desc: expression_desc;
     exp_loc: Location.t;
     exp_type: type_expr;
-    exp_env: Env.t }
+    exp_env: Env.t;
+   }
 
 and expression_desc =
     Texp_ident of Path.t * value_description