Synchronize with trunk.unused_declarations

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

6 files changed, 59 insertions, 43 deletions

diff --git a/camlp4/Camlp4/Debug.ml b/camlp4/Camlp4/Debug.ml
index 2d901f3e98..73a38db89f 100644
--- a/camlp4/Camlp4/Debug.ml
+++ b/camlp4/Camlp4/Debug.ml
@@ -50,24 +50,15 @@ value mode =
 
 value formatter =
   let header = "camlp4-debug: " in
-  let normal s =
-    let rec self from accu =
-      try
-        let i = String.index_from s from '\n'
-        in self (i + 1) [String.sub s from (i - from + 1) :: accu]
-      with
-      [ Not_found -> [ String.sub s from (String.length s - from) :: accu ] ]
-    in String.concat header (List.rev (self 0 [])) in
-  let after_new_line str = header ^ normal str in
-  let f = ref after_new_line in
-  let output str chr = do {
-    output_string out_channel (f.val str);
-    output_char out_channel chr;
-    f.val := if chr = '\n' then after_new_line else normal;
-  } in
+  let at_bol = ref True in
   (make_formatter
     (fun buf pos len ->
-      let p = pred len in output (String.sub buf pos p) buf.[pos + p])
+       for i = pos to pos + len - 1 do
+         if at_bol.val then output_string out_channel header else ();
+         let ch = buf.[i];
+         output_char out_channel ch;
+         at_bol.val := ch = '\n';
+       done)
     (fun () -> flush out_channel));
 
 value printf section fmt = fprintf formatter ("%s: " ^^ fmt) section;
diff --git a/camlp4/Camlp4/Printers/OCaml.ml b/camlp4/Camlp4/Printers/OCaml.ml
index 24c4bac1a1..def7f196a2 100644
--- a/camlp4/Camlp4/Printers/OCaml.ml
+++ b/camlp4/Camlp4/Printers/OCaml.ml
@@ -106,10 +106,7 @@ module Make (Syntax : Sig.Camlp4Syntax) = struct
           "Cannot print %S this identifier does not respect OCaml lexing rules (%s)"
           str (Lexer.Error.to_string exn)) ];
 
-  value ocaml_char =
-    fun
-    [ "'" -> "\\'"
-    | c -> c ];
+  value ocaml_char x = x;
 
   value rec get_expr_args a al =
     match a with
@@ -559,7 +556,7 @@ module Make (Syntax : Sig.Camlp4Syntax) = struct
     | <:expr< $int64:s$ >> -> o#numeric f s "L"
     | <:expr< $int32:s$ >> -> o#numeric f s "l"
     | <:expr< $flo:s$ >> -> o#numeric f s ""
-    | <:expr< $chr:s$ >> -> pp f "'%s'" (ocaml_char s)
+    | <:expr< $chr:s$ >> -> pp f "'%s'" s
     | <:expr< $id:i$ >> -> o#var_ident f i
     | <:expr< { $b$ } >> ->
         pp f "@[<hv0>@[<hv2>{%a@]@ }@]" o#record_binding b
@@ -669,7 +666,7 @@ module Make (Syntax : Sig.Camlp4Syntax) = struct
     | <:patt< $int32:s$ >> -> o#numeric f s "l"
     | <:patt< $int:s$ >> -> o#numeric f s ""
     | <:patt< $flo:s$ >> -> o#numeric f s ""
-    | <:patt< $chr:s$ >> -> pp f "'%s'" (ocaml_char s)
+    | <:patt< $chr:s$ >> -> pp f "'%s'" s
     | <:patt< ~ $s$ >> -> pp f "~%s" s
     | <:patt< ` $uid:s$ >> -> pp f "`%a" o#var s
     | <:patt< # $i$ >> -> pp f "@[<2>#%a@]" o#ident i
@@ -951,7 +948,7 @@ module Make (Syntax : Sig.Camlp4Syntax) = struct
     let () = o#node f ce Ast.loc_of_class_expr in
     match ce with
     [ <:class_expr< $ce$ $e$ >> ->
-          pp f "@[<2>%a@ %a@]" o#class_expr ce o#expr e
+          pp f "@[<2>%a@ %a@]" o#class_expr ce o#apply_expr e
     | <:class_expr< $id:i$ >> ->
           pp f "@[<2>%a@]" o#ident i
     | <:class_expr< $id:i$ [ $t$ ] >> ->
diff --git a/camlp4/Camlp4Parsers/Camlp4MacroParser.ml b/camlp4/Camlp4Parsers/Camlp4MacroParser.ml
index c29cdd7347..840bc5ec1a 100644
--- a/camlp4/Camlp4Parsers/Camlp4MacroParser.ml
+++ b/camlp4/Camlp4Parsers/Camlp4MacroParser.ml
@@ -52,6 +52,7 @@ Added statements:
      DEFINE <lident> = <expression> IN <expression>
      __FILE__
      __LOCATION__
+     LOCATION_OF <parameter>
 
   In patterns:
 
@@ -84,6 +85,10 @@ Added statements:
 
   The expression __FILE__ returns the current compiled file name.
   The expression __LOCATION__ returns the current location of itself.
+  If used inside a macro, it returns the location where the macro is
+  called.
+  The expression (LOCATION_OF parameter) returns the location of the given
+  macro parameter. It cannot be used outside a macro definition.
 
 *)
 
@@ -151,6 +156,15 @@ module Make (Syntax : Sig.Camlp4Syntax) = struct
       [ <:expr< $lid:x$ >> | <:expr< $uid:x$ >> as e ->
           try List.assoc x env with
           [ Not_found -> super#expr e ]
+      | <:expr@_loc< LOCATION_OF $lid:x$ >> | <:expr@_loc< LOCATION_OF $uid:x$ >> as e ->
+          try
+            let loc = Ast.loc_of_expr (List.assoc x env) in
+            let (a, b, c, d, e, f, g, h) = Loc.to_tuple loc in
+            <:expr< Loc.of_tuple
+              ($`str:a$, $`int:b$, $`int:c$, $`int:d$,
+               $`int:e$, $`int:f$, $`int:g$,
+               $if h then <:expr< True >> else <:expr< False >> $) >>
+          with [ Not_found -> super#expr e ]
       | e -> super#expr e ];
 
     method patt =
@@ -387,15 +401,6 @@ module Make (Syntax : Sig.Camlp4Syntax) = struct
         | "DEFINE"; i = LIDENT; "="; def = expr; "IN"; body = expr ->
             (new subst _loc [(i, def)])#expr body ] ]
     ;
-    expr: LEVEL "simple"
-      [ [ LIDENT "__FILE__" -> <:expr< $`str:Loc.file_name _loc$ >>
-        | LIDENT "__LOCATION__" ->
-            let (a, b, c, d, e, f, g, h) = Loc.to_tuple _loc in
-            <:expr< Loc.of_tuple
-                ($`str:a$, $`int:b$, $`int:c$, $`int:d$,
-                 $`int:e$, $`int:f$, $`int:g$,
-                 $if h then <:expr< True >> else <:expr< False >> $) >> ] ]
-    ;
     patt:
       [ [ "IFDEF"; i = uident; "THEN"; p1 = patt; "ELSE"; p2 = patt; endif ->
             if is_defined i then p1 else p2
@@ -434,12 +439,20 @@ module MakeNothing (AstFilters : Camlp4.Sig.AstFilters) = struct
  open AstFilters;
  open Ast;
 
- value remove_nothings =
+ (* Remove NOTHING and expanse __FILE__ and __LOCATION__ *)
+ value map_expr =
    fun
    [ <:expr< $e$ NOTHING >> | <:expr< fun $ <:patt< NOTHING >> $ -> $e$ >> -> e
+   | <:expr@_loc< $lid:"__FILE__"$ >> -> <:expr< $`str:Loc.file_name _loc$ >>
+   | <:expr@_loc< $lid:"__LOCATION__"$ >> ->
+     let (a, b, c, d, e, f, g, h) = Loc.to_tuple _loc in
+     <:expr< Loc.of_tuple
+       ($`str:a$, $`int:b$, $`int:c$, $`int:d$,
+        $`int:e$, $`int:f$, $`int:g$,
+        $if h then <:expr< True >> else <:expr< False >> $) >>
    | e -> e];
 
- register_str_item_filter (Ast.map_expr remove_nothings)#str_item;
+ register_str_item_filter (Ast.map_expr map_expr)#str_item;
 
 end;
 
diff --git a/camlp4/Camlp4Parsers/Camlp4OCamlParser.ml b/camlp4/Camlp4Parsers/Camlp4OCamlParser.ml
index 36606cdd31..3d841516e4 100644
--- a/camlp4/Camlp4Parsers/Camlp4OCamlParser.ml
+++ b/camlp4/Camlp4Parsers/Camlp4OCamlParser.ml
@@ -584,9 +584,13 @@ module Make (Syntax : Sig.Camlp4Syntax) = struct
     ;
     type_kind:
       [ [ "private"; tk = type_kind -> <:ctyp< private $tk$ >>
-        | t = TRY [OPT "|"; t = constructor_declarations;
-                   test_not_dot_nor_lparen -> t] ->
-            <:ctyp< [ $t$ ] >>
+        | (x, t) = TRY [x = OPT "|"; t = constructor_declarations;
+                        test_not_dot_nor_lparen -> (x, t)] ->
+            (* If there is no "|" and [t] is an antiquotation,
+               then it is not a sum type. *)
+            match (x, t) with
+            [ (None, Ast.TyAnt _) -> t
+            | _ -> <:ctyp< [ $t$ ] >> ]
         | t = TRY ctyp -> <:ctyp< $t$ >>
         | t = TRY ctyp; "="; "private"; tk = type_kind ->
             <:ctyp< $t$ == private $tk$ >>
diff --git a/camlp4/Camlp4Parsers/Camlp4OCamlRevisedParser.ml b/camlp4/Camlp4Parsers/Camlp4OCamlRevisedParser.ml
index 5ccb69321b..52dab40f45 100644
--- a/camlp4/Camlp4Parsers/Camlp4OCamlRevisedParser.ml
+++ b/camlp4/Camlp4Parsers/Camlp4OCamlRevisedParser.ml
@@ -1782,13 +1782,19 @@ New syntax:\
     ;
     str_item_quot:
       [ [ "#"; n = a_LIDENT; dp = opt_expr -> <:str_item< # $n$ $dp$ >>
-        | st1 = str_item; semi; st2 = SELF -> <:str_item< $st1$; $st2$ >>
+        | st1 = str_item; semi; st2 = SELF ->
+            match st2 with
+            [ <:str_item<>> -> st1
+            | _ -> <:str_item< $st1$; $st2$ >> ]
         | st = str_item -> st
         | -> <:str_item<>> ] ]
     ;
     sig_item_quot:
       [ [ "#"; n = a_LIDENT; dp = opt_expr -> <:sig_item< # $n$ $dp$ >>
-        | sg1 = sig_item; semi; sg2 = SELF -> <:sig_item< $sg1$; $sg2$ >>
+        | sg1 = sig_item; semi; sg2 = SELF ->
+            match sg2 with
+            [ <:sig_item<>> -> sg1
+            | _ -> <:sig_item< $sg1$; $sg2$ >> ]
         | sg = sig_item -> sg
         | -> <:sig_item<>> ] ]
     ;
@@ -1873,12 +1879,17 @@ New syntax:\
     ;
     class_str_item_quot:
       [ [ x1 = class_str_item; semi; x2 = SELF ->
-          <:class_str_item< $x1$; $x2$ >>
+          match x2 with
+          [ <:class_str_item<>> -> x1
+          | _ -> <:class_str_item< $x1$; $x2$ >> ]
         | x = class_str_item -> x
         | -> <:class_str_item<>> ] ]
     ;
     class_sig_item_quot:
-      [ [ x1 = class_sig_item; semi; x2 = SELF -> <:class_sig_item< $x1$; $x2$ >>
+      [ [ x1 = class_sig_item; semi; x2 = SELF ->
+          match x2 with
+          [ <:class_sig_item<>> -> x1
+          | _ -> <:class_sig_item< $x1$; $x2$ >> ]
         | x = class_sig_item -> x
         | -> <:class_sig_item<>> ] ]
     ;
diff --git a/camlp4/boot/Camlp4Ast.ml b/camlp4/boot/Camlp4Ast.ml
index fb8a0a61c4..da35700cd2 100644
--- a/camlp4/boot/Camlp4Ast.ml
+++ b/camlp4/boot/Camlp4Ast.ml
@@ -471,10 +471,10 @@ module Make (Loc : Sig.Loc) : Sig.Camlp4Ast with module Loc = Loc =
             value meta_loc = meta_loc_expr;
             module Expr =
               struct
-                value meta_string _loc s = Ast.ExStr _loc s;
+                value meta_string _loc s = Ast.ExStr _loc (safe_string_escaped s);
                 value meta_int _loc s = Ast.ExInt _loc s;
                 value meta_float _loc s = Ast.ExFlo _loc s;
-                value meta_char _loc s = Ast.ExChr _loc s;
+                value meta_char _loc s = Ast.ExChr _loc (String.escaped s);
                 value meta_bool _loc =
                   fun
                   [ False -> Ast.ExId _loc (Ast.IdUid _loc "False")