[camlp4] Merge 3.10 on trunk for camlp4/Camlp4/Printers

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

5 files changed, 131 insertions, 109 deletions

diff --git a/camlp4/Camlp4/Printers/DumpCamlp4Ast.ml b/camlp4/Camlp4/Printers/DumpCamlp4Ast.ml
index 11bfcc7f1..ea005fb30 100644
--- a/camlp4/Camlp4/Printers/DumpCamlp4Ast.ml
+++ b/camlp4/Camlp4/Printers/DumpCamlp4Ast.ml
@@ -29,7 +29,8 @@ module Make (Syntax : Sig.Syntax)
 
   value with_open_out_file x f =
     match x with
-    [ Some file -> do { let oc = open_out_bin file in f oc;
+    [ Some file -> do { let oc = open_out_bin file;
+                        f oc;
                         flush oc;
                         close_out oc }
     | None -> do { set_binary_mode_out stdout True; f stdout; flush stdout } ];
diff --git a/camlp4/Camlp4/Printers/DumpOCamlAst.ml b/camlp4/Camlp4/Printers/DumpOCamlAst.ml
index 952fce9f8..0ce7e5b15 100644
--- a/camlp4/Camlp4/Printers/DumpOCamlAst.ml
+++ b/camlp4/Camlp4/Printers/DumpOCamlAst.ml
@@ -30,7 +30,8 @@ module Make (Syntax : Sig.Camlp4Syntax)
 
   value with_open_out_file x f =
     match x with
-    [ Some file -> do { let oc = open_out_bin file in f oc;
+    [ Some file -> do { let oc = open_out_bin file;
+                        f oc;
                         flush oc;
                         close_out oc }
     | None -> do { set_binary_mode_out stdout True; f stdout; flush stdout } ];
diff --git a/camlp4/Camlp4/Printers/OCaml.ml b/camlp4/Camlp4/Printers/OCaml.ml
index 35eb358e8..95856ccb6 100644
--- a/camlp4/Camlp4/Printers/OCaml.ml
+++ b/camlp4/Camlp4/Printers/OCaml.ml
@@ -26,6 +26,8 @@ end;
 module Make (Syntax : Sig.Camlp4Syntax) = struct
   include Syntax;
 
+  type sep = format unit formatter unit;
+
   value pp = fprintf;
   value cut f = fprintf f "@ ";
 
@@ -65,23 +67,23 @@ module Make (Syntax : Sig.Camlp4Syntax) = struct
 
   module StringSet = Set.Make String;
 
+  value infix_lidents = ["asr"; "land"; "lor"; "lsl"; "lsr"; "lxor"; "mod"; "or"];
+
   value is_infix =
     let first_chars = ['='; '<'; '>'; '|'; '&'; '$'; '@'; '^'; '+'; '-'; '*'; '/'; '%'; '\\']
     and infixes =
-      List.fold_right StringSet.add
-        ["asr"; "land"; "lor"; "lsl"; "lsr"; "lxor"; "mod"; "or"] StringSet.empty
+      List.fold_right StringSet.add infix_lidents StringSet.empty
     in fun s -> (StringSet.mem s infixes
                  || (s <> "" && List.mem s.[0] first_chars));
 
   value is_keyword =
-    let keywords =
+    let keywords = (* without infix_lidents *)
       List.fold_right StringSet.add
-        ["and";  "as";   "assert"; "asr"; "begin"; "class"; "constraint"; "do";
-         "done";  "downto";  "else";  "end";  "exception"; "external"; "false";
-         "for";   "fun";   "function";   "functor";   "if";   "in";  "include";
-         "inherit";  "initializer"; "land"; "lazy"; "let"; "lor"; "lsl"; "lsr";
-         "lxor";   "match";   "method";   "mod";  "module";  "mutable";  "new";
-         "object";  "of";  "open";  "or";  "parser";  "private";  "rec"; "sig";
+        ["and"; "as"; "assert"; "begin"; "class"; "constraint"; "do";
+         "done"; "downto"; "else"; "end"; "exception"; "external"; "false";
+         "for"; "fun"; "function"; "functor"; "if"; "in"; "include";
+         "inherit"; "initializer"; "lazy"; "let"; "match"; "method"; "module";
+         "mutable"; "new"; "object";  "of";  "open"; "parser";  "private";  "rec"; "sig";
          "struct";  "then";  "to";  "true";  "try";  "type";  "val"; "virtual";
          "when"; "while"; "with"] StringSet.empty
       in fun s -> StringSet.mem s keywords;
@@ -95,7 +97,7 @@ module Make (Syntax : Sig.Camlp4Syntax) = struct
     try match lexer str with parser
         [: `(tok, _); `(EOI, _) :] -> tok
     with
-    [ Stream.Failure ->
+    [ Stream.Failure | Stream.Error _ ->
         failwith (sprintf
           "Cannot print %S this string contains more than one token" str)
     | Lexer.Error.E exn ->
@@ -162,8 +164,8 @@ module Make (Syntax : Sig.Camlp4Syntax) = struct
     method reset_semi = {< semi = False >};
     method reset =      {< pipe = False; semi = False >};
 
-    value semisep = ";;";
-    value andsep : format unit formatter unit = "@]@ @[<2>and@ ";
+    value semisep : sep = ";;";
+    value andsep : sep = "@]@ @[<2>and@ ";
     value value_val = "val";
     value value_let = "let";
     value mode = if comments then `comments else `no_comments;
@@ -203,7 +205,9 @@ module Make (Syntax : Sig.Camlp4Syntax) = struct
           | _ ->
             match lex_string v with
             [ (LIDENT s | UIDENT s | ESCAPED_IDENT s) when is_keyword s ->
-                  pp f "%s__" s
+                pp f "%s__" s
+            | (LIDENT s | ESCAPED_IDENT s) when List.mem s infix_lidents ->
+                pp f "( %s )" s
             | SYMBOL s ->
                 pp f "( %s )" s
             | LIDENT s | UIDENT s | ESCAPED_IDENT s ->
@@ -295,9 +299,6 @@ module Make (Syntax : Sig.Camlp4Syntax) = struct
                o#under_semi#record_binding f b2 }
       | <:rec_binding< $anti:s$ >> -> o#anti f s ];
 
-    method object_dup f =
-      list (fun f (s, e) -> pp f "@[<2>%a =@ %a@]" o#var s o#expr e) ";@ " f;
-
     method mk_patt_list =
       fun
       [ <:patt< [$p1$ :: $p2$] >> ->
@@ -339,15 +340,16 @@ module Make (Syntax : Sig.Camlp4Syntax) = struct
     method constrain f (t1, t2) =
       pp f "@[<2>constraint@ %a =@ %a@]" o#ctyp t1 o#ctyp t2;
 
-    method sum_type f t = do {
-      (* FIXME pp_print_if_newline f (); *)
-      pp_print_string f "| ";
-      o#ctyp f t;
-    };
+    method sum_type f t =
+      match Ast.list_of_ctyp t [] with
+      [ [] -> ()
+      | ts ->
+          pp f "@[<hv0>| %a@]" (list o#ctyp "@ | ") ts ];
+
     method string f = pp f "%s";
     method quoted_string f = pp f "%S";
 
-    method numeric f s = if s.[0] = '-' then pp f "(%s)" s else pp f "%s" s;
+    method intlike f s = if s.[0] = '-' then pp f "(%s)" s else pp f "%s" s;
 
     method module_expr_get_functor_args accu =
       fun
@@ -461,7 +463,7 @@ module Make (Syntax : Sig.Camlp4Syntax) = struct
     | <:expr< assert False >> -> pp f "@[<2>assert@ false@]"
     | <:expr< assert $e$ >> -> pp f "@[<2>assert@ %a@]" o#dot_expr e
     | <:expr< let module $s$ = $me$ in $e$ >> ->
-          pp f "@[<2>let module %a =@ %a@]@ @[<2>in@ %a@]" o#var s o#module_expr me o#expr e
+          pp f "@[<2>let module %a =@ %a@]@ @[<2>in@ %a@]" o#var s o#module_expr me o#reset_semi#expr e
     | e -> o#apply_expr f e ];
 
     method apply_expr f e =
@@ -503,11 +505,11 @@ module Make (Syntax : Sig.Camlp4Syntax) = struct
     | <:expr< for $s$ = $e1$ $to:df$ $e2$ do { $e3$ } >> ->
         pp f "@[<hv0>@[<hv2>@[<2>for %a =@ %a@ %a@ %a@ do@]@ %a@]@ done@]"
           o#var s o#expr e1 o#direction_flag df o#expr e2 o#seq e3
-    | <:expr< $int:s$ >> -> o#numeric f s
-    | <:expr< $nativeint:s$ >> -> pp f "%an" o#numeric s
-    | <:expr< $int64:s$ >> -> pp f "%aL" o#numeric s
-    | <:expr< $int32:s$ >> -> pp f "%al" o#numeric s
-    | <:expr< $flo:s$ >> -> o#numeric f s
+    | <:expr< $int:s$ >> -> pp f "%a" o#intlike s
+    | <:expr< $nativeint:s$ >> -> pp f "%an" o#intlike s
+    | <:expr< $int64:s$ >> -> pp f "%aL" o#intlike s
+    | <:expr< $int32:s$ >> -> pp f "%al" o#intlike s
+    | <:expr< $flo:s$ >> -> pp f "%s" s
     | <:expr< $chr:s$ >> -> pp f "'%s'" (ocaml_char s)
     | <:expr< $id:i$ >> -> o#var_ident f i
     | <:expr< { $b$ } >> ->
@@ -587,15 +589,17 @@ module Make (Syntax : Sig.Camlp4Syntax) = struct
     [ <:patt< [$_$ :: $_$] >> as p -> o#simple_patt f p
     | <:patt< $x$ $y$ >> ->
         let (a, al) = get_patt_args x [y] in
-        if (not curry_constr) && Ast.is_patt_constructor a then
+        if not (Ast.is_patt_constructor a) then
+          Format.eprintf "WARNING: strange pattern application of a non constructor@."
+        else if curry_constr then
+          pp f "@[<2>%a@]" (list o#simple_patt "@ ") [a::al]
+        else
           match al with
           [ [ <:patt< ($tup:_$) >> ] ->
               pp f "@[<2>%a@ (%a)@]" o#simple_patt x o#patt y
           | [_] -> pp f "@[<2>%a@ %a@]" o#patt5 x o#simple_patt y
           | al -> pp f "@[<2>%a@ (%a)@]" o#patt5 a
                        (list o#simple_patt ",@ ") al ]
-        else
-          pp f "@[<2>%a@]" (list o#simple_patt "@ ") [a::al]
     | p -> o#simple_patt f p ];
 
     method simple_patt f p =
@@ -609,11 +613,11 @@ module Make (Syntax : Sig.Camlp4Syntax) = struct
     | <:patt< { $p$ } >> -> pp f "@[<hv2>{@ %a@]@ }" o#patt p
     | <:patt< $str:s$ >> -> pp f "\"%s\"" s
     | <:patt< ( $p$ : $t$ ) >> -> pp f "@[<1>(%a :@ %a)@]" o#patt p o#ctyp t
-    | <:patt< $nativeint:s$ >> -> pp f "%an" o#numeric s
-    | <:patt< $int64:s$ >> -> pp f "%aL" o#numeric s
-    | <:patt< $int32:s$ >> -> pp f "%al" o#numeric s
-    | <:patt< $int:s$ >> -> o#numeric f s
-    | <:patt< $flo:s$ >> -> o#numeric f s
+    | <:patt< $nativeint:s$ >> -> pp f "%an" o#intlike s
+    | <:patt< $int64:s$ >> -> pp f "%aL" o#intlike s
+    | <:patt< $int32:s$ >> -> pp f "%al" o#intlike s
+    | <:patt< $int:s$ >> -> pp f "%a" o#intlike s
+    | <:patt< $flo:s$ >> -> pp f "%s" s
     | <:patt< $chr:s$ >> -> pp f "'%s'" (ocaml_char s)
     | <:patt< ~ $s$ >> -> pp f "~%s" s
     | <:patt< ` $uid:s$ >> -> pp f "`%a" o#var s
@@ -622,18 +626,23 @@ module Make (Syntax : Sig.Camlp4Syntax) = struct
     | <:patt< ~ $s$ : ($p$) >> -> pp f "@[<2>~%s:@ (%a)@]" s o#patt p
     | <:patt< ? $s$ >> -> pp f "?%s" s
     | <:patt< ?($p$) >> ->
-          pp f "@[<2>?(%a)@]" o#patt p
+          pp f "@[<2>?(%a)@]" o#patt_tycon p
     | <:patt< ? $s$ : ($p$) >> ->
-          pp f "@[<2>?%s:@,@[<1>(%a)@]@]" s o#patt p
+          pp f "@[<2>?%s:@,@[<1>(%a)@]@]" s o#patt_tycon p
     | <:patt< ?($p$ = $e$) >> ->
-          pp f "@[<2>?(%a =@ %a)@]" o#patt p o#expr e
+          pp f "@[<2>?(%a =@ %a)@]" o#patt_tycon p o#expr e
     | <:patt< ? $s$ : ($p$ = $e$) >> ->
-          pp f "@[<2>?%s:@,@[<1>(%a =@ %a)@]@]" s o#patt p o#expr e
+          pp f "@[<2>?%s:@,@[<1>(%a =@ %a)@]@]" s o#patt_tycon p o#expr e
     | <:patt< $_$ $_$ >> | <:patt< ($_$ as $_$) >> | <:patt< $_$ | $_$ >> |
       <:patt< $_$ .. $_$ >> | <:patt< $_$, $_$ >> |
       <:patt< $_$; $_$ >> | <:patt< $_$ = $_$ >> as p ->
           pp f "@[<1>(%a)@]" o#patt p ];
 
+    method patt_tycon f =
+      fun
+      [ <:patt< ( $p$ : $t$ ) >> -> pp f "%a :@ %a" o#patt p o#ctyp t
+      | p -> o#patt f p ];
+
     method simple_ctyp f t =
     let () = o#node f t Ast.loc_of_ctyp in
     match t with
@@ -650,11 +659,13 @@ module Make (Syntax : Sig.Camlp4Syntax) = struct
     | <:ctyp< { $t$ } >> -> pp f "@[<2>{@ %a@]@ }" o#ctyp t
     | <:ctyp< [ $t$ ] >> -> pp f "@[<0>%a@]" o#sum_type t
     | <:ctyp< ( $tup:t$ ) >> -> pp f "@[<1>(%a)@]" o#ctyp t
-    | <:ctyp< [ = $t$ ] >> -> pp f "@[<2>[@ %a@]@ ]" o#ctyp t
-    | <:ctyp< [ < $t$ ] >> -> pp f "@[<2>[<@ %a@]@,]" o#ctyp t
+    | <:ctyp< [ = $t$ ] >> -> pp f "@[<2>[@ %a@]@ ]" o#sum_type t
+    | <:ctyp< [ < $t$ ] >> -> pp f "@[<2>[<@ %a@]@,]" o#sum_type t
     | <:ctyp< [ < $t1$ > $t2$ ] >> ->
-        pp f "@[<2>[<@ %a@ >@ %a@]@ ]" o#ctyp t1 o#ctyp t2
-    | <:ctyp< [ > $t$ ] >> -> pp f "@[<2>[>@ %a@]@,]" o#ctyp t
+        let (a, al) = get_ctyp_args t2 [] in
+        pp f "@[<2>[<@ %a@ >@ %a@]@ ]" o#sum_type t1
+          (list o#simple_ctyp "@ ") [a::al]
+    | <:ctyp< [ > $t$ ] >> -> pp f "@[<2>[>@ %a@]@,]" o#sum_type t
     | <:ctyp< # $i$ >> -> pp f "@[<2>#%a@]" o#ident i
     | <:ctyp< $t1$ == $t2$ >> ->
         pp f "@[<2>%a =@ %a@]" o#simple_ctyp t1 o#simple_ctyp t2
@@ -721,9 +732,9 @@ module Make (Syntax : Sig.Camlp4Syntax) = struct
       | <:sig_item< $sg1$; $sg2$ >> ->
           do { o#sig_item f sg1; cut f; o#sig_item f sg2 }
       | <:sig_item< exception $t$ >> ->
-          pp f "@[<2>exception@ %a%s@]" o#ctyp t semisep
+          pp f "@[<2>exception@ %a%(%)@]" o#ctyp t semisep
       | <:sig_item< external $s$ : $t$ = $sl$ >> ->
-          pp f "@[<2>external@ %a :@ %a =@ %a%s@]"
+          pp f "@[<2>external@ %a :@ %a =@ %a%(%)@]"
             o#var s o#ctyp t (meta_list o#quoted_string "@ ") sl semisep
       | <:sig_item< module $s1$ ($s2$ : $mt1$) : $mt2$ >> ->
           let rec loop accu =
@@ -732,35 +743,35 @@ module Make (Syntax : Sig.Camlp4Syntax) = struct
                 loop [(s, mt1)::accu] mt2
             | mt -> (List.rev accu, mt) ] in
           let (al, mt) = loop [(s2, mt1)] mt2 in
-          pp f "@[<2>module %a@ @[<0>%a@] :@ %a%s@]"
+          pp f "@[<2>module %a@ @[<0>%a@] :@ %a%(%)@]"
             o#var s1 o#functor_args al o#module_type mt semisep
       | <:sig_item< module $s$ : $mt$ >> ->
-          pp f "@[<2>module %a :@ %a%s@]"
+          pp f "@[<2>module %a :@ %a%(%)@]"
             o#var s o#module_type mt semisep
       | <:sig_item< module type $s$ = $ <:module_type<>> $ >> ->
-          pp f "@[<2>module type %a%s@]" o#var s semisep
+          pp f "@[<2>module type %a%(%)@]" o#var s semisep
       | <:sig_item< module type $s$ = $mt$ >> ->
-          pp f "@[<2>module type %a =@ %a%s@]"
+          pp f "@[<2>module type %a =@ %a%(%)@]"
             o#var s o#module_type mt semisep
       | <:sig_item< open $sl$ >> ->
-          pp f "@[<2>open@ %a%s@]" o#ident sl semisep
+          pp f "@[<2>open@ %a%(%)@]" o#ident sl semisep
       | <:sig_item< type $t$ >> ->
-          pp f "@[<hv0>@[<hv2>type %a@]%s@]" o#ctyp t semisep
+          pp f "@[<hv0>@[<hv2>type %a@]%(%)@]" o#ctyp t semisep
       | <:sig_item< value $s$ : $t$ >> ->
-          pp f "@[<2>%s %a :@ %a%s@]"
+          pp f "@[<2>%s %a :@ %a%(%)@]"
             value_val o#var s o#ctyp t semisep
       | <:sig_item< include $mt$ >> ->
-          pp f "@[<2>include@ %a%s@]" o#module_type mt semisep
+          pp f "@[<2>include@ %a%(%)@]" o#module_type mt semisep
       | <:sig_item< class type $ct$ >> ->
-          pp f "@[<2>class type %a%s@]" o#class_type ct semisep
+          pp f "@[<2>class type %a%(%)@]" o#class_type ct semisep
       | <:sig_item< class $ce$ >> ->
-          pp f "@[<2>class %a%s@]" o#class_type ce semisep
+          pp f "@[<2>class %a%(%)@]" o#class_type ce semisep
       | <:sig_item< module rec $mb$ >> ->
-          pp f "@[<2>module rec %a%s@]"
+          pp f "@[<2>module rec %a%(%)@]"
             o#module_rec_binding mb semisep
       | <:sig_item< # $_$ $_$ >> -> ()
       | <:sig_item< $anti:s$ >> ->
-          pp f "%a%s" o#anti s semisep ];
+          pp f "%a%(%)" o#anti s semisep ];
 
     method str_item f st =
       let () = o#node f st Ast.loc_of_str_item in
@@ -772,47 +783,47 @@ module Make (Syntax : Sig.Camlp4Syntax) = struct
       | <:str_item< $st1$; $st2$ >> ->
             do { o#str_item f st1; cut f; o#str_item f st2 }
       | <:str_item< exception $t$ >> ->
-            pp f "@[<2>exception@ %a%s@]" o#ctyp t semisep
+            pp f "@[<2>exception@ %a%(%)@]" o#ctyp t semisep
       | <:str_item< exception $t$ = $sl$ >> ->
-            pp f "@[<2>exception@ %a =@ %a%s@]" o#ctyp t o#ident sl semisep
+            pp f "@[<2>exception@ %a =@ %a%(%)@]" o#ctyp t o#ident sl semisep
       | <:str_item< external $s$ : $t$ = $sl$ >> ->
-            pp f "@[<2>external@ %a :@ %a =@ %a%s@]"
+            pp f "@[<2>external@ %a :@ %a =@ %a%(%)@]"
               o#var s o#ctyp t (meta_list o#quoted_string "@ ") sl semisep
       | <:str_item< module $s1$ ($s2$ : $mt1$) = $me$ >> ->
           match o#module_expr_get_functor_args [(s2, mt1)] me with
           [ (al, me, Some mt2) ->
-              pp f "@[<2>module %a@ @[<0>%a@] :@ %a =@ %a%s@]"
+              pp f "@[<2>module %a@ @[<0>%a@] :@ %a =@ %a%(%)@]"
                 o#var s1 o#functor_args al o#module_type mt2
                 o#module_expr me semisep
           | (al, me, _) ->
-              pp f "@[<2>module %a@ @[<0>%a@] =@ %a%s@]"
+              pp f "@[<2>module %a@ @[<0>%a@] =@ %a%(%)@]"
                 o#var s1 o#functor_args al o#module_expr me semisep ]
       | <:str_item< module $s$ : $mt$ = $me$ >> ->
-            pp f "@[<2>module %a :@ %a =@ %a%s@]"
+            pp f "@[<2>module %a :@ %a =@ %a%(%)@]"
               o#var s o#module_type mt o#module_expr me semisep
       | <:str_item< module $s$ = $me$ >> ->
-            pp f "@[<2>module %a =@ %a%s@]" o#var s o#module_expr me semisep
+            pp f "@[<2>module %a =@ %a%(%)@]" o#var s o#module_expr me semisep
       | <:str_item< module type $s$ = $mt$ >> ->
-            pp f "@[<2>module type %a =@ %a%s@]"
+            pp f "@[<2>module type %a =@ %a%(%)@]"
               o#var s o#module_type mt semisep
       | <:str_item< open $sl$ >> ->
-            pp f "@[<2>open@ %a%s@]" o#ident sl semisep
+            pp f "@[<2>open@ %a%(%)@]" o#ident sl semisep
       | <:str_item< type $t$ >> ->
-            pp f "@[<hv0>@[<hv2>type %a@]%s@]" o#ctyp t semisep
+            pp f "@[<hv0>@[<hv2>type %a@]%(%)@]" o#ctyp t semisep
       | <:str_item< value $rec:r$ $bi$ >> ->
-            pp f "@[<2>%s %a%a%s@]" value_let o#rec_flag r o#binding bi semisep
+            pp f "@[<2>%s %a%a%(%)@]" value_let o#rec_flag r o#binding bi semisep
       | <:str_item< $exp:e$ >> ->
-            pp f "@[<2>let _ =@ %a%s@]" o#expr e semisep
+            pp f "@[<2>let _ =@ %a%(%)@]" o#expr e semisep
       | <:str_item< include $me$ >> ->
-            pp f "@[<2>include@ %a%s@]" o#module_expr me semisep
+            pp f "@[<2>include@ %a%(%)@]" o#module_expr me semisep
       | <:str_item< class type $ct$ >> ->
-            pp f "@[<2>class type %a%s@]" o#class_type ct semisep
+            pp f "@[<2>class type %a%(%)@]" o#class_type ct semisep
       | <:str_item< class $ce$ >> ->
-            pp f "@[<hv2>class %a%s@]" o#class_declaration ce semisep
+            pp f "@[<hv2>class %a%(%)@]" o#class_declaration ce semisep
       | <:str_item< module rec $mb$ >> ->
-            pp f "@[<2>module rec %a%s@]" o#module_rec_binding mb semisep
+            pp f "@[<2>module rec %a%(%)@]" o#module_rec_binding mb semisep
       | <:str_item< # $_$ $_$ >> -> ()
-      | <:str_item< $anti:s$ >> -> pp f "%a%s" o#anti s semisep
+      | <:str_item< $anti:s$ >> -> pp f "%a%(%)" o#anti s semisep
       | Ast.StExc _ _ (Ast.OAnt _) -> assert False ];
 
     method module_type f mt =
@@ -932,21 +943,21 @@ module Make (Syntax : Sig.Camlp4Syntax) = struct
       | <:class_sig_item< $csg1$; $csg2$ >> ->
             do { o#class_sig_item f csg1; cut f; o#class_sig_item f csg2 }
       | <:class_sig_item< type $t1$ = $t2$ >> ->
-            pp f "@[<2>type@ %a =@ %a%s@]" o#ctyp t1 o#ctyp t2 semisep
+            pp f "@[<2>type@ %a =@ %a%(%)@]" o#ctyp t1 o#ctyp t2 semisep
       | <:class_sig_item< inherit $ct$ >> ->
-            pp f "@[<2>inherit@ %a%s@]" o#class_type ct semisep
+            pp f "@[<2>inherit@ %a%(%)@]" o#class_type ct semisep
       | <:class_sig_item< method $private:pr$ $s$ : $t$ >> ->
-            pp f "@[<2>method %a%a :@ %a%s@]" o#private_flag pr o#var s
+            pp f "@[<2>method %a%a :@ %a%(%)@]" o#private_flag pr o#var s
               o#ctyp t semisep
       | <:class_sig_item< method virtual $private:pr$ $s$ : $t$ >> ->
-            pp f "@[<2>method virtual %a%a :@ %a%s@]"
+            pp f "@[<2>method virtual %a%a :@ %a%(%)@]"
               o#private_flag pr o#var s o#ctyp t semisep
       | <:class_sig_item< value $mutable:mu$ $virtual:vi$ $s$ : $t$ >> ->
-            pp f "@[<2>%s %a%a%a :@ %a%s@]"
+            pp f "@[<2>%s %a%a%a :@ %a%(%)@]"
               value_val o#mutable_flag mu o#virtual_flag vi o#var s o#ctyp t
               semisep
       | <:class_sig_item< $anti:s$ >> ->
-            pp f "%a%s" o#anti s semisep ];
+            pp f "%a%(%)" o#anti s semisep ];
 
     method class_str_item f cst =
       let () = o#node f cst Ast.loc_of_class_str_item in
@@ -958,34 +969,34 @@ module Make (Syntax : Sig.Camlp4Syntax) = struct
       | <:class_str_item< $cst1$; $cst2$ >> ->
             do { o#class_str_item f cst1; cut f; o#class_str_item f cst2 }
       | <:class_str_item< type $t1$ = $t2$ >> ->
-            pp f "@[<2>type %a =@ %a%s@]" o#ctyp t1 o#ctyp t2 semisep
+            pp f "@[<2>constraint %a =@ %a%(%)@]" o#ctyp t1 o#ctyp t2 semisep
       | <:class_str_item< inherit $ce$ >> ->
-            pp f "@[<2>inherit@ %a%s@]" o#class_expr ce semisep
+            pp f "@[<2>inherit@ %a%(%)@]" o#class_expr ce semisep
       | <:class_str_item< inherit $ce$ as $lid:s$ >> ->
-            pp f "@[<2>inherit@ %a as@ %a%s@]" o#class_expr ce o#var s semisep
+            pp f "@[<2>inherit@ %a as@ %a%(%)@]" o#class_expr ce o#var s semisep
       | <:class_str_item< initializer $e$ >> ->
-            pp f "@[<2>initializer@ %a%s@]" o#expr e semisep
+            pp f "@[<2>initializer@ %a%(%)@]" o#expr e semisep
       | <:class_str_item< method $private:pr$ $s$ = $e$ >> ->
-            pp f "@[<2>method %a%a =@ %a%s@]"
+            pp f "@[<2>method %a%a =@ %a%(%)@]"
               o#private_flag pr o#var s o#expr e semisep
       | <:class_str_item< method $private:pr$ $s$ : $t$ = $e$ >> ->
-            pp f "@[<2>method %a%a :@ %a =@ %a%s@]"
+            pp f "@[<2>method %a%a :@ %a =@ %a%(%)@]"
               o#private_flag pr o#var s o#ctyp t o#expr e semisep
       | <:class_str_item< method virtual $private:pr$ $s$ : $t$ >> ->
-            pp f "@[<2>method virtual@ %a%a :@ %a%s@]"
+            pp f "@[<2>method virtual@ %a%a :@ %a%(%)@]"
               o#private_flag pr o#var s o#ctyp t semisep
       | <:class_str_item< value virtual $mutable:mu$ $s$ : $t$ >> ->
-            pp f "@[<2>%s virtual %a%a :@ %a%s@]"
+            pp f "@[<2>%s virtual %a%a :@ %a%(%)@]"
               value_val o#mutable_flag mu o#var s o#ctyp t semisep
       | <:class_str_item< value $mutable:mu$ $s$ = $e$ >> ->
-            pp f "@[<2>%s %a%a =@ %a%s@]"
+            pp f "@[<2>%s %a%a =@ %a%(%)@]"
               value_val o#mutable_flag mu o#var s o#expr e semisep
       | <:class_str_item< $anti:s$ >> ->
-            pp f "%a%s" o#anti s semisep ];
+            pp f "%a%(%)" o#anti s semisep ];
 
     method implem f st =
       match st with
-      [ <:str_item< $exp:e$ >> -> pp f "@[<0>%a%s@]@." o#expr e semisep
+      [ <:str_item< $exp:e$ >> -> pp f "@[<0>%a%(%)@]@." o#expr e semisep
       | st -> pp f "@[<v0>%a@]@." o#str_item st ];
 
     method interf f sg = pp f "@[<v0>%a@]@." o#sig_item sg;
@@ -1021,7 +1032,7 @@ module MakeMore (Syntax : Sig.Camlp4Syntax)
 
   include Make Syntax;
 
-  value semisep = ref False;
+  value semisep : ref sep = ref ("@\n" : sep);
   value margin = ref 78;
   value comments = ref True;
   value locations = ref False;
@@ -1030,7 +1041,7 @@ module MakeMore (Syntax : Sig.Camlp4Syntax)
   value print output_file fct =
     let o = new printer ~comments:comments.val
                         ~curry_constr:curry_constr.val () in
-    let o = if semisep.val then o#set_semisep ";;" else o#set_semisep "" in
+    let o = o#set_semisep semisep.val in
     let o = if locations.val then o#set_loc_and_comments else o in
     with_outfile output_file
       (fun f ->
@@ -1043,15 +1054,23 @@ module MakeMore (Syntax : Sig.Camlp4Syntax)
   value print_implem ?input_file:(_) ?output_file st =
     print output_file (fun o -> o#implem) st;
 
+  value check_sep s =
+    if String.contains s '%' then failwith "-sep Format error, % found in string"
+    else (Obj.magic (Struct.Token.Eval.string s : string) : sep);
+
   Options.add "-l" (Arg.Int (fun i -> margin.val := i))
     "<length> line length for pretty printing.";
 
-  Options.add "-ss" (Arg.Set semisep) "Print double semicolons.";
+  Options.add "-ss" (Arg.Unit (fun () -> semisep.val := ";;"))
+    " Print double semicolons.";
 
-  Options.add "-curry-constr" (Arg.Set curry_constr) "Use currified constructors.";
+  Options.add "-no_ss" (Arg.Unit (fun () -> semisep.val := ""))
+    " Do not print double semicolons (default).";
 
-  Options.add "-no_ss" (Arg.Clear semisep)
-    "Do not print double semicolons (default).";
+  Options.add "-sep" (Arg.String (fun s -> semisep.val := check_sep s))
+    " Use this string between phrases.";
+
+  Options.add "-curry-constr" (Arg.Set curry_constr) "Use currified constructors.";
 
   Options.add "-no_comments" (Arg.Clear comments) "Do not add comments.";
 
diff --git a/camlp4/Camlp4/Printers/OCaml.mli b/camlp4/Camlp4/Printers/OCaml.mli
index 0a027d037..a99fdbcf0 100644
--- a/camlp4/Camlp4/Printers/OCaml.mli
+++ b/camlp4/Camlp4/Printers/OCaml.mli
@@ -26,6 +26,8 @@ module Make (Syntax : Sig.Camlp4Syntax) : sig
             and module Ast     = Syntax.Ast
             and module Gram    = Syntax.Gram;
 
+  type sep = format unit formatter unit;
+
   value list' :
     (formatter -> 'a -> unit) ->
       format 'b formatter unit ->
@@ -64,7 +66,7 @@ module Make (Syntax : Sig.Camlp4Syntax) : sig
 
     value pipe : bool;
     value semi : bool;
-    value semisep : string;
+    value semisep : sep;
     value value_val : string;
     value value_let : string;
     method anti : formatter -> string -> unit;
@@ -92,7 +94,7 @@ module Make (Syntax : Sig.Camlp4Syntax) : sig
       formatter ->
         list (string * Ast.module_type) -> unit;
     method ident : formatter -> Ast.ident -> unit;
-    method numeric : formatter -> string -> unit;
+    method intlike : formatter -> string -> unit;
     method binding : formatter -> Ast.binding -> unit;
     method record_binding : formatter -> Ast.rec_binding -> unit;
     method match_case : formatter -> Ast.match_case -> unit;
@@ -113,14 +115,13 @@ module Make (Syntax : Sig.Camlp4Syntax) : sig
     method rec_flag : formatter -> Ast.meta_bool -> unit;
     method flag : formatter -> Ast.meta_bool -> string -> unit;
     method node : formatter -> 'b -> ('b -> Loc.t) -> unit;
-    method object_dup :
-      formatter -> list (string * Ast.expr) -> unit;
     method patt : formatter -> Ast.patt -> unit;
     method patt1 : formatter -> Ast.patt -> unit;
     method patt2 : formatter -> Ast.patt -> unit;
     method patt3 : formatter -> Ast.patt -> unit;
     method patt4 : formatter -> Ast.patt -> unit;
     method patt5 : formatter -> Ast.patt -> unit;
+    method patt_tycon : formatter -> Ast.patt -> unit;
     method patt_expr_fun_args :
       formatter -> (Ast.patt * Ast.expr) -> unit;
     method patt_class_expr_fun_args :
@@ -132,11 +133,11 @@ module Make (Syntax : Sig.Camlp4Syntax) : sig
     method raise_match_failure : formatter -> Loc.t -> unit;
     method reset : 'a;
     method reset_semi : 'a;
-    method semisep : string;
+    method semisep : sep;
     method set_comments : bool -> 'a;
     method set_curry_constr : bool -> 'a;
     method set_loc_and_comments : 'a;
-    method set_semisep : string -> 'a;
+    method set_semisep : sep -> 'a;
     method simple_ctyp : formatter -> Ast.ctyp -> unit;
     method simple_expr : formatter -> Ast.expr -> unit;
     method simple_patt : formatter -> Ast.patt -> unit;
diff --git a/camlp4/Camlp4/Printers/OCamlr.ml b/camlp4/Camlp4/Printers/OCamlr.ml
index 6c2232c63..d907d14c6 100644
--- a/camlp4/Camlp4/Printers/OCamlr.ml
+++ b/camlp4/Camlp4/Printers/OCamlr.ml
@@ -43,8 +43,8 @@ module Make (Syntax : Sig.Camlp4Syntax) = struct
   object (o)
     inherit PP_o.printer ~curry_constr:init_curry_constr ~comments () as super;
 
-    value semisep = ";";
-    value andsep : format unit formatter unit = "@]@ @[<2>and@ ";
+    value semisep : sep = ";";
+    value andsep : sep = "@]@ @[<2>and@ ";
     value value_val = "value";
     value value_let = "value";
     value mode = if comments then `comments else `no_comments;
@@ -217,7 +217,7 @@ module Make (Syntax : Sig.Camlp4Syntax) = struct
 
     method str_item f st =
     match st with
-    [ <:str_item< $exp:e$ >> -> pp f "@[<2>%a%s@]" o#expr e semisep
+    [ <:str_item< $exp:e$ >> -> pp f "@[<2>%a%(%)@]" o#expr e semisep
     | st -> super#str_item f st ];
 
     method module_expr f me =