diff --git a/CHANGELOG.md b/CHANGELOG.md
index d78f5076d3..d0da9508ef 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -28,6 +28,12 @@
 
 - Fix issue where async as an id cannot be used with application and labelled arguments https://github.com/rescript-lang/syntax/issues/707
 
+- Fix 5557 the exhaustive checking for Char is incorrect during the unicode migration https://github.com/rescript-lang/rescript-compiler/pull/5749
+
+- Fix 5753 the comment for unicode char is inaccurate https://github.com/rescript-lang/syntax/pull/709
+
+- Internal changes: the payload of Pconst_char from char to int  type safety. https://github.com/rescript-lang/syntax/pull/709
+
 # 10.1.0-rc.2
 
 #### :bug: Bug Fix
@@ -74,6 +80,7 @@
 - Change the internal representation of props for the lowercase components to record. https://github.com/rescript-lang/syntax/pull/665
 - Add `JsxPPXReactSupport` module to relocate the helper functions for JSX v4 from `rescript-react`
 
+
 # 10.1.0-alpha.2
 
 #### :rocket: New Feature
diff --git a/jscomp/core/js_dump.ml b/jscomp/core/js_dump.ml
index 4063b60bde..7bc42e1164 100644
--- a/jscomp/core/js_dump.ml
+++ b/jscomp/core/js_dump.ml
@@ -630,7 +630,7 @@ and expression_desc cxt ~(level : int) f x : cxt =
         match v with
         | Float { f } -> Js_number.caml_float_literal_to_js_string f
         (* attach string here for float constant folding?*)
-        | Int { i; c = Some c } -> Format.asprintf "/* %C */%ld" c i
+        | Int { i; c = Some c } -> Format.asprintf "/* %s */%ld" (Ext_util.string_of_int_as_char c) i
         | Int { i; c = None } ->
             Int32.to_string i
             (* check , js convention with ocaml lexical convention *)
diff --git a/jscomp/core/js_exp_make.mli b/jscomp/core/js_exp_make.mli
index 0c9ef3bd28..351663cceb 100644
--- a/jscomp/core/js_exp_make.mli
+++ b/jscomp/core/js_exp_make.mli
@@ -103,7 +103,7 @@ val method_ :
 
 val econd : ?comment:string -> t -> t -> t -> t
 
-val int : ?comment:string -> ?c:char -> int32 -> t
+val int : ?comment:string -> ?c:int -> int32 -> t
 
 val uint32 : ?comment:string -> int32 -> t
 
diff --git a/jscomp/core/js_of_lam_string.ml b/jscomp/core/js_of_lam_string.ml
index 6ba28e7037..1ec3f77e98 100644
--- a/jscomp/core/js_of_lam_string.ml
+++ b/jscomp/core/js_of_lam_string.ml
@@ -29,7 +29,7 @@ module E = Js_exp_make
     currently, it follows the same patten of ocaml, [char] is [int]
 *)
 
-let const_char (i : char) = E.int ~c:i (Int32.of_int @@ Char.code i)
+let const_char (i : int) = E.int ~c:i (Int32.of_int @@ i)
 
 (* string [s[i]] expects to return a [ocaml_char] *)
 let ref_string e e1 = E.string_index e e1
diff --git a/jscomp/core/js_of_lam_string.mli b/jscomp/core/js_of_lam_string.mli
index cb3f2aeb10..eb6ca708dd 100644
--- a/jscomp/core/js_of_lam_string.mli
+++ b/jscomp/core/js_of_lam_string.mli
@@ -34,6 +34,6 @@ val ref_byte : J.expression -> J.expression -> J.expression
 
 val set_byte : J.expression -> J.expression -> J.expression -> J.expression
 
-val const_char : char -> J.expression
+val const_char : int -> J.expression
 
 val bytes_to_string : J.expression -> J.expression
diff --git a/jscomp/core/js_op.ml b/jscomp/core/js_op.ml
index b7e25e2f4a..4e40d3eb5b 100644
--- a/jscomp/core/js_op.ml
+++ b/jscomp/core/js_op.ml
@@ -126,7 +126,7 @@ type float_lit = { f : string } [@@unboxed]
 
 type number =
   | Float of float_lit
-  | Int of { i : int32; c : char option }
+  | Int of { i : int32; c : int option }
   | Uint of int32
 
 (* becareful when constant folding +/-,
diff --git a/jscomp/core/lam.ml b/jscomp/core/lam.ml
index 2915b1f5f7..989c047ac3 100644
--- a/jscomp/core/lam.ml
+++ b/jscomp/core/lam.ml
@@ -562,7 +562,7 @@ let prim ~primitive:(prim : Lam_primitive.t) ~args loc : t =
       | ( (Pstringrefs | Pstringrefu),
           Const_string { s = a; unicode = false },
           Const_int { i = b } ) -> (
-          try Lift.char (String.get a (Int32.to_int b)) with _ -> default ())
+          try Lift.char (Char.code (String.get a (Int32.to_int b))) with _ -> default ())
       | _ -> default ())
   | _ -> (
       match prim with
@@ -633,7 +633,7 @@ let rec complete_range (sw_consts : (int * _) list) ~(start : int) ~finish =
 let rec eval_const_as_bool (v : Lam_constant.t) : bool =
   match v with
   | Const_int { i = x } -> x <> 0l
-  | Const_char x -> Char.code x <> 0
+  | Const_char x -> x <> 0
   | Const_int64 x -> x <> 0L
   | Const_js_false | Const_js_null | Const_module_alias | Const_js_undefined ->
       false
diff --git a/jscomp/core/lam_constant.ml b/jscomp/core/lam_constant.ml
index 547c5be174..5775e9b461 100644
--- a/jscomp/core/lam_constant.ml
+++ b/jscomp/core/lam_constant.ml
@@ -42,7 +42,7 @@ type t =
   | Const_js_true
   | Const_js_false
   | Const_int of { i : int32; comment : pointer_info }
-  | Const_char of char
+  | Const_char of int
   | Const_string of { s : string; unicode : bool }
   | Const_float of string
   | Const_int64 of int64
diff --git a/jscomp/core/lam_constant.mli b/jscomp/core/lam_constant.mli
index eeb61134dd..4fdb33b1c9 100644
--- a/jscomp/core/lam_constant.mli
+++ b/jscomp/core/lam_constant.mli
@@ -38,7 +38,7 @@ type t =
   | Const_js_true
   | Const_js_false
   | Const_int of { i : int32; comment : pointer_info }
-  | Const_char of char
+  | Const_char of int
   | Const_string of { s : string; unicode : bool }
   | Const_float of string
   | Const_int64 of int64
diff --git a/jscomp/core/lam_pass_lets_dce.ml b/jscomp/core/lam_pass_lets_dce.ml
index 6220be37e3..2a107799b3 100644
--- a/jscomp/core/lam_pass_lets_dce.ml
+++ b/jscomp/core/lam_pass_lets_dce.ml
@@ -209,7 +209,7 @@ let lets_helper (count_var : Ident.t -> Lam_pass_count.used_info) lam : Lam.t =
           |Lconst((Const_int {i})) -> 
             let i = Int32.to_int i in
             if i < String.length l_s && i >= 0  then
-              Lam.const ((Const_char l_s.[i]))
+              Lam.const ((Const_char (Char.code l_s.[i])))
             else 
               Lam.prim ~primitive ~args:[l';r'] loc 
           | _ -> 
diff --git a/jscomp/core/lam_pass_lets_dce.pp.ml b/jscomp/core/lam_pass_lets_dce.pp.ml
index 7005041ee3..681c83919e 100644
--- a/jscomp/core/lam_pass_lets_dce.pp.ml
+++ b/jscomp/core/lam_pass_lets_dce.pp.ml
@@ -208,7 +208,7 @@ let lets_helper (count_var : Ident.t -> Lam_pass_count.used_info) lam : Lam.t =
           |Lconst((Const_int {i})) -> 
             let i = Int32.to_int i in
             if i < String.length l_s && i >= 0  then
-              Lam.const ((Const_char l_s.[i]))
+              Lam.const ((Const_char (Char.code l_s.[i])))
             else 
               Lam.prim ~primitive ~args:[l';r'] loc 
           | _ -> 
diff --git a/jscomp/core/lam_print.ml b/jscomp/core/lam_print.ml
index 80188805e8..b6cb43989a 100644
--- a/jscomp/core/lam_print.ml
+++ b/jscomp/core/lam_print.ml
@@ -21,7 +21,7 @@ let rec struct_const ppf (cst : Lam_constant.t) =
   | Const_module_alias -> fprintf ppf "#alias"
   | Const_js_undefined -> fprintf ppf "#undefined"
   | Const_int { i } -> fprintf ppf "%ld" i
-  | Const_char c -> fprintf ppf "%C" c
+  | Const_char i -> fprintf ppf "%s" (Ext_util.string_of_int_as_char i)
   | Const_string { s } -> fprintf ppf "%S" s
   | Const_float f -> fprintf ppf "%s" f
   | Const_int64 n -> fprintf ppf "%LiL" n
diff --git a/jscomp/ext/ext_utf8.ml b/jscomp/ext/ext_utf8.ml
index 281bfb7a0c..0d02b2c573 100644
--- a/jscomp/ext/ext_utf8.ml
+++ b/jscomp/ext/ext_utf8.ml
@@ -92,3 +92,40 @@ let decode_utf8_string s =
 
 (* let verify s loc =
    assert false *)
+
+let encode_codepoint c =
+  (* reused from syntax/src/res_utf8.ml *)
+  let h2 = 0b1100_0000 in
+  let h3 = 0b1110_0000 in
+  let h4 = 0b1111_0000 in
+  let cont_mask = 0b0011_1111 in
+  if c <= 127 then (
+    let bytes = (Bytes.create [@doesNotRaise]) 1 in
+    Bytes.unsafe_set bytes 0 (Char.unsafe_chr c);
+    Bytes.unsafe_to_string bytes)
+  else if c <= 2047 then (
+    let bytes = (Bytes.create [@doesNotRaise]) 2 in
+    Bytes.unsafe_set bytes 0 (Char.unsafe_chr (h2 lor (c lsr 6)));
+    Bytes.unsafe_set bytes 1
+      (Char.unsafe_chr (0b1000_0000 lor (c land cont_mask)));
+    Bytes.unsafe_to_string bytes)
+  else if c <= 65535 then (
+    let bytes = (Bytes.create [@doesNotRaise]) 3 in
+    Bytes.unsafe_set bytes 0 (Char.unsafe_chr (h3 lor (c lsr 12)));
+    Bytes.unsafe_set bytes 1
+      (Char.unsafe_chr (0b1000_0000 lor ((c lsr 6) land cont_mask)));
+    Bytes.unsafe_set bytes 2
+      (Char.unsafe_chr (0b1000_0000 lor (c land cont_mask)));
+    Bytes.unsafe_to_string bytes)
+  else
+    (* if c <= max then *)
+    let bytes = (Bytes.create [@doesNotRaise]) 4 in
+    Bytes.unsafe_set bytes 0 (Char.unsafe_chr (h4 lor (c lsr 18)));
+    Bytes.unsafe_set bytes 1
+      (Char.unsafe_chr (0b1000_0000 lor ((c lsr 12) land cont_mask)));
+    Bytes.unsafe_set bytes 2
+      (Char.unsafe_chr (0b1000_0000 lor ((c lsr 6) land cont_mask)));
+    Bytes.unsafe_set bytes 3
+      (Char.unsafe_chr (0b1000_0000 lor (c land cont_mask)));
+    Bytes.unsafe_to_string bytes
+
diff --git a/jscomp/ext/ext_utf8.mli b/jscomp/ext/ext_utf8.mli
index 2f29717c12..e1beadec59 100644
--- a/jscomp/ext/ext_utf8.mli
+++ b/jscomp/ext/ext_utf8.mli
@@ -36,3 +36,5 @@ val next : string -> remaining:int -> int -> int
 exception Invalid_utf8 of string
 
 val decode_utf8_string : string -> int list
+
+val encode_codepoint : int -> string
diff --git a/jscomp/ext/ext_util.ml b/jscomp/ext/ext_util.ml
index 0664f4aac5..1be75ff117 100644
--- a/jscomp/ext/ext_util.ml
+++ b/jscomp/ext/ext_util.ml
@@ -40,3 +40,22 @@ let stats_to_string
     num_buckets max_bucket_length
     (String.concat ","
        (Array.to_list (Array.map string_of_int bucket_histogram)))
+
+let string_of_int_as_char (i : int) : string =
+  if i <= 255 && i >= 0 then Format.asprintf "%C" (Char.unsafe_chr i)
+  else
+    let str =
+      match Char.unsafe_chr i with
+      | '\'' -> "\\'"
+      | '\\' -> "\\\\"
+      | '\n' -> "\\n"
+      | '\t' -> "\\t"
+      | '\r' -> "\\r"
+      | '\b' -> "\\b"
+      | ' ' .. '~' as c ->
+          let s = (Bytes.create [@doesNotRaise]) 1 in
+          Bytes.unsafe_set s 0 c;
+          Bytes.unsafe_to_string s
+      | _ -> Ext_utf8.encode_codepoint i
+    in
+    Printf.sprintf "\'%s\'" str
diff --git a/jscomp/ext/ext_util.mli b/jscomp/ext/ext_util.mli
index 6b73837687..d31d11a90b 100644
--- a/jscomp/ext/ext_util.mli
+++ b/jscomp/ext/ext_util.mli
@@ -25,3 +25,6 @@
 val power_2_above : int -> int -> int
 
 val stats_to_string : Hashtbl.statistics -> string
+
+val string_of_int_as_char : int -> string
+
diff --git a/jscomp/ml/ast_helper.ml b/jscomp/ml/ast_helper.ml
index 2d1f9b565b..80fb40a1c7 100644
--- a/jscomp/ml/ast_helper.ml
+++ b/jscomp/ml/ast_helper.ml
@@ -39,7 +39,7 @@ module Const = struct
   let int64 ?(suffix='L') i = integer ~suffix (Int64.to_string i)
   let nativeint ?(suffix='n') i = integer ~suffix (Nativeint.to_string i)
   let float ?suffix f = Pconst_float (f, suffix)
-  let char c = Pconst_char c
+  let char c = Pconst_char (Char.code c)
   let string ?quotation_delimiter s = Pconst_string (s, quotation_delimiter)
 end
 
diff --git a/jscomp/ml/asttypes.ml b/jscomp/ml/asttypes.ml
index 9c6f4aea36..8fefc45283 100644
--- a/jscomp/ml/asttypes.ml
+++ b/jscomp/ml/asttypes.ml
@@ -17,7 +17,7 @@
 
 type constant =
     Const_int of int
-  | Const_char of char
+  | Const_char of int
   | Const_string of string * string option
   | Const_float of string
   | Const_int32 of int32
@@ -70,4 +70,4 @@ let same_arg_label (x : arg_label) y =
       begin match y with 
       | Optional s0 -> s = s0
       | _ -> false  
-      end  
\ No newline at end of file
+      end  
diff --git a/jscomp/ml/matching.ml b/jscomp/ml/matching.ml
index e65cb7a21e..4802a3dbf8 100644
--- a/jscomp/ml/matching.ml
+++ b/jscomp/ml/matching.ml
@@ -2202,7 +2202,7 @@ let combine_constant names loc arg cst partial ctx def
         call_switcher loc fail arg min_int max_int int_lambda_list names
     | Const_char _ ->
         let int_lambda_list =
-          List.map (function Const_char c, l -> (Char.code c, l)
+          List.map (function Const_char c, l -> (c, l)
             | _ -> assert false)
             const_lambda_list in
         call_switcher loc fail arg 0 max_int int_lambda_list names
diff --git a/jscomp/ml/parmatch.ml b/jscomp/ml/parmatch.ml
index ef5440c7ee..e06991290b 100644
--- a/jscomp/ml/parmatch.ml
+++ b/jscomp/ml/parmatch.ml
@@ -379,7 +379,7 @@ let is_cons = function
 
 let pretty_const c = match c with
 | Const_int i -> Printf.sprintf "%d" i
-| Const_char c -> Printf.sprintf "%C" c
+| Const_char i -> Printf.sprintf "%s" (Pprintast.string_of_int_as_char i)
 | Const_string (s, _) -> Printf.sprintf "%S" s
 | Const_float f -> Printf.sprintf "%s" f
 | Const_int32 i -> Printf.sprintf "%ldl" i
@@ -1037,7 +1037,7 @@ let build_other_constant proj make first next p env =
 
 let some_other_tag = "<some other tag>"
 
-let build_other ext env = match env with
+let build_other ext env : Typedtree.pattern = match env with
 | ({pat_desc = Tpat_construct (lid, {cstr_tag=Cstr_extension _},_)},_) :: _ ->
         (* let c = {c with cstr_name = "*extension*"} in *) (* PR#7330 *)
         make_pat (Tpat_var (Ident.create "*extension*",
@@ -1079,13 +1079,19 @@ let build_other ext env = match env with
             make_pat (Tpat_or (pat, p_res, None)) p.pat_type p.pat_env)
           pat other_pats
     end
-| ({pat_desc=(Tpat_constant (Const_int _ | Const_char _))} as p,_) :: _ ->
+| ({pat_desc=(Tpat_constant (Const_int _ ))} as p,_) :: _ ->
     build_other_constant
       (function Tpat_constant(Const_int i) -> i 
-      | Tpat_constant (Const_char i) -> Char.code i
       | _ -> assert false)
       (function i -> Tpat_constant(Const_int i))
       0 succ p env
+| ({pat_desc=(Tpat_constant (Const_char _ ))} as p,_) :: _ ->
+        build_other_constant
+          (function 
+          | Tpat_constant (Const_char i) -> i
+          | _ -> assert false)
+          (function i -> Tpat_constant(Const_char i))
+          0 succ p env      
 | ({pat_desc=(Tpat_constant (Const_int32 _))} as p,_) :: _ ->
     build_other_constant
       (function Tpat_constant(Const_int32 i) -> i | _ -> assert false)
diff --git a/jscomp/ml/parser.ml b/jscomp/ml/parser.ml
index 5ddf83e25f..31527ccc9c 100644
--- a/jscomp/ml/parser.ml
+++ b/jscomp/ml/parser.ml
@@ -11015,7 +11015,7 @@ let yyact = [|
     let _1 = (Parsing.peek_val __caml_parser_env 0 : char) in
     Obj.repr(
 # 2155 "ml/parser.mly"
-                 ( Pconst_char _1 )
+                 ( Pconst_char (Char.code _1) )
 # 11020 "ml/parser.ml"
                : 'constant))
 ; (fun __caml_parser_env ->
diff --git a/jscomp/ml/parser.mly b/jscomp/ml/parser.mly
index dc1fca4229..fe4ace9a4e 100644
--- a/jscomp/ml/parser.mly
+++ b/jscomp/ml/parser.mly
@@ -2152,7 +2152,7 @@ label:
 
 constant:
   | INT          { let (n, m) = $1 in Pconst_integer (n, m) }
-  | CHAR         { Pconst_char $1 }
+  | CHAR         { Pconst_char (Char.code $1) }
   | STRING       { let (s, d) = $1 in Pconst_string (s, d) }
   | FLOAT        { let (f, m) = $1 in Pconst_float (f, m) }
 ;
diff --git a/jscomp/ml/parsetree.ml b/jscomp/ml/parsetree.ml
index d2b997ab41..ebf1837755 100644
--- a/jscomp/ml/parsetree.ml
+++ b/jscomp/ml/parsetree.ml
@@ -24,7 +24,7 @@ type constant =
      Suffixes [g-z][G-Z] are accepted by the parser.
      Suffixes except 'l', 'L' and 'n' are rejected by the typechecker
   *)
-  | Pconst_char of char
+  | Pconst_char of int
   (* 'c' *)
   | Pconst_string of string * string option
   (* "constant"
diff --git a/jscomp/ml/pprintast.ml b/jscomp/ml/pprintast.ml
index 8c0ec6d74d..37d549bb77 100644
--- a/jscomp/ml/pprintast.ml
+++ b/jscomp/ml/pprintast.ml
@@ -192,8 +192,10 @@ let rec longident f = function
 
 let longident_loc f x = pp f "%a" longident x.txt
 
+let string_of_int_as_char i = Ext_util.string_of_int_as_char i
+
 let constant f = function
-  | Pconst_char i -> pp f "%C"  i
+  | Pconst_char i -> pp f "%s"  (string_of_int_as_char i)
   | Pconst_string (i, None) -> pp f "%S" i
   | Pconst_string (i, Some delim) -> pp f "{%s|%s|%s}" delim i delim
   | Pconst_integer (i, None) -> paren (i.[0]='-') (fun f -> pp f "%s") f i
@@ -770,7 +772,7 @@ and value_description ctxt f x =
   pp f "@[<hov2>%a%a@]" (core_type ctxt) x.pval_type
     (fun f x ->
       
-# 772 "ml/pprintast.pp.ml"
+# 774 "ml/pprintast.pp.ml"
       match x.pval_prim with 
       | first :: second :: _ 
         when Ext_string.first_marshal_char second
@@ -783,7 +785,7 @@ and value_description ctxt f x =
         pp f "@ =@ %a" (list constant_string) x.pval_prim
       
     
-# 787 "ml/pprintast.pp.ml"
+# 789 "ml/pprintast.pp.ml"
     ) x
 
 and extension ctxt f (s, e) =
diff --git a/jscomp/ml/pprintast.mli b/jscomp/ml/pprintast.mli
index 18ffa38b0c..7da9ee0d12 100644
--- a/jscomp/ml/pprintast.mli
+++ b/jscomp/ml/pprintast.mli
@@ -24,3 +24,4 @@ val pattern: Format.formatter -> Parsetree.pattern -> unit
 val signature: Format.formatter -> Parsetree.signature -> unit
 val structure: Format.formatter -> Parsetree.structure -> unit
 val string_of_structure: Parsetree.structure -> string
+val string_of_int_as_char: int -> string
diff --git a/jscomp/ml/pprintast.pp.ml b/jscomp/ml/pprintast.pp.ml
index 2bdeb8b923..b531404ef6 100644
--- a/jscomp/ml/pprintast.pp.ml
+++ b/jscomp/ml/pprintast.pp.ml
@@ -191,8 +191,10 @@ let rec longident f = function
 
 let longident_loc f x = pp f "%a" longident x.txt
 
+let string_of_int_as_char i = Ext_util.string_of_int_as_char i
+
 let constant f = function
-  | Pconst_char i -> pp f "%C"  i
+  | Pconst_char i -> pp f "%s"  (string_of_int_as_char i)
   | Pconst_string (i, None) -> pp f "%S" i
   | Pconst_string (i, Some delim) -> pp f "{%s|%s|%s}" delim i delim
   | Pconst_integer (i, None) -> paren (i.[0]='-') (fun f -> pp f "%s") f i
diff --git a/jscomp/ml/printast.ml b/jscomp/ml/printast.ml
index 3ab833359c..eee7a90517 100644
--- a/jscomp/ml/printast.ml
+++ b/jscomp/ml/printast.ml
@@ -60,7 +60,7 @@ let fmt_char_option f = function
 let fmt_constant f x =
   match x with
   | Pconst_integer (i,m) -> fprintf f "PConst_int (%s,%a)" i fmt_char_option m;
-  | Pconst_char (c) -> fprintf f "PConst_char %02x" (Char.code c);
+  | Pconst_char (c) -> fprintf f "PConst_char %02x" c;
   | Pconst_string (s, None) -> fprintf f "PConst_string(%S,None)" s;
   | Pconst_string (s, Some delim) ->
       fprintf f "PConst_string (%S,Some %S)" s delim;
diff --git a/jscomp/ml/printlambda.ml b/jscomp/ml/printlambda.ml
index 636834bed9..8542238594 100644
--- a/jscomp/ml/printlambda.ml
+++ b/jscomp/ml/printlambda.ml
@@ -21,7 +21,7 @@ open Lambda
 
 let rec struct_const ppf = function
   | Const_base(Const_int n) -> fprintf ppf "%i" n
-  | Const_base(Const_char c) -> fprintf ppf "%C" c
+  | Const_base(Const_char i) -> fprintf ppf "%s" (Pprintast.string_of_int_as_char i)
   | Const_base(Const_string (s, _)) -> fprintf ppf "%S" s
   | Const_immstring s -> fprintf ppf "#%S" s
   | Const_base(Const_float f) -> fprintf ppf "%s" f
diff --git a/jscomp/ml/printtyped.ml b/jscomp/ml/printtyped.ml
index 09e348c9fe..f6243f6c6e 100644
--- a/jscomp/ml/printtyped.ml
+++ b/jscomp/ml/printtyped.ml
@@ -58,7 +58,7 @@ let fmt_path f x = fprintf f "\"%a\"" fmt_path_aux x;;
 let fmt_constant f x =
   match x with
   | Const_int (i) -> fprintf f "Const_int %d" i;
-  | Const_char (c) -> fprintf f "Const_char %02x" (Char.code c);
+  | Const_char (c) -> fprintf f "Const_char %02x" c;
   | Const_string (s, None) -> fprintf f "Const_string(%S,None)" s;
   | Const_string (s, Some delim) ->
       fprintf f "Const_string (%S,Some %S)" s delim;
diff --git a/jscomp/ml/typecore.ml b/jscomp/ml/typecore.ml
index 012cdd765c..59e0cda9d8 100644
--- a/jscomp/ml/typecore.ml
+++ b/jscomp/ml/typecore.ml
@@ -1009,7 +1009,7 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env
         else
           or_ ~loc:gloc
             (constant ~loc:gloc (Pconst_char c1))
-            (loop (Char.chr(Char.code c1 + 1)) c2)
+            (loop (c1 + 1) c2)
       in
       let p = if c1 <= c2 then loop c1 c2 else loop c2 c1 in
       let p = {p with ppat_loc=loc} in
diff --git a/jscomp/napkin/CHANGELOG.md b/jscomp/napkin/CHANGELOG.md
index 064b2d342c..bd63726ca9 100644
--- a/jscomp/napkin/CHANGELOG.md
+++ b/jscomp/napkin/CHANGELOG.md
@@ -59,6 +59,7 @@
 #### :nail_care Polish
 
 - Change the internal representation of props for the lowercase components to record. https://github.com/rescript-lang/syntax/pull/665
+- Change the payload of Pconst_char for type safety. https://github.com/rescript-lang/rescript-compiler/pull/5759
 
 ## ReScript 10.0
 
diff --git a/jscomp/test/build.ninja b/jscomp/test/build.ninja
index 0940c846b6..ed61ae122c 100644
--- a/jscomp/test/build.ninja
+++ b/jscomp/test/build.ninja
@@ -333,6 +333,8 @@ o test/gpr_5169_test.cmi test/gpr_5169_test.cmj : cc test/gpr_5169_test.ml | $bs
 o test/gpr_5218_test.cmi test/gpr_5218_test.cmj : cc test/gpr_5218_test.res | test/mt.cmj $bsc $stdlib runtime
 o test/gpr_5280_optimize_test.cmi test/gpr_5280_optimize_test.cmj : cc test/gpr_5280_optimize_test.ml | $bsc $stdlib runtime
 o test/gpr_5312.cmi test/gpr_5312.cmj : cc test/gpr_5312.res | $bsc $stdlib runtime
+o test/gpr_5557.cmi test/gpr_5557.cmj : cc test/gpr_5557.res | $bsc $stdlib runtime
+o test/gpr_5753.cmi test/gpr_5753.cmj : cc test/gpr_5753.res | $bsc $stdlib runtime
 o test/gpr_627_test.cmi test/gpr_627_test.cmj : cc test/gpr_627_test.ml | test/mt.cmj $bsc $stdlib runtime
 o test/gpr_658.cmi test/gpr_658.cmj : cc test/gpr_658.ml | $bsc $stdlib runtime
 o test/gpr_858_test.cmi test/gpr_858_test.cmj : cc test/gpr_858_test.ml | $bsc $stdlib runtime
@@ -735,4 +737,4 @@ o test/utf8_decode_test.cmi test/utf8_decode_test.cmj : cc test/utf8_decode_test
 o test/variant.cmi test/variant.cmj : cc test/variant.ml | $bsc $stdlib runtime
 o test/watch_test.cmi test/watch_test.cmj : cc test/watch_test.ml | $bsc $stdlib runtime
 o test/webpack_config.cmi test/webpack_config.cmj : cc test/webpack_config.ml | $bsc $stdlib runtime
-o test : phony test/406_primitive_test.cmi test/406_primitive_test.cmj test/EmptyRecord.cmi test/EmptyRecord.cmj test/SafePromises.cmi test/SafePromises.cmj test/a.cmi test/a.cmj test/a_filename_test.cmi test/a_filename_test.cmj test/a_list_test.cmi test/a_list_test.cmj test/a_recursive_type.cmi test/a_recursive_type.cmj test/a_scope_bug.cmi test/a_scope_bug.cmj test/a_string_test.cmi test/a_string_test.cmj test/abstract_type.cmi test/abstract_type.cmj test/adt_optimize_test.cmi test/adt_optimize_test.cmj test/alias_test.cmi test/alias_test.cmj test/and_or_tailcall_test.cmi test/and_or_tailcall_test.cmj test/app_root_finder.cmi test/app_root_finder.cmj test/argv_test.cmi test/argv_test.cmj test/ari_regress_test.cmi test/ari_regress_test.cmj test/arith_lexer.cmi test/arith_lexer.cmj test/arith_parser.cmi test/arith_parser.cmj test/arith_syntax.cmi test/arith_syntax.cmj test/arity.cmi test/arity.cmj test/arity_deopt.cmi test/arity_deopt.cmj test/arity_infer.cmi test/arity_infer.cmj test/arity_ml.cmi test/arity_ml.cmj test/array_data_util.cmi test/array_data_util.cmj test/array_safe_get.cmi test/array_safe_get.cmj test/array_subtle_test.cmi test/array_subtle_test.cmj test/array_test.cmi test/array_test.cmj test/ast_abstract_test.cmi test/ast_abstract_test.cmj test/ast_js_mapper_poly_test.cmi test/ast_js_mapper_poly_test.cmj test/ast_js_mapper_test.cmi test/ast_js_mapper_test.cmj test/ast_mapper_defensive_test.cmi test/ast_mapper_defensive_test.cmj test/ast_mapper_unused_warning_test.cmi test/ast_mapper_unused_warning_test.cmj test/async_ideas.cmi test/async_ideas.cmj test/async_inline.cmi test/async_inline.cmj test/attr_test.cmi test/attr_test.cmj test/b.cmi test/b.cmj test/bal_set_mini.cmi test/bal_set_mini.cmj test/bang_primitive.cmi test/bang_primitive.cmj test/basic_module_test.cmi test/basic_module_test.cmj test/bb.cmi test/bb.cmj test/bdd.cmi test/bdd.cmj test/belt_internal_test.cmi test/belt_internal_test.cmj test/belt_result_alias_test.cmi test/belt_result_alias_test.cmj test/bench.cmi test/bench.cmj test/big_enum.cmi test/big_enum.cmj test/big_polyvar_test.cmi test/big_polyvar_test.cmj test/block_alias_test.cmi test/block_alias_test.cmj test/boolean_test.cmi test/boolean_test.cmj test/bs_MapInt_test.cmi test/bs_MapInt_test.cmj test/bs_abstract_test.cmi test/bs_abstract_test.cmj test/bs_array_test.cmi test/bs_array_test.cmj test/bs_auto_uncurry.cmi test/bs_auto_uncurry.cmj test/bs_auto_uncurry_test.cmi test/bs_auto_uncurry_test.cmj test/bs_float_test.cmi test/bs_float_test.cmj test/bs_hashmap_test.cmi test/bs_hashmap_test.cmj test/bs_hashset_int_test.cmi test/bs_hashset_int_test.cmj test/bs_hashtbl_string_test.cmi test/bs_hashtbl_string_test.cmj test/bs_ignore_effect.cmi test/bs_ignore_effect.cmj test/bs_ignore_test.cmi test/bs_ignore_test.cmj test/bs_int_test.cmi test/bs_int_test.cmj test/bs_list_test.cmi test/bs_list_test.cmj test/bs_map_set_dict_test.cmi test/bs_map_set_dict_test.cmj test/bs_map_test.cmi test/bs_map_test.cmj test/bs_min_max_test.cmi test/bs_min_max_test.cmj test/bs_mutable_set_test.cmi test/bs_mutable_set_test.cmj test/bs_node_string_buffer_test.cmi test/bs_node_string_buffer_test.cmj test/bs_poly_map_test.cmi test/bs_poly_map_test.cmj test/bs_poly_mutable_map_test.cmi test/bs_poly_mutable_map_test.cmj test/bs_poly_mutable_set_test.cmi test/bs_poly_mutable_set_test.cmj test/bs_poly_set_test.cmi test/bs_poly_set_test.cmj test/bs_qualified.cmi test/bs_qualified.cmj test/bs_queue_test.cmi test/bs_queue_test.cmj test/bs_rbset_int_bench.cmi test/bs_rbset_int_bench.cmj test/bs_rest_test.cmi test/bs_rest_test.cmj test/bs_set_bench.cmi test/bs_set_bench.cmj test/bs_set_int_test.cmi test/bs_set_int_test.cmj test/bs_sort_test.cmi test/bs_sort_test.cmj test/bs_splice_partial.cmi test/bs_splice_partial.cmj test/bs_stack_test.cmi test/bs_stack_test.cmj test/bs_string_test.cmi test/bs_string_test.cmj test/bs_unwrap_test.cmi test/bs_unwrap_test.cmj test/buffer_test.cmi test/buffer_test.cmj test/bytes_split_gpr_743_test.cmi test/bytes_split_gpr_743_test.cmj test/caml_compare_test.cmi test/caml_compare_test.cmj test/caml_format_test.cmi test/caml_format_test.cmj test/caml_sys_poly_fill_test.cmi test/caml_sys_poly_fill_test.cmj test/chain_code_test.cmi test/chain_code_test.cmj test/chn_test.cmi test/chn_test.cmj test/class_setter_getter.cmi test/class_setter_getter.cmj test/class_type_ffi_test.cmi test/class_type_ffi_test.cmj test/coercion_module_alias_test.cmi test/coercion_module_alias_test.cmj test/compare_test.cmi test/compare_test.cmj test/complete_parmatch_test.cmi test/complete_parmatch_test.cmj test/complex_if_test.cmi test/complex_if_test.cmj test/complex_test.cmi test/complex_test.cmj test/complex_while_loop.cmi test/complex_while_loop.cmj test/condition_compilation_test.cmi test/condition_compilation_test.cmj test/config1_test.cmi test/config1_test.cmj test/config2_test.cmi test/config2_test.cmj test/console_log_test.cmi test/console_log_test.cmj test/const_block_test.cmi test/const_block_test.cmj test/const_defs.cmi test/const_defs.cmj test/const_defs_test.cmi test/const_defs_test.cmj test/const_test.cmi test/const_test.cmj test/cont_int_fold_test.cmi test/cont_int_fold_test.cmj test/cps_test.cmi test/cps_test.cmj test/cross_module_inline_test.cmi test/cross_module_inline_test.cmj test/custom_error_test.cmi test/custom_error_test.cmj test/debug_keep_test.cmi test/debug_keep_test.cmj test/debug_mode_value.cmi test/debug_mode_value.cmj test/debug_tmp.cmi test/debug_tmp.cmj test/debugger_test.cmi test/debugger_test.cmj test/default_export_test.cmi test/default_export_test.cmj test/defunctor_make_test.cmi test/defunctor_make_test.cmj test/demo.cmi test/demo.cmj test/demo_binding.cmi test/demo_binding.cmj test/demo_int_map.cmi test/demo_int_map.cmj test/demo_page.cmi test/demo_page.cmj test/demo_pipe.cmi test/demo_pipe.cmj test/derive_dyntype.cmi test/derive_dyntype.cmj test/derive_projector_test.cmi test/derive_projector_test.cmj test/derive_type_test.cmi test/derive_type_test.cmj test/digest_test.cmi test/digest_test.cmj test/div_by_zero_test.cmi test/div_by_zero_test.cmj test/dollar_escape_test.cmi test/dollar_escape_test.cmj test/earger_curry_test.cmi test/earger_curry_test.cmj test/effect.cmi test/effect.cmj test/epsilon_test.cmi test/epsilon_test.cmj test/equal_box_test.cmi test/equal_box_test.cmj test/equal_exception_test.cmi test/equal_exception_test.cmj test/equal_test.cmi test/equal_test.cmj test/es6_export.cmi test/es6_export.cmj test/es6_import.cmi test/es6_import.cmj test/es6_module_test.cmi test/es6_module_test.cmj test/escape_esmodule.cmi test/escape_esmodule.cmj test/esmodule_ref.cmi test/esmodule_ref.cmj test/event_ffi.cmi test/event_ffi.cmj test/exception_alias.cmi test/exception_alias.cmj test/exception_def.cmi test/exception_def.cmj test/exception_raise_test.cmi test/exception_raise_test.cmj test/exception_rebind_test.cmi test/exception_rebind_test.cmj test/exception_rebound_err_test.cmi test/exception_rebound_err_test.cmj test/exception_repr_test.cmi test/exception_repr_test.cmj test/exception_value_test.cmi test/exception_value_test.cmj test/exn_error_pattern.cmi test/exn_error_pattern.cmj test/export_keyword.cmi test/export_keyword.cmj test/ext_array_test.cmi test/ext_array_test.cmj test/ext_bytes_test.cmi test/ext_bytes_test.cmj test/ext_filename_test.cmi test/ext_filename_test.cmj test/ext_list_test.cmi test/ext_list_test.cmj test/ext_pervasives_test.cmi test/ext_pervasives_test.cmj test/ext_string_test.cmi test/ext_string_test.cmj test/ext_sys_test.cmi test/ext_sys_test.cmj test/extensible_variant_test.cmi test/extensible_variant_test.cmj test/external_polyfill_test.cmi test/external_polyfill_test.cmj test/external_ppx.cmi test/external_ppx.cmj test/external_ppx2.cmi test/external_ppx2.cmj test/fail_comp.cmi test/fail_comp.cmj test/ffi_arity_test.cmi test/ffi_arity_test.cmj test/ffi_array_test.cmi test/ffi_array_test.cmj test/ffi_js_test.cmi test/ffi_js_test.cmj test/ffi_splice_test.cmi test/ffi_splice_test.cmj test/ffi_test.cmi test/ffi_test.cmj test/fib.cmi test/fib.cmj test/flattern_order_test.cmi test/flattern_order_test.cmj test/flexible_array_test.cmi test/flexible_array_test.cmj test/float_array.cmi test/float_array.cmj test/float_of_bits_test.cmi test/float_of_bits_test.cmj test/float_record.cmi test/float_record.cmj test/float_test.cmi test/float_test.cmj test/floatarray_test.cmi test/floatarray_test.cmj test/flow_parser_reg_test.cmi test/flow_parser_reg_test.cmj test/for_loop_test.cmi test/for_loop_test.cmj test/for_side_effect_test.cmi test/for_side_effect_test.cmj test/format_regression.cmi test/format_regression.cmj test/format_test.cmi test/format_test.cmj test/fs_test.cmi test/fs_test.cmj test/fun_pattern_match.cmi test/fun_pattern_match.cmj test/functor_app_test.cmi test/functor_app_test.cmj test/functor_def.cmi test/functor_def.cmj test/functor_ffi.cmi test/functor_ffi.cmj test/functor_inst.cmi test/functor_inst.cmj test/functors.cmi test/functors.cmj test/gbk.cmi test/gbk.cmj test/genlex_test.cmi test/genlex_test.cmj test/gentTypeReTest.cmi test/gentTypeReTest.cmj test/global_exception_regression_test.cmi test/global_exception_regression_test.cmj test/global_mangles.cmi test/global_mangles.cmj test/global_module_alias_test.cmi test/global_module_alias_test.cmj test/google_closure_test.cmi test/google_closure_test.cmj test/gpr496_test.cmi test/gpr496_test.cmj test/gpr_1063_test.cmi test/gpr_1063_test.cmj test/gpr_1072.cmi test/gpr_1072.cmj test/gpr_1072_reg.cmi test/gpr_1072_reg.cmj test/gpr_1150.cmi test/gpr_1150.cmj test/gpr_1154_test.cmi test/gpr_1154_test.cmj test/gpr_1170.cmi test/gpr_1170.cmj test/gpr_1240_missing_unbox.cmi test/gpr_1240_missing_unbox.cmj test/gpr_1245_test.cmi test/gpr_1245_test.cmj test/gpr_1268.cmi test/gpr_1268.cmj test/gpr_1409_test.cmi test/gpr_1409_test.cmj test/gpr_1423_app_test.cmi test/gpr_1423_app_test.cmj test/gpr_1423_nav.cmi test/gpr_1423_nav.cmj test/gpr_1438.cmi test/gpr_1438.cmj test/gpr_1481.cmi test/gpr_1481.cmj test/gpr_1484.cmi test/gpr_1484.cmj test/gpr_1501_test.cmi test/gpr_1501_test.cmj test/gpr_1503_test.cmi test/gpr_1503_test.cmj test/gpr_1539_test.cmi test/gpr_1539_test.cmj test/gpr_1600_test.cmi test/gpr_1600_test.cmj test/gpr_1658_test.cmi test/gpr_1658_test.cmj test/gpr_1667_test.cmi test/gpr_1667_test.cmj test/gpr_1692_test.cmi test/gpr_1692_test.cmj test/gpr_1698_test.cmi test/gpr_1698_test.cmj test/gpr_1701_test.cmi test/gpr_1701_test.cmj test/gpr_1716_test.cmi test/gpr_1716_test.cmj test/gpr_1717_test.cmi test/gpr_1717_test.cmj test/gpr_1728_test.cmi test/gpr_1728_test.cmj test/gpr_1749_test.cmi test/gpr_1749_test.cmj test/gpr_1759_test.cmi test/gpr_1759_test.cmj test/gpr_1760_test.cmi test/gpr_1760_test.cmj test/gpr_1762_test.cmi test/gpr_1762_test.cmj test/gpr_1817_test.cmi test/gpr_1817_test.cmj test/gpr_1822_test.cmi test/gpr_1822_test.cmj test/gpr_1891_test.cmi test/gpr_1891_test.cmj test/gpr_1943_test.cmi test/gpr_1943_test.cmj test/gpr_1946_test.cmi test/gpr_1946_test.cmj test/gpr_2316_test.cmi test/gpr_2316_test.cmj test/gpr_2352_test.cmi test/gpr_2352_test.cmj test/gpr_2413_test.cmi test/gpr_2413_test.cmj test/gpr_2474.cmi test/gpr_2474.cmj test/gpr_2487.cmi test/gpr_2487.cmj test/gpr_2503_test.cmi test/gpr_2503_test.cmj test/gpr_2608_test.cmi test/gpr_2608_test.cmj test/gpr_2614_test.cmi test/gpr_2614_test.cmj test/gpr_2633_test.cmi test/gpr_2633_test.cmj test/gpr_2642_test.cmi test/gpr_2642_test.cmj test/gpr_2652_test.cmi test/gpr_2652_test.cmj test/gpr_2682_test.cmi test/gpr_2682_test.cmj test/gpr_2700_test.cmi test/gpr_2700_test.cmj test/gpr_2731_test.cmi test/gpr_2731_test.cmj test/gpr_2789_test.cmi test/gpr_2789_test.cmj test/gpr_2931_test.cmi test/gpr_2931_test.cmj test/gpr_3142_test.cmi test/gpr_3142_test.cmj test/gpr_3154_test.cmi test/gpr_3154_test.cmj test/gpr_3209_test.cmi test/gpr_3209_test.cmj test/gpr_3492_test.cmi test/gpr_3492_test.cmj test/gpr_3519_jsx_test.cmi test/gpr_3519_jsx_test.cmj test/gpr_3519_test.cmi test/gpr_3519_test.cmj test/gpr_3536_test.cmi test/gpr_3536_test.cmj test/gpr_3546_test.cmi test/gpr_3546_test.cmj test/gpr_3548_test.cmi test/gpr_3548_test.cmj test/gpr_3549_test.cmi test/gpr_3549_test.cmj test/gpr_3566_drive_test.cmi test/gpr_3566_drive_test.cmj test/gpr_3566_test.cmi test/gpr_3566_test.cmj test/gpr_3595_test.cmi test/gpr_3595_test.cmj test/gpr_3609_test.cmi test/gpr_3609_test.cmj test/gpr_3697_test.cmi test/gpr_3697_test.cmj test/gpr_373_test.cmi test/gpr_373_test.cmj test/gpr_3770_test.cmi test/gpr_3770_test.cmj test/gpr_3852_alias.cmi test/gpr_3852_alias.cmj test/gpr_3852_alias_reify.cmi test/gpr_3852_alias_reify.cmj test/gpr_3852_effect.cmi test/gpr_3852_effect.cmj test/gpr_3865.cmi test/gpr_3865.cmj test/gpr_3865_bar.cmi test/gpr_3865_bar.cmj test/gpr_3865_foo.cmi test/gpr_3865_foo.cmj test/gpr_3875_test.cmi test/gpr_3875_test.cmj test/gpr_3877_test.cmi test/gpr_3877_test.cmj test/gpr_3895_test.cmi test/gpr_3895_test.cmj test/gpr_3897_test.cmi test/gpr_3897_test.cmj test/gpr_3931_test.cmi test/gpr_3931_test.cmj test/gpr_3980_test.cmi test/gpr_3980_test.cmj test/gpr_4025_test.cmi test/gpr_4025_test.cmj test/gpr_405_test.cmi test/gpr_405_test.cmj test/gpr_4069_test.cmi test/gpr_4069_test.cmj test/gpr_4265_test.cmi test/gpr_4265_test.cmj test/gpr_4274_test.cmi test/gpr_4274_test.cmj test/gpr_4280_test.cmi test/gpr_4280_test.cmj test/gpr_4407_test.cmi test/gpr_4407_test.cmj test/gpr_441.cmi test/gpr_441.cmj test/gpr_4442_test.cmi test/gpr_4442_test.cmj test/gpr_4491_test.cmi test/gpr_4491_test.cmj test/gpr_4494_test.cmi test/gpr_4494_test.cmj test/gpr_4519_test.cmi test/gpr_4519_test.cmj test/gpr_459_test.cmi test/gpr_459_test.cmj test/gpr_4632.cmi test/gpr_4632.cmj test/gpr_4639_test.cmi test/gpr_4639_test.cmj test/gpr_4900_test.cmi test/gpr_4900_test.cmj test/gpr_4924_test.cmi test/gpr_4924_test.cmj test/gpr_4931.cmi test/gpr_4931.cmj test/gpr_4931_allow.cmi test/gpr_4931_allow.cmj test/gpr_5071_test.cmi test/gpr_5071_test.cmj test/gpr_5169_test.cmi test/gpr_5169_test.cmj test/gpr_5218_test.cmi test/gpr_5218_test.cmj test/gpr_5280_optimize_test.cmi test/gpr_5280_optimize_test.cmj test/gpr_5312.cmi test/gpr_5312.cmj test/gpr_627_test.cmi test/gpr_627_test.cmj test/gpr_658.cmi test/gpr_658.cmj test/gpr_858_test.cmi test/gpr_858_test.cmj test/gpr_858_unit2_test.cmi test/gpr_858_unit2_test.cmj test/gpr_904_test.cmi test/gpr_904_test.cmj test/gpr_974_test.cmi test/gpr_974_test.cmj test/gpr_977_test.cmi test/gpr_977_test.cmj test/gpr_return_type_unused_attribute.cmi test/gpr_return_type_unused_attribute.cmj test/gray_code_test.cmi test/gray_code_test.cmj test/guide_for_ext.cmi test/guide_for_ext.cmj test/hamming_test.cmi test/hamming_test.cmj test/hash_collision_test.cmi test/hash_collision_test.cmj test/hash_sugar_desugar.cmi test/hash_sugar_desugar.cmj test/hash_test.cmi test/hash_test.cmj test/hashtbl_test.cmi test/hashtbl_test.cmj test/hello.foo.cmi test/hello.foo.cmj test/hello_res.cmi test/hello_res.cmj test/http_types.cmi test/http_types.cmj test/ignore_test.cmi test/ignore_test.cmj test/imm_map_bench.cmi test/imm_map_bench.cmj test/include_side_effect.cmi test/include_side_effect.cmj test/include_side_effect_free.cmi test/include_side_effect_free.cmj test/incomplete_toplevel_test.cmi test/incomplete_toplevel_test.cmj test/infer_type_test.cmi test/infer_type_test.cmj test/inline_const.cmi test/inline_const.cmj test/inline_const_test.cmi test/inline_const_test.cmj test/inline_edge_cases.cmi test/inline_edge_cases.cmj test/inline_map2_test.cmi test/inline_map2_test.cmj test/inline_map_demo.cmi test/inline_map_demo.cmj test/inline_map_test.cmi test/inline_map_test.cmj test/inline_record_test.cmi test/inline_record_test.cmj test/inline_regression_test.cmi test/inline_regression_test.cmj test/inline_string_test.cmi test/inline_string_test.cmj test/inner_call.cmi test/inner_call.cmj test/inner_define.cmi test/inner_define.cmj test/inner_unused.cmi test/inner_unused.cmj test/installation_test.cmi test/installation_test.cmj test/int32_test.cmi test/int32_test.cmj test/int64_mul_div_test.cmi test/int64_mul_div_test.cmj test/int64_string_bench.cmi test/int64_string_bench.cmj test/int64_string_test.cmi test/int64_string_test.cmj test/int64_test.cmi test/int64_test.cmj test/int_hashtbl_test.cmi test/int_hashtbl_test.cmj test/int_map.cmi test/int_map.cmj test/int_overflow_test.cmi test/int_overflow_test.cmj test/int_poly_var.cmi test/int_poly_var.cmj test/int_switch_test.cmi test/int_switch_test.cmj test/internal_unused_test.cmi test/internal_unused_test.cmj test/io_test.cmi test/io_test.cmj test/js_array_test.cmi test/js_array_test.cmj test/js_bool_test.cmi test/js_bool_test.cmj test/js_cast_test.cmi test/js_cast_test.cmj test/js_date_test.cmi test/js_date_test.cmj test/js_dict_test.cmi test/js_dict_test.cmj test/js_exception_catch_test.cmi test/js_exception_catch_test.cmj test/js_float_test.cmi test/js_float_test.cmj test/js_global_test.cmi test/js_global_test.cmj test/js_int_test.cmi test/js_int_test.cmj test/js_json_test.cmi test/js_json_test.cmj test/js_list_test.cmi test/js_list_test.cmj test/js_math_test.cmi test/js_math_test.cmj test/js_null_test.cmi test/js_null_test.cmj test/js_null_undefined_test.cmi test/js_null_undefined_test.cmj test/js_nullable_test.cmi test/js_nullable_test.cmj test/js_obj_test.cmi test/js_obj_test.cmj test/js_option_test.cmi test/js_option_test.cmj test/js_promise_basic_test.cmi test/js_promise_basic_test.cmj test/js_re_test.cmi test/js_re_test.cmj test/js_string_test.cmi test/js_string_test.cmj test/js_typed_array_test.cmi test/js_typed_array_test.cmj test/js_undefined_test.cmi test/js_undefined_test.cmj test/js_val.cmi test/js_val.cmj test/jsoo_400_test.cmi test/jsoo_400_test.cmj test/jsoo_485_test.cmi test/jsoo_485_test.cmj test/key_word_property.cmi test/key_word_property.cmj test/key_word_property2.cmi test/key_word_property2.cmj test/key_word_property_plus_test.cmi test/key_word_property_plus_test.cmj test/label_uncurry.cmi test/label_uncurry.cmj test/large_integer_pat.cmi test/large_integer_pat.cmj test/large_record_duplication_test.cmi test/large_record_duplication_test.cmj test/largest_int_flow.cmi test/largest_int_flow.cmj test/lazy_demo.cmi test/lazy_demo.cmj test/lazy_test.cmi test/lazy_test.cmj test/lexer_test.cmi test/lexer_test.cmj test/lib_js_test.cmi test/lib_js_test.cmj test/libarg_test.cmi test/libarg_test.cmj test/libqueue_test.cmi test/libqueue_test.cmj test/limits_test.cmi test/limits_test.cmj test/list_stack.cmi test/list_stack.cmj test/list_test.cmi test/list_test.cmj test/local_class_type.cmi test/local_class_type.cmj test/local_exception_test.cmi test/local_exception_test.cmj test/loop_regression_test.cmi test/loop_regression_test.cmj test/loop_suites_test.cmi test/loop_suites_test.cmj test/map_find_test.cmi test/map_find_test.cmj test/map_test.cmi test/map_test.cmj test/mario_game.cmi test/mario_game.cmj test/marshal.cmi test/marshal.cmj test/method_chain.cmi test/method_chain.cmj test/method_name_test.cmi test/method_name_test.cmj test/method_string_name.cmi test/method_string_name.cmj test/minimal_test.cmi test/minimal_test.cmj test/miss_colon_test.cmi test/miss_colon_test.cmj test/mock_mt.cmi test/mock_mt.cmj test/module_alias_test.cmi test/module_alias_test.cmj test/module_as_class_ffi.cmi test/module_as_class_ffi.cmj test/module_as_function.cmi test/module_as_function.cmj test/module_missing_conversion.cmi test/module_missing_conversion.cmj test/module_parameter_test.cmi test/module_parameter_test.cmj test/module_splice_test.cmi test/module_splice_test.cmj test/more_poly_variant_test.cmi test/more_poly_variant_test.cmj test/more_uncurry.cmi test/more_uncurry.cmj test/mpr_6033_test.cmi test/mpr_6033_test.cmj test/mt.cmi test/mt.cmj test/mt_global.cmi test/mt_global.cmj test/mutable_obj_test.cmi test/mutable_obj_test.cmj test/mutable_uncurry_test.cmi test/mutable_uncurry_test.cmj test/mutual_non_recursive_type.cmi test/mutual_non_recursive_type.cmj test/name_mangle_test.cmi test/name_mangle_test.cmj test/nested_include.cmi test/nested_include.cmj test/nested_module_alias.cmi test/nested_module_alias.cmj test/nested_obj_literal.cmi test/nested_obj_literal.cmj test/nested_obj_test.cmi test/nested_obj_test.cmj test/nested_pattern_match_test.cmi test/nested_pattern_match_test.cmj test/noassert.cmi test/noassert.cmj test/node_fs_test.cmi test/node_fs_test.cmj test/node_path_test.cmi test/node_path_test.cmj test/null_list_test.cmi test/null_list_test.cmj test/number_lexer.cmi test/number_lexer.cmj test/obj_literal_ppx.cmi test/obj_literal_ppx.cmj test/obj_literal_ppx_test.cmi test/obj_literal_ppx_test.cmj test/obj_magic_test.cmi test/obj_magic_test.cmj test/obj_type_test.cmi test/obj_type_test.cmj test/ocaml_re_test.cmi test/ocaml_re_test.cmj test/of_string_test.cmi test/of_string_test.cmj test/offset.cmi test/offset.cmj test/oo_js_test_date.cmi test/oo_js_test_date.cmj test/option_encoding_test.cmi test/option_encoding_test.cmj test/option_record_none_test.cmi test/option_record_none_test.cmj test/option_repr_test.cmi test/option_repr_test.cmj test/optional_ffi_test.cmi test/optional_ffi_test.cmj test/optional_regression_test.cmi test/optional_regression_test.cmj test/pipe_send_readline.cmi test/pipe_send_readline.cmj test/pipe_syntax.cmi test/pipe_syntax.cmj test/poly_empty_array.cmi test/poly_empty_array.cmj test/poly_type.cmi test/poly_type.cmj test/poly_variant_test.cmi test/poly_variant_test.cmj test/polymorphic_raw_test.cmi test/polymorphic_raw_test.cmj test/polymorphism_test.cmi test/polymorphism_test.cmj test/polyvar_convert.cmi test/polyvar_convert.cmj test/polyvar_test.cmi test/polyvar_test.cmj test/ppx_apply_test.cmi test/ppx_apply_test.cmj test/ppx_this_obj_field.cmi test/ppx_this_obj_field.cmj test/ppx_this_obj_test.cmi test/ppx_this_obj_test.cmj test/pq_test.cmi test/pq_test.cmj test/pr6726.cmi test/pr6726.cmj test/pr_regression_test.cmi test/pr_regression_test.cmj test/prepend_data_ffi.cmi test/prepend_data_ffi.cmj test/primitive_reg_test.cmi test/primitive_reg_test.cmj test/print_alpha_test.cmi test/print_alpha_test.cmj test/promise.cmi test/promise.cmj test/promise_catch_test.cmi test/promise_catch_test.cmj test/queue_402.cmi test/queue_402.cmj test/queue_test.cmi test/queue_test.cmj test/random_test.cmi test/random_test.cmj test/raw_hash_tbl_bench.cmi test/raw_hash_tbl_bench.cmj test/raw_output_test.cmi test/raw_output_test.cmj test/raw_pure_test.cmi test/raw_pure_test.cmj test/rbset.cmi test/rbset.cmj test/react.cmi test/react.cmj test/reactDOMRe.cmi test/reactDOMRe.cmj test/reactDOMServerRe.cmi test/reactDOMServerRe.cmj test/reactEvent.cmi test/reactEvent.cmj test/reactTestUtils.cmi test/reactTestUtils.cmj test/reasonReact.cmi test/reasonReact.cmj test/reasonReactCompat.cmi test/reasonReactCompat.cmj test/reasonReactOptimizedCreateClass.cmi test/reasonReactOptimizedCreateClass.cmj test/reasonReactRouter.cmi test/reasonReactRouter.cmj test/rebind_module.cmi test/rebind_module.cmj test/rebind_module_test.cmi test/rebind_module_test.cmj test/rec_array_test.cmi test/rec_array_test.cmj test/rec_fun_test.cmi test/rec_fun_test.cmj test/rec_module_opt.cmi test/rec_module_opt.cmj test/rec_module_test.cmi test/rec_module_test.cmj test/rec_value_test.cmi test/rec_value_test.cmj test/record_debug_test.cmi test/record_debug_test.cmj test/record_extension_test.cmi test/record_extension_test.cmj test/record_name_test.cmi test/record_name_test.cmj test/record_regression.cmi test/record_regression.cmj test/record_with_test.cmi test/record_with_test.cmj test/recursive_module.cmi test/recursive_module.cmj test/recursive_module_test.cmi test/recursive_module_test.cmj test/recursive_react_component.cmi test/recursive_react_component.cmj test/recursive_records_test.cmi test/recursive_records_test.cmj test/recursive_unbound_module_test.cmi test/recursive_unbound_module_test.cmj test/regression_print.cmi test/regression_print.cmj test/relative_path.cmi test/relative_path.cmj test/res_debug.cmi test/res_debug.cmj test/return_check.cmi test/return_check.cmj test/runtime_encoding_test.cmi test/runtime_encoding_test.cmj test/set_gen.cmi test/set_gen.cmj test/sexp.cmi test/sexp.cmj test/sexpm.cmi test/sexpm.cmj test/sexpm_test.cmi test/sexpm_test.cmj test/side_effect.cmi test/side_effect.cmj test/side_effect_free.cmi test/side_effect_free.cmj test/simple_derive_test.cmi test/simple_derive_test.cmj test/simple_derive_use.cmi test/simple_derive_use.cmj test/simple_lexer_test.cmi test/simple_lexer_test.cmj test/simplify_lambda_632o.cmi test/simplify_lambda_632o.cmj test/single_module_alias.cmi test/single_module_alias.cmj test/singular_unit_test.cmi test/singular_unit_test.cmj test/small_inline_test.cmi test/small_inline_test.cmj test/splice_test.cmi test/splice_test.cmj test/stack_comp_test.cmi test/stack_comp_test.cmj test/stack_test.cmi test/stack_test.cmj test/stream_parser_test.cmi test/stream_parser_test.cmj test/string_bound_get_test.cmi test/string_bound_get_test.cmj test/string_get_set_test.cmi test/string_get_set_test.cmj test/string_interp_test.cmi test/string_interp_test.cmj test/string_literal_print_test.cmi test/string_literal_print_test.cmj test/string_runtime_test.cmi test/string_runtime_test.cmj test/string_set.cmi test/string_set.cmj test/string_set_test.cmi test/string_set_test.cmj test/string_test.cmi test/string_test.cmj test/string_unicode_test.cmi test/string_unicode_test.cmj test/stringmatch_test.cmi test/stringmatch_test.cmj test/submodule.cmi test/submodule.cmj test/submodule_call.cmi test/submodule_call.cmj test/switch_case_test.cmi test/switch_case_test.cmj test/tailcall_inline_test.cmi test/tailcall_inline_test.cmj test/template.cmi test/template.cmj test/test.cmi test/test.cmj test/test2.cmi test/test2.cmj test/test_alias.cmi test/test_alias.cmj test/test_ari.cmi test/test_ari.cmj test/test_array.cmi test/test_array.cmj test/test_array_append.cmi test/test_array_append.cmj test/test_array_primitive.cmi test/test_array_primitive.cmj test/test_bool_equal.cmi test/test_bool_equal.cmj test/test_bs_this.cmi test/test_bs_this.cmj test/test_bug.cmi test/test_bug.cmj test/test_bytes.cmi test/test_bytes.cmj test/test_case_opt_collision.cmi test/test_case_opt_collision.cmj test/test_case_set.cmi test/test_case_set.cmj test/test_char.cmi test/test_char.cmj test/test_closure.cmi test/test_closure.cmj test/test_common.cmi test/test_common.cmj test/test_const_elim.cmi test/test_const_elim.cmj test/test_const_propogate.cmi test/test_const_propogate.cmj test/test_cpp.cmi test/test_cpp.cmj test/test_cps.cmi test/test_cps.cmj test/test_demo.cmi test/test_demo.cmj test/test_dup_param.cmi test/test_dup_param.cmj test/test_eq.cmi test/test_eq.cmj test/test_exception.cmi test/test_exception.cmj test/test_exception_escape.cmi test/test_exception_escape.cmj test/test_export2.cmi test/test_export2.cmj test/test_external.cmi test/test_external.cmj test/test_external_unit.cmi test/test_external_unit.cmj test/test_ffi.cmi test/test_ffi.cmj test/test_fib.cmi test/test_fib.cmj test/test_filename.cmi test/test_filename.cmj test/test_for_loop.cmi test/test_for_loop.cmj test/test_for_map.cmi test/test_for_map.cmj test/test_for_map2.cmi test/test_for_map2.cmj test/test_format.cmi test/test_format.cmj test/test_formatter.cmi test/test_formatter.cmj test/test_functor_dead_code.cmi test/test_functor_dead_code.cmj test/test_generative_module.cmi test/test_generative_module.cmj test/test_global_print.cmi test/test_global_print.cmj test/test_google_closure.cmi test/test_google_closure.cmj test/test_http_server.cmi test/test_http_server.cmj test/test_include.cmi test/test_include.cmj test/test_incomplete.cmi test/test_incomplete.cmj test/test_incr_ref.cmi test/test_incr_ref.cmj test/test_index.cmi test/test_index.cmj test/test_int_map_find.cmi test/test_int_map_find.cmj test/test_internalOO.cmi test/test_internalOO.cmj test/test_is_js.cmi test/test_is_js.cmj test/test_js_ffi.cmi test/test_js_ffi.cmj test/test_let.cmi test/test_let.cmj test/test_list.cmi test/test_list.cmj test/test_literal.cmi test/test_literal.cmj test/test_literals.cmi test/test_literals.cmj test/test_match_exception.cmi test/test_match_exception.cmj test/test_mutliple.cmi test/test_mutliple.cmj test/test_nat64.cmi test/test_nat64.cmj test/test_nested_let.cmi test/test_nested_let.cmj test/test_nested_print.cmi test/test_nested_print.cmj test/test_non_export.cmi test/test_non_export.cmj test/test_nullary.cmi test/test_nullary.cmj test/test_obj.cmi test/test_obj.cmj test/test_obj_simple_ffi.cmi test/test_obj_simple_ffi.cmj test/test_order.cmi test/test_order.cmj test/test_order_tailcall.cmi test/test_order_tailcall.cmj test/test_other_exn.cmi test/test_other_exn.cmj test/test_pack.cmi test/test_pack.cmj test/test_per.cmi test/test_per.cmj test/test_pervasive.cmi test/test_pervasive.cmj test/test_pervasives2.cmi test/test_pervasives2.cmj test/test_pervasives3.cmi test/test_pervasives3.cmj test/test_primitive.cmi test/test_primitive.cmj test/test_promise_bind.cmi test/test_promise_bind.cmj test/test_ramification.cmi test/test_ramification.cmj test/test_react.cmi test/test_react.cmj test/test_react_case.cmi test/test_react_case.cmj test/test_regex.cmi test/test_regex.cmj test/test_require.cmi test/test_require.cmj test/test_runtime_encoding.cmi test/test_runtime_encoding.cmj test/test_scope.cmi test/test_scope.cmj test/test_seq.cmi test/test_seq.cmj test/test_set.cmi test/test_set.cmj test/test_side_effect_functor.cmi test/test_side_effect_functor.cmj test/test_simple_include.cmi test/test_simple_include.cmj test/test_simple_pattern_match.cmi test/test_simple_pattern_match.cmj test/test_simple_ref.cmi test/test_simple_ref.cmj test/test_simple_tailcall.cmi test/test_simple_tailcall.cmj test/test_small.cmi test/test_small.cmj test/test_sprintf.cmi test/test_sprintf.cmj test/test_stack.cmi test/test_stack.cmj test/test_static_catch_ident.cmi test/test_static_catch_ident.cmj test/test_string.cmi test/test_string.cmj test/test_string_case.cmi test/test_string_case.cmj test/test_string_const.cmi test/test_string_const.cmj test/test_string_map.cmi test/test_string_map.cmj test/test_string_switch.cmi test/test_string_switch.cmj test/test_switch.cmi test/test_switch.cmj test/test_trywith.cmi test/test_trywith.cmj test/test_tuple.cmi test/test_tuple.cmj test/test_tuple_destructring.cmi test/test_tuple_destructring.cmj test/test_type_based_arity.cmi test/test_type_based_arity.cmj test/test_u.cmi test/test_u.cmj test/test_unknown.cmi test/test_unknown.cmj test/test_unsafe_cmp.cmi test/test_unsafe_cmp.cmj test/test_unsafe_obj_ffi.cmi test/test_unsafe_obj_ffi.cmj test/test_unsafe_obj_ffi_ppx.cmi test/test_unsafe_obj_ffi_ppx.cmj test/test_unsupported_primitive.cmi test/test_unsupported_primitive.cmj test/test_while_closure.cmi test/test_while_closure.cmj test/test_while_side_effect.cmi test/test_while_side_effect.cmj test/test_zero_nullable.cmi test/test_zero_nullable.cmj test/then_mangle_test.cmi test/then_mangle_test.cmj test/ticker.cmi test/ticker.cmj test/to_string_test.cmi test/to_string_test.cmj test/topsort_test.cmi test/topsort_test.cmj test/tramp_fib.cmi test/tramp_fib.cmj test/tuple_alloc.cmi test/tuple_alloc.cmj test/type_disambiguate.cmi test/type_disambiguate.cmj test/typeof_test.cmi test/typeof_test.cmj test/ui_defs.cmi test/unboxed_attribute.cmi test/unboxed_attribute.cmj test/unboxed_attribute_test.cmi test/unboxed_attribute_test.cmj test/unboxed_crash.cmi test/unboxed_crash.cmj test/unboxed_use_case.cmi test/unboxed_use_case.cmj test/uncurry_external_test.cmi test/uncurry_external_test.cmj test/uncurry_glob_test.cmi test/uncurry_glob_test.cmj test/uncurry_method.cmi test/uncurry_method.cmj test/uncurry_test.cmi test/uncurry_test.cmj test/undef_regression2_test.cmi test/undef_regression2_test.cmj test/undef_regression_test.cmi test/undef_regression_test.cmj test/undefine_conditional.cmi test/undefine_conditional.cmj test/unicode_type_error.cmi test/unicode_type_error.cmj test/unit_undefined_test.cmi test/unit_undefined_test.cmj test/unitest_string.cmi test/unitest_string.cmj test/unsafe_full_apply_primitive.cmi test/unsafe_full_apply_primitive.cmj test/unsafe_obj_external.cmi test/unsafe_obj_external.cmj test/unsafe_ppx_test.cmi test/unsafe_ppx_test.cmj test/unsafe_this.cmi test/unsafe_this.cmj test/update_record_test.cmi test/update_record_test.cmj test/utf8_decode_test.cmi test/utf8_decode_test.cmj test/variant.cmi test/variant.cmj test/watch_test.cmi test/watch_test.cmj test/webpack_config.cmi test/webpack_config.cmj
+o test : phony test/406_primitive_test.cmi test/406_primitive_test.cmj test/EmptyRecord.cmi test/EmptyRecord.cmj test/SafePromises.cmi test/SafePromises.cmj test/a.cmi test/a.cmj test/a_filename_test.cmi test/a_filename_test.cmj test/a_list_test.cmi test/a_list_test.cmj test/a_recursive_type.cmi test/a_recursive_type.cmj test/a_scope_bug.cmi test/a_scope_bug.cmj test/a_string_test.cmi test/a_string_test.cmj test/abstract_type.cmi test/abstract_type.cmj test/adt_optimize_test.cmi test/adt_optimize_test.cmj test/alias_test.cmi test/alias_test.cmj test/and_or_tailcall_test.cmi test/and_or_tailcall_test.cmj test/app_root_finder.cmi test/app_root_finder.cmj test/argv_test.cmi test/argv_test.cmj test/ari_regress_test.cmi test/ari_regress_test.cmj test/arith_lexer.cmi test/arith_lexer.cmj test/arith_parser.cmi test/arith_parser.cmj test/arith_syntax.cmi test/arith_syntax.cmj test/arity.cmi test/arity.cmj test/arity_deopt.cmi test/arity_deopt.cmj test/arity_infer.cmi test/arity_infer.cmj test/arity_ml.cmi test/arity_ml.cmj test/array_data_util.cmi test/array_data_util.cmj test/array_safe_get.cmi test/array_safe_get.cmj test/array_subtle_test.cmi test/array_subtle_test.cmj test/array_test.cmi test/array_test.cmj test/ast_abstract_test.cmi test/ast_abstract_test.cmj test/ast_js_mapper_poly_test.cmi test/ast_js_mapper_poly_test.cmj test/ast_js_mapper_test.cmi test/ast_js_mapper_test.cmj test/ast_mapper_defensive_test.cmi test/ast_mapper_defensive_test.cmj test/ast_mapper_unused_warning_test.cmi test/ast_mapper_unused_warning_test.cmj test/async_ideas.cmi test/async_ideas.cmj test/async_inline.cmi test/async_inline.cmj test/attr_test.cmi test/attr_test.cmj test/b.cmi test/b.cmj test/bal_set_mini.cmi test/bal_set_mini.cmj test/bang_primitive.cmi test/bang_primitive.cmj test/basic_module_test.cmi test/basic_module_test.cmj test/bb.cmi test/bb.cmj test/bdd.cmi test/bdd.cmj test/belt_internal_test.cmi test/belt_internal_test.cmj test/belt_result_alias_test.cmi test/belt_result_alias_test.cmj test/bench.cmi test/bench.cmj test/big_enum.cmi test/big_enum.cmj test/big_polyvar_test.cmi test/big_polyvar_test.cmj test/block_alias_test.cmi test/block_alias_test.cmj test/boolean_test.cmi test/boolean_test.cmj test/bs_MapInt_test.cmi test/bs_MapInt_test.cmj test/bs_abstract_test.cmi test/bs_abstract_test.cmj test/bs_array_test.cmi test/bs_array_test.cmj test/bs_auto_uncurry.cmi test/bs_auto_uncurry.cmj test/bs_auto_uncurry_test.cmi test/bs_auto_uncurry_test.cmj test/bs_float_test.cmi test/bs_float_test.cmj test/bs_hashmap_test.cmi test/bs_hashmap_test.cmj test/bs_hashset_int_test.cmi test/bs_hashset_int_test.cmj test/bs_hashtbl_string_test.cmi test/bs_hashtbl_string_test.cmj test/bs_ignore_effect.cmi test/bs_ignore_effect.cmj test/bs_ignore_test.cmi test/bs_ignore_test.cmj test/bs_int_test.cmi test/bs_int_test.cmj test/bs_list_test.cmi test/bs_list_test.cmj test/bs_map_set_dict_test.cmi test/bs_map_set_dict_test.cmj test/bs_map_test.cmi test/bs_map_test.cmj test/bs_min_max_test.cmi test/bs_min_max_test.cmj test/bs_mutable_set_test.cmi test/bs_mutable_set_test.cmj test/bs_node_string_buffer_test.cmi test/bs_node_string_buffer_test.cmj test/bs_poly_map_test.cmi test/bs_poly_map_test.cmj test/bs_poly_mutable_map_test.cmi test/bs_poly_mutable_map_test.cmj test/bs_poly_mutable_set_test.cmi test/bs_poly_mutable_set_test.cmj test/bs_poly_set_test.cmi test/bs_poly_set_test.cmj test/bs_qualified.cmi test/bs_qualified.cmj test/bs_queue_test.cmi test/bs_queue_test.cmj test/bs_rbset_int_bench.cmi test/bs_rbset_int_bench.cmj test/bs_rest_test.cmi test/bs_rest_test.cmj test/bs_set_bench.cmi test/bs_set_bench.cmj test/bs_set_int_test.cmi test/bs_set_int_test.cmj test/bs_sort_test.cmi test/bs_sort_test.cmj test/bs_splice_partial.cmi test/bs_splice_partial.cmj test/bs_stack_test.cmi test/bs_stack_test.cmj test/bs_string_test.cmi test/bs_string_test.cmj test/bs_unwrap_test.cmi test/bs_unwrap_test.cmj test/buffer_test.cmi test/buffer_test.cmj test/bytes_split_gpr_743_test.cmi test/bytes_split_gpr_743_test.cmj test/caml_compare_test.cmi test/caml_compare_test.cmj test/caml_format_test.cmi test/caml_format_test.cmj test/caml_sys_poly_fill_test.cmi test/caml_sys_poly_fill_test.cmj test/chain_code_test.cmi test/chain_code_test.cmj test/chn_test.cmi test/chn_test.cmj test/class_setter_getter.cmi test/class_setter_getter.cmj test/class_type_ffi_test.cmi test/class_type_ffi_test.cmj test/coercion_module_alias_test.cmi test/coercion_module_alias_test.cmj test/compare_test.cmi test/compare_test.cmj test/complete_parmatch_test.cmi test/complete_parmatch_test.cmj test/complex_if_test.cmi test/complex_if_test.cmj test/complex_test.cmi test/complex_test.cmj test/complex_while_loop.cmi test/complex_while_loop.cmj test/condition_compilation_test.cmi test/condition_compilation_test.cmj test/config1_test.cmi test/config1_test.cmj test/config2_test.cmi test/config2_test.cmj test/console_log_test.cmi test/console_log_test.cmj test/const_block_test.cmi test/const_block_test.cmj test/const_defs.cmi test/const_defs.cmj test/const_defs_test.cmi test/const_defs_test.cmj test/const_test.cmi test/const_test.cmj test/cont_int_fold_test.cmi test/cont_int_fold_test.cmj test/cps_test.cmi test/cps_test.cmj test/cross_module_inline_test.cmi test/cross_module_inline_test.cmj test/custom_error_test.cmi test/custom_error_test.cmj test/debug_keep_test.cmi test/debug_keep_test.cmj test/debug_mode_value.cmi test/debug_mode_value.cmj test/debug_tmp.cmi test/debug_tmp.cmj test/debugger_test.cmi test/debugger_test.cmj test/default_export_test.cmi test/default_export_test.cmj test/defunctor_make_test.cmi test/defunctor_make_test.cmj test/demo.cmi test/demo.cmj test/demo_binding.cmi test/demo_binding.cmj test/demo_int_map.cmi test/demo_int_map.cmj test/demo_page.cmi test/demo_page.cmj test/demo_pipe.cmi test/demo_pipe.cmj test/derive_dyntype.cmi test/derive_dyntype.cmj test/derive_projector_test.cmi test/derive_projector_test.cmj test/derive_type_test.cmi test/derive_type_test.cmj test/digest_test.cmi test/digest_test.cmj test/div_by_zero_test.cmi test/div_by_zero_test.cmj test/dollar_escape_test.cmi test/dollar_escape_test.cmj test/earger_curry_test.cmi test/earger_curry_test.cmj test/effect.cmi test/effect.cmj test/epsilon_test.cmi test/epsilon_test.cmj test/equal_box_test.cmi test/equal_box_test.cmj test/equal_exception_test.cmi test/equal_exception_test.cmj test/equal_test.cmi test/equal_test.cmj test/es6_export.cmi test/es6_export.cmj test/es6_import.cmi test/es6_import.cmj test/es6_module_test.cmi test/es6_module_test.cmj test/escape_esmodule.cmi test/escape_esmodule.cmj test/esmodule_ref.cmi test/esmodule_ref.cmj test/event_ffi.cmi test/event_ffi.cmj test/exception_alias.cmi test/exception_alias.cmj test/exception_def.cmi test/exception_def.cmj test/exception_raise_test.cmi test/exception_raise_test.cmj test/exception_rebind_test.cmi test/exception_rebind_test.cmj test/exception_rebound_err_test.cmi test/exception_rebound_err_test.cmj test/exception_repr_test.cmi test/exception_repr_test.cmj test/exception_value_test.cmi test/exception_value_test.cmj test/exn_error_pattern.cmi test/exn_error_pattern.cmj test/export_keyword.cmi test/export_keyword.cmj test/ext_array_test.cmi test/ext_array_test.cmj test/ext_bytes_test.cmi test/ext_bytes_test.cmj test/ext_filename_test.cmi test/ext_filename_test.cmj test/ext_list_test.cmi test/ext_list_test.cmj test/ext_pervasives_test.cmi test/ext_pervasives_test.cmj test/ext_string_test.cmi test/ext_string_test.cmj test/ext_sys_test.cmi test/ext_sys_test.cmj test/extensible_variant_test.cmi test/extensible_variant_test.cmj test/external_polyfill_test.cmi test/external_polyfill_test.cmj test/external_ppx.cmi test/external_ppx.cmj test/external_ppx2.cmi test/external_ppx2.cmj test/fail_comp.cmi test/fail_comp.cmj test/ffi_arity_test.cmi test/ffi_arity_test.cmj test/ffi_array_test.cmi test/ffi_array_test.cmj test/ffi_js_test.cmi test/ffi_js_test.cmj test/ffi_splice_test.cmi test/ffi_splice_test.cmj test/ffi_test.cmi test/ffi_test.cmj test/fib.cmi test/fib.cmj test/flattern_order_test.cmi test/flattern_order_test.cmj test/flexible_array_test.cmi test/flexible_array_test.cmj test/float_array.cmi test/float_array.cmj test/float_of_bits_test.cmi test/float_of_bits_test.cmj test/float_record.cmi test/float_record.cmj test/float_test.cmi test/float_test.cmj test/floatarray_test.cmi test/floatarray_test.cmj test/flow_parser_reg_test.cmi test/flow_parser_reg_test.cmj test/for_loop_test.cmi test/for_loop_test.cmj test/for_side_effect_test.cmi test/for_side_effect_test.cmj test/format_regression.cmi test/format_regression.cmj test/format_test.cmi test/format_test.cmj test/fs_test.cmi test/fs_test.cmj test/fun_pattern_match.cmi test/fun_pattern_match.cmj test/functor_app_test.cmi test/functor_app_test.cmj test/functor_def.cmi test/functor_def.cmj test/functor_ffi.cmi test/functor_ffi.cmj test/functor_inst.cmi test/functor_inst.cmj test/functors.cmi test/functors.cmj test/gbk.cmi test/gbk.cmj test/genlex_test.cmi test/genlex_test.cmj test/gentTypeReTest.cmi test/gentTypeReTest.cmj test/global_exception_regression_test.cmi test/global_exception_regression_test.cmj test/global_mangles.cmi test/global_mangles.cmj test/global_module_alias_test.cmi test/global_module_alias_test.cmj test/google_closure_test.cmi test/google_closure_test.cmj test/gpr496_test.cmi test/gpr496_test.cmj test/gpr_1063_test.cmi test/gpr_1063_test.cmj test/gpr_1072.cmi test/gpr_1072.cmj test/gpr_1072_reg.cmi test/gpr_1072_reg.cmj test/gpr_1150.cmi test/gpr_1150.cmj test/gpr_1154_test.cmi test/gpr_1154_test.cmj test/gpr_1170.cmi test/gpr_1170.cmj test/gpr_1240_missing_unbox.cmi test/gpr_1240_missing_unbox.cmj test/gpr_1245_test.cmi test/gpr_1245_test.cmj test/gpr_1268.cmi test/gpr_1268.cmj test/gpr_1409_test.cmi test/gpr_1409_test.cmj test/gpr_1423_app_test.cmi test/gpr_1423_app_test.cmj test/gpr_1423_nav.cmi test/gpr_1423_nav.cmj test/gpr_1438.cmi test/gpr_1438.cmj test/gpr_1481.cmi test/gpr_1481.cmj test/gpr_1484.cmi test/gpr_1484.cmj test/gpr_1501_test.cmi test/gpr_1501_test.cmj test/gpr_1503_test.cmi test/gpr_1503_test.cmj test/gpr_1539_test.cmi test/gpr_1539_test.cmj test/gpr_1600_test.cmi test/gpr_1600_test.cmj test/gpr_1658_test.cmi test/gpr_1658_test.cmj test/gpr_1667_test.cmi test/gpr_1667_test.cmj test/gpr_1692_test.cmi test/gpr_1692_test.cmj test/gpr_1698_test.cmi test/gpr_1698_test.cmj test/gpr_1701_test.cmi test/gpr_1701_test.cmj test/gpr_1716_test.cmi test/gpr_1716_test.cmj test/gpr_1717_test.cmi test/gpr_1717_test.cmj test/gpr_1728_test.cmi test/gpr_1728_test.cmj test/gpr_1749_test.cmi test/gpr_1749_test.cmj test/gpr_1759_test.cmi test/gpr_1759_test.cmj test/gpr_1760_test.cmi test/gpr_1760_test.cmj test/gpr_1762_test.cmi test/gpr_1762_test.cmj test/gpr_1817_test.cmi test/gpr_1817_test.cmj test/gpr_1822_test.cmi test/gpr_1822_test.cmj test/gpr_1891_test.cmi test/gpr_1891_test.cmj test/gpr_1943_test.cmi test/gpr_1943_test.cmj test/gpr_1946_test.cmi test/gpr_1946_test.cmj test/gpr_2316_test.cmi test/gpr_2316_test.cmj test/gpr_2352_test.cmi test/gpr_2352_test.cmj test/gpr_2413_test.cmi test/gpr_2413_test.cmj test/gpr_2474.cmi test/gpr_2474.cmj test/gpr_2487.cmi test/gpr_2487.cmj test/gpr_2503_test.cmi test/gpr_2503_test.cmj test/gpr_2608_test.cmi test/gpr_2608_test.cmj test/gpr_2614_test.cmi test/gpr_2614_test.cmj test/gpr_2633_test.cmi test/gpr_2633_test.cmj test/gpr_2642_test.cmi test/gpr_2642_test.cmj test/gpr_2652_test.cmi test/gpr_2652_test.cmj test/gpr_2682_test.cmi test/gpr_2682_test.cmj test/gpr_2700_test.cmi test/gpr_2700_test.cmj test/gpr_2731_test.cmi test/gpr_2731_test.cmj test/gpr_2789_test.cmi test/gpr_2789_test.cmj test/gpr_2931_test.cmi test/gpr_2931_test.cmj test/gpr_3142_test.cmi test/gpr_3142_test.cmj test/gpr_3154_test.cmi test/gpr_3154_test.cmj test/gpr_3209_test.cmi test/gpr_3209_test.cmj test/gpr_3492_test.cmi test/gpr_3492_test.cmj test/gpr_3519_jsx_test.cmi test/gpr_3519_jsx_test.cmj test/gpr_3519_test.cmi test/gpr_3519_test.cmj test/gpr_3536_test.cmi test/gpr_3536_test.cmj test/gpr_3546_test.cmi test/gpr_3546_test.cmj test/gpr_3548_test.cmi test/gpr_3548_test.cmj test/gpr_3549_test.cmi test/gpr_3549_test.cmj test/gpr_3566_drive_test.cmi test/gpr_3566_drive_test.cmj test/gpr_3566_test.cmi test/gpr_3566_test.cmj test/gpr_3595_test.cmi test/gpr_3595_test.cmj test/gpr_3609_test.cmi test/gpr_3609_test.cmj test/gpr_3697_test.cmi test/gpr_3697_test.cmj test/gpr_373_test.cmi test/gpr_373_test.cmj test/gpr_3770_test.cmi test/gpr_3770_test.cmj test/gpr_3852_alias.cmi test/gpr_3852_alias.cmj test/gpr_3852_alias_reify.cmi test/gpr_3852_alias_reify.cmj test/gpr_3852_effect.cmi test/gpr_3852_effect.cmj test/gpr_3865.cmi test/gpr_3865.cmj test/gpr_3865_bar.cmi test/gpr_3865_bar.cmj test/gpr_3865_foo.cmi test/gpr_3865_foo.cmj test/gpr_3875_test.cmi test/gpr_3875_test.cmj test/gpr_3877_test.cmi test/gpr_3877_test.cmj test/gpr_3895_test.cmi test/gpr_3895_test.cmj test/gpr_3897_test.cmi test/gpr_3897_test.cmj test/gpr_3931_test.cmi test/gpr_3931_test.cmj test/gpr_3980_test.cmi test/gpr_3980_test.cmj test/gpr_4025_test.cmi test/gpr_4025_test.cmj test/gpr_405_test.cmi test/gpr_405_test.cmj test/gpr_4069_test.cmi test/gpr_4069_test.cmj test/gpr_4265_test.cmi test/gpr_4265_test.cmj test/gpr_4274_test.cmi test/gpr_4274_test.cmj test/gpr_4280_test.cmi test/gpr_4280_test.cmj test/gpr_4407_test.cmi test/gpr_4407_test.cmj test/gpr_441.cmi test/gpr_441.cmj test/gpr_4442_test.cmi test/gpr_4442_test.cmj test/gpr_4491_test.cmi test/gpr_4491_test.cmj test/gpr_4494_test.cmi test/gpr_4494_test.cmj test/gpr_4519_test.cmi test/gpr_4519_test.cmj test/gpr_459_test.cmi test/gpr_459_test.cmj test/gpr_4632.cmi test/gpr_4632.cmj test/gpr_4639_test.cmi test/gpr_4639_test.cmj test/gpr_4900_test.cmi test/gpr_4900_test.cmj test/gpr_4924_test.cmi test/gpr_4924_test.cmj test/gpr_4931.cmi test/gpr_4931.cmj test/gpr_4931_allow.cmi test/gpr_4931_allow.cmj test/gpr_5071_test.cmi test/gpr_5071_test.cmj test/gpr_5169_test.cmi test/gpr_5169_test.cmj test/gpr_5218_test.cmi test/gpr_5218_test.cmj test/gpr_5280_optimize_test.cmi test/gpr_5280_optimize_test.cmj test/gpr_5312.cmi test/gpr_5312.cmj test/gpr_5557.cmi test/gpr_5557.cmj test/gpr_5753.cmi test/gpr_5753.cmj test/gpr_627_test.cmi test/gpr_627_test.cmj test/gpr_658.cmi test/gpr_658.cmj test/gpr_858_test.cmi test/gpr_858_test.cmj test/gpr_858_unit2_test.cmi test/gpr_858_unit2_test.cmj test/gpr_904_test.cmi test/gpr_904_test.cmj test/gpr_974_test.cmi test/gpr_974_test.cmj test/gpr_977_test.cmi test/gpr_977_test.cmj test/gpr_return_type_unused_attribute.cmi test/gpr_return_type_unused_attribute.cmj test/gray_code_test.cmi test/gray_code_test.cmj test/guide_for_ext.cmi test/guide_for_ext.cmj test/hamming_test.cmi test/hamming_test.cmj test/hash_collision_test.cmi test/hash_collision_test.cmj test/hash_sugar_desugar.cmi test/hash_sugar_desugar.cmj test/hash_test.cmi test/hash_test.cmj test/hashtbl_test.cmi test/hashtbl_test.cmj test/hello.foo.cmi test/hello.foo.cmj test/hello_res.cmi test/hello_res.cmj test/http_types.cmi test/http_types.cmj test/ignore_test.cmi test/ignore_test.cmj test/imm_map_bench.cmi test/imm_map_bench.cmj test/include_side_effect.cmi test/include_side_effect.cmj test/include_side_effect_free.cmi test/include_side_effect_free.cmj test/incomplete_toplevel_test.cmi test/incomplete_toplevel_test.cmj test/infer_type_test.cmi test/infer_type_test.cmj test/inline_const.cmi test/inline_const.cmj test/inline_const_test.cmi test/inline_const_test.cmj test/inline_edge_cases.cmi test/inline_edge_cases.cmj test/inline_map2_test.cmi test/inline_map2_test.cmj test/inline_map_demo.cmi test/inline_map_demo.cmj test/inline_map_test.cmi test/inline_map_test.cmj test/inline_record_test.cmi test/inline_record_test.cmj test/inline_regression_test.cmi test/inline_regression_test.cmj test/inline_string_test.cmi test/inline_string_test.cmj test/inner_call.cmi test/inner_call.cmj test/inner_define.cmi test/inner_define.cmj test/inner_unused.cmi test/inner_unused.cmj test/installation_test.cmi test/installation_test.cmj test/int32_test.cmi test/int32_test.cmj test/int64_mul_div_test.cmi test/int64_mul_div_test.cmj test/int64_string_bench.cmi test/int64_string_bench.cmj test/int64_string_test.cmi test/int64_string_test.cmj test/int64_test.cmi test/int64_test.cmj test/int_hashtbl_test.cmi test/int_hashtbl_test.cmj test/int_map.cmi test/int_map.cmj test/int_overflow_test.cmi test/int_overflow_test.cmj test/int_poly_var.cmi test/int_poly_var.cmj test/int_switch_test.cmi test/int_switch_test.cmj test/internal_unused_test.cmi test/internal_unused_test.cmj test/io_test.cmi test/io_test.cmj test/js_array_test.cmi test/js_array_test.cmj test/js_bool_test.cmi test/js_bool_test.cmj test/js_cast_test.cmi test/js_cast_test.cmj test/js_date_test.cmi test/js_date_test.cmj test/js_dict_test.cmi test/js_dict_test.cmj test/js_exception_catch_test.cmi test/js_exception_catch_test.cmj test/js_float_test.cmi test/js_float_test.cmj test/js_global_test.cmi test/js_global_test.cmj test/js_int_test.cmi test/js_int_test.cmj test/js_json_test.cmi test/js_json_test.cmj test/js_list_test.cmi test/js_list_test.cmj test/js_math_test.cmi test/js_math_test.cmj test/js_null_test.cmi test/js_null_test.cmj test/js_null_undefined_test.cmi test/js_null_undefined_test.cmj test/js_nullable_test.cmi test/js_nullable_test.cmj test/js_obj_test.cmi test/js_obj_test.cmj test/js_option_test.cmi test/js_option_test.cmj test/js_promise_basic_test.cmi test/js_promise_basic_test.cmj test/js_re_test.cmi test/js_re_test.cmj test/js_string_test.cmi test/js_string_test.cmj test/js_typed_array_test.cmi test/js_typed_array_test.cmj test/js_undefined_test.cmi test/js_undefined_test.cmj test/js_val.cmi test/js_val.cmj test/jsoo_400_test.cmi test/jsoo_400_test.cmj test/jsoo_485_test.cmi test/jsoo_485_test.cmj test/key_word_property.cmi test/key_word_property.cmj test/key_word_property2.cmi test/key_word_property2.cmj test/key_word_property_plus_test.cmi test/key_word_property_plus_test.cmj test/label_uncurry.cmi test/label_uncurry.cmj test/large_integer_pat.cmi test/large_integer_pat.cmj test/large_record_duplication_test.cmi test/large_record_duplication_test.cmj test/largest_int_flow.cmi test/largest_int_flow.cmj test/lazy_demo.cmi test/lazy_demo.cmj test/lazy_test.cmi test/lazy_test.cmj test/lexer_test.cmi test/lexer_test.cmj test/lib_js_test.cmi test/lib_js_test.cmj test/libarg_test.cmi test/libarg_test.cmj test/libqueue_test.cmi test/libqueue_test.cmj test/limits_test.cmi test/limits_test.cmj test/list_stack.cmi test/list_stack.cmj test/list_test.cmi test/list_test.cmj test/local_class_type.cmi test/local_class_type.cmj test/local_exception_test.cmi test/local_exception_test.cmj test/loop_regression_test.cmi test/loop_regression_test.cmj test/loop_suites_test.cmi test/loop_suites_test.cmj test/map_find_test.cmi test/map_find_test.cmj test/map_test.cmi test/map_test.cmj test/mario_game.cmi test/mario_game.cmj test/marshal.cmi test/marshal.cmj test/method_chain.cmi test/method_chain.cmj test/method_name_test.cmi test/method_name_test.cmj test/method_string_name.cmi test/method_string_name.cmj test/minimal_test.cmi test/minimal_test.cmj test/miss_colon_test.cmi test/miss_colon_test.cmj test/mock_mt.cmi test/mock_mt.cmj test/module_alias_test.cmi test/module_alias_test.cmj test/module_as_class_ffi.cmi test/module_as_class_ffi.cmj test/module_as_function.cmi test/module_as_function.cmj test/module_missing_conversion.cmi test/module_missing_conversion.cmj test/module_parameter_test.cmi test/module_parameter_test.cmj test/module_splice_test.cmi test/module_splice_test.cmj test/more_poly_variant_test.cmi test/more_poly_variant_test.cmj test/more_uncurry.cmi test/more_uncurry.cmj test/mpr_6033_test.cmi test/mpr_6033_test.cmj test/mt.cmi test/mt.cmj test/mt_global.cmi test/mt_global.cmj test/mutable_obj_test.cmi test/mutable_obj_test.cmj test/mutable_uncurry_test.cmi test/mutable_uncurry_test.cmj test/mutual_non_recursive_type.cmi test/mutual_non_recursive_type.cmj test/name_mangle_test.cmi test/name_mangle_test.cmj test/nested_include.cmi test/nested_include.cmj test/nested_module_alias.cmi test/nested_module_alias.cmj test/nested_obj_literal.cmi test/nested_obj_literal.cmj test/nested_obj_test.cmi test/nested_obj_test.cmj test/nested_pattern_match_test.cmi test/nested_pattern_match_test.cmj test/noassert.cmi test/noassert.cmj test/node_fs_test.cmi test/node_fs_test.cmj test/node_path_test.cmi test/node_path_test.cmj test/null_list_test.cmi test/null_list_test.cmj test/number_lexer.cmi test/number_lexer.cmj test/obj_literal_ppx.cmi test/obj_literal_ppx.cmj test/obj_literal_ppx_test.cmi test/obj_literal_ppx_test.cmj test/obj_magic_test.cmi test/obj_magic_test.cmj test/obj_type_test.cmi test/obj_type_test.cmj test/ocaml_re_test.cmi test/ocaml_re_test.cmj test/of_string_test.cmi test/of_string_test.cmj test/offset.cmi test/offset.cmj test/oo_js_test_date.cmi test/oo_js_test_date.cmj test/option_encoding_test.cmi test/option_encoding_test.cmj test/option_record_none_test.cmi test/option_record_none_test.cmj test/option_repr_test.cmi test/option_repr_test.cmj test/optional_ffi_test.cmi test/optional_ffi_test.cmj test/optional_regression_test.cmi test/optional_regression_test.cmj test/pipe_send_readline.cmi test/pipe_send_readline.cmj test/pipe_syntax.cmi test/pipe_syntax.cmj test/poly_empty_array.cmi test/poly_empty_array.cmj test/poly_type.cmi test/poly_type.cmj test/poly_variant_test.cmi test/poly_variant_test.cmj test/polymorphic_raw_test.cmi test/polymorphic_raw_test.cmj test/polymorphism_test.cmi test/polymorphism_test.cmj test/polyvar_convert.cmi test/polyvar_convert.cmj test/polyvar_test.cmi test/polyvar_test.cmj test/ppx_apply_test.cmi test/ppx_apply_test.cmj test/ppx_this_obj_field.cmi test/ppx_this_obj_field.cmj test/ppx_this_obj_test.cmi test/ppx_this_obj_test.cmj test/pq_test.cmi test/pq_test.cmj test/pr6726.cmi test/pr6726.cmj test/pr_regression_test.cmi test/pr_regression_test.cmj test/prepend_data_ffi.cmi test/prepend_data_ffi.cmj test/primitive_reg_test.cmi test/primitive_reg_test.cmj test/print_alpha_test.cmi test/print_alpha_test.cmj test/promise.cmi test/promise.cmj test/promise_catch_test.cmi test/promise_catch_test.cmj test/queue_402.cmi test/queue_402.cmj test/queue_test.cmi test/queue_test.cmj test/random_test.cmi test/random_test.cmj test/raw_hash_tbl_bench.cmi test/raw_hash_tbl_bench.cmj test/raw_output_test.cmi test/raw_output_test.cmj test/raw_pure_test.cmi test/raw_pure_test.cmj test/rbset.cmi test/rbset.cmj test/react.cmi test/react.cmj test/reactDOMRe.cmi test/reactDOMRe.cmj test/reactDOMServerRe.cmi test/reactDOMServerRe.cmj test/reactEvent.cmi test/reactEvent.cmj test/reactTestUtils.cmi test/reactTestUtils.cmj test/reasonReact.cmi test/reasonReact.cmj test/reasonReactCompat.cmi test/reasonReactCompat.cmj test/reasonReactOptimizedCreateClass.cmi test/reasonReactOptimizedCreateClass.cmj test/reasonReactRouter.cmi test/reasonReactRouter.cmj test/rebind_module.cmi test/rebind_module.cmj test/rebind_module_test.cmi test/rebind_module_test.cmj test/rec_array_test.cmi test/rec_array_test.cmj test/rec_fun_test.cmi test/rec_fun_test.cmj test/rec_module_opt.cmi test/rec_module_opt.cmj test/rec_module_test.cmi test/rec_module_test.cmj test/rec_value_test.cmi test/rec_value_test.cmj test/record_debug_test.cmi test/record_debug_test.cmj test/record_extension_test.cmi test/record_extension_test.cmj test/record_name_test.cmi test/record_name_test.cmj test/record_regression.cmi test/record_regression.cmj test/record_with_test.cmi test/record_with_test.cmj test/recursive_module.cmi test/recursive_module.cmj test/recursive_module_test.cmi test/recursive_module_test.cmj test/recursive_react_component.cmi test/recursive_react_component.cmj test/recursive_records_test.cmi test/recursive_records_test.cmj test/recursive_unbound_module_test.cmi test/recursive_unbound_module_test.cmj test/regression_print.cmi test/regression_print.cmj test/relative_path.cmi test/relative_path.cmj test/res_debug.cmi test/res_debug.cmj test/return_check.cmi test/return_check.cmj test/runtime_encoding_test.cmi test/runtime_encoding_test.cmj test/set_gen.cmi test/set_gen.cmj test/sexp.cmi test/sexp.cmj test/sexpm.cmi test/sexpm.cmj test/sexpm_test.cmi test/sexpm_test.cmj test/side_effect.cmi test/side_effect.cmj test/side_effect_free.cmi test/side_effect_free.cmj test/simple_derive_test.cmi test/simple_derive_test.cmj test/simple_derive_use.cmi test/simple_derive_use.cmj test/simple_lexer_test.cmi test/simple_lexer_test.cmj test/simplify_lambda_632o.cmi test/simplify_lambda_632o.cmj test/single_module_alias.cmi test/single_module_alias.cmj test/singular_unit_test.cmi test/singular_unit_test.cmj test/small_inline_test.cmi test/small_inline_test.cmj test/splice_test.cmi test/splice_test.cmj test/stack_comp_test.cmi test/stack_comp_test.cmj test/stack_test.cmi test/stack_test.cmj test/stream_parser_test.cmi test/stream_parser_test.cmj test/string_bound_get_test.cmi test/string_bound_get_test.cmj test/string_get_set_test.cmi test/string_get_set_test.cmj test/string_interp_test.cmi test/string_interp_test.cmj test/string_literal_print_test.cmi test/string_literal_print_test.cmj test/string_runtime_test.cmi test/string_runtime_test.cmj test/string_set.cmi test/string_set.cmj test/string_set_test.cmi test/string_set_test.cmj test/string_test.cmi test/string_test.cmj test/string_unicode_test.cmi test/string_unicode_test.cmj test/stringmatch_test.cmi test/stringmatch_test.cmj test/submodule.cmi test/submodule.cmj test/submodule_call.cmi test/submodule_call.cmj test/switch_case_test.cmi test/switch_case_test.cmj test/tailcall_inline_test.cmi test/tailcall_inline_test.cmj test/template.cmi test/template.cmj test/test.cmi test/test.cmj test/test2.cmi test/test2.cmj test/test_alias.cmi test/test_alias.cmj test/test_ari.cmi test/test_ari.cmj test/test_array.cmi test/test_array.cmj test/test_array_append.cmi test/test_array_append.cmj test/test_array_primitive.cmi test/test_array_primitive.cmj test/test_bool_equal.cmi test/test_bool_equal.cmj test/test_bs_this.cmi test/test_bs_this.cmj test/test_bug.cmi test/test_bug.cmj test/test_bytes.cmi test/test_bytes.cmj test/test_case_opt_collision.cmi test/test_case_opt_collision.cmj test/test_case_set.cmi test/test_case_set.cmj test/test_char.cmi test/test_char.cmj test/test_closure.cmi test/test_closure.cmj test/test_common.cmi test/test_common.cmj test/test_const_elim.cmi test/test_const_elim.cmj test/test_const_propogate.cmi test/test_const_propogate.cmj test/test_cpp.cmi test/test_cpp.cmj test/test_cps.cmi test/test_cps.cmj test/test_demo.cmi test/test_demo.cmj test/test_dup_param.cmi test/test_dup_param.cmj test/test_eq.cmi test/test_eq.cmj test/test_exception.cmi test/test_exception.cmj test/test_exception_escape.cmi test/test_exception_escape.cmj test/test_export2.cmi test/test_export2.cmj test/test_external.cmi test/test_external.cmj test/test_external_unit.cmi test/test_external_unit.cmj test/test_ffi.cmi test/test_ffi.cmj test/test_fib.cmi test/test_fib.cmj test/test_filename.cmi test/test_filename.cmj test/test_for_loop.cmi test/test_for_loop.cmj test/test_for_map.cmi test/test_for_map.cmj test/test_for_map2.cmi test/test_for_map2.cmj test/test_format.cmi test/test_format.cmj test/test_formatter.cmi test/test_formatter.cmj test/test_functor_dead_code.cmi test/test_functor_dead_code.cmj test/test_generative_module.cmi test/test_generative_module.cmj test/test_global_print.cmi test/test_global_print.cmj test/test_google_closure.cmi test/test_google_closure.cmj test/test_http_server.cmi test/test_http_server.cmj test/test_include.cmi test/test_include.cmj test/test_incomplete.cmi test/test_incomplete.cmj test/test_incr_ref.cmi test/test_incr_ref.cmj test/test_index.cmi test/test_index.cmj test/test_int_map_find.cmi test/test_int_map_find.cmj test/test_internalOO.cmi test/test_internalOO.cmj test/test_is_js.cmi test/test_is_js.cmj test/test_js_ffi.cmi test/test_js_ffi.cmj test/test_let.cmi test/test_let.cmj test/test_list.cmi test/test_list.cmj test/test_literal.cmi test/test_literal.cmj test/test_literals.cmi test/test_literals.cmj test/test_match_exception.cmi test/test_match_exception.cmj test/test_mutliple.cmi test/test_mutliple.cmj test/test_nat64.cmi test/test_nat64.cmj test/test_nested_let.cmi test/test_nested_let.cmj test/test_nested_print.cmi test/test_nested_print.cmj test/test_non_export.cmi test/test_non_export.cmj test/test_nullary.cmi test/test_nullary.cmj test/test_obj.cmi test/test_obj.cmj test/test_obj_simple_ffi.cmi test/test_obj_simple_ffi.cmj test/test_order.cmi test/test_order.cmj test/test_order_tailcall.cmi test/test_order_tailcall.cmj test/test_other_exn.cmi test/test_other_exn.cmj test/test_pack.cmi test/test_pack.cmj test/test_per.cmi test/test_per.cmj test/test_pervasive.cmi test/test_pervasive.cmj test/test_pervasives2.cmi test/test_pervasives2.cmj test/test_pervasives3.cmi test/test_pervasives3.cmj test/test_primitive.cmi test/test_primitive.cmj test/test_promise_bind.cmi test/test_promise_bind.cmj test/test_ramification.cmi test/test_ramification.cmj test/test_react.cmi test/test_react.cmj test/test_react_case.cmi test/test_react_case.cmj test/test_regex.cmi test/test_regex.cmj test/test_require.cmi test/test_require.cmj test/test_runtime_encoding.cmi test/test_runtime_encoding.cmj test/test_scope.cmi test/test_scope.cmj test/test_seq.cmi test/test_seq.cmj test/test_set.cmi test/test_set.cmj test/test_side_effect_functor.cmi test/test_side_effect_functor.cmj test/test_simple_include.cmi test/test_simple_include.cmj test/test_simple_pattern_match.cmi test/test_simple_pattern_match.cmj test/test_simple_ref.cmi test/test_simple_ref.cmj test/test_simple_tailcall.cmi test/test_simple_tailcall.cmj test/test_small.cmi test/test_small.cmj test/test_sprintf.cmi test/test_sprintf.cmj test/test_stack.cmi test/test_stack.cmj test/test_static_catch_ident.cmi test/test_static_catch_ident.cmj test/test_string.cmi test/test_string.cmj test/test_string_case.cmi test/test_string_case.cmj test/test_string_const.cmi test/test_string_const.cmj test/test_string_map.cmi test/test_string_map.cmj test/test_string_switch.cmi test/test_string_switch.cmj test/test_switch.cmi test/test_switch.cmj test/test_trywith.cmi test/test_trywith.cmj test/test_tuple.cmi test/test_tuple.cmj test/test_tuple_destructring.cmi test/test_tuple_destructring.cmj test/test_type_based_arity.cmi test/test_type_based_arity.cmj test/test_u.cmi test/test_u.cmj test/test_unknown.cmi test/test_unknown.cmj test/test_unsafe_cmp.cmi test/test_unsafe_cmp.cmj test/test_unsafe_obj_ffi.cmi test/test_unsafe_obj_ffi.cmj test/test_unsafe_obj_ffi_ppx.cmi test/test_unsafe_obj_ffi_ppx.cmj test/test_unsupported_primitive.cmi test/test_unsupported_primitive.cmj test/test_while_closure.cmi test/test_while_closure.cmj test/test_while_side_effect.cmi test/test_while_side_effect.cmj test/test_zero_nullable.cmi test/test_zero_nullable.cmj test/then_mangle_test.cmi test/then_mangle_test.cmj test/ticker.cmi test/ticker.cmj test/to_string_test.cmi test/to_string_test.cmj test/topsort_test.cmi test/topsort_test.cmj test/tramp_fib.cmi test/tramp_fib.cmj test/tuple_alloc.cmi test/tuple_alloc.cmj test/type_disambiguate.cmi test/type_disambiguate.cmj test/typeof_test.cmi test/typeof_test.cmj test/ui_defs.cmi test/unboxed_attribute.cmi test/unboxed_attribute.cmj test/unboxed_attribute_test.cmi test/unboxed_attribute_test.cmj test/unboxed_crash.cmi test/unboxed_crash.cmj test/unboxed_use_case.cmi test/unboxed_use_case.cmj test/uncurry_external_test.cmi test/uncurry_external_test.cmj test/uncurry_glob_test.cmi test/uncurry_glob_test.cmj test/uncurry_method.cmi test/uncurry_method.cmj test/uncurry_test.cmi test/uncurry_test.cmj test/undef_regression2_test.cmi test/undef_regression2_test.cmj test/undef_regression_test.cmi test/undef_regression_test.cmj test/undefine_conditional.cmi test/undefine_conditional.cmj test/unicode_type_error.cmi test/unicode_type_error.cmj test/unit_undefined_test.cmi test/unit_undefined_test.cmj test/unitest_string.cmi test/unitest_string.cmj test/unsafe_full_apply_primitive.cmi test/unsafe_full_apply_primitive.cmj test/unsafe_obj_external.cmi test/unsafe_obj_external.cmj test/unsafe_ppx_test.cmi test/unsafe_ppx_test.cmj test/unsafe_this.cmi test/unsafe_this.cmj test/update_record_test.cmi test/update_record_test.cmj test/utf8_decode_test.cmi test/utf8_decode_test.cmj test/variant.cmi test/variant.cmj test/watch_test.cmi test/watch_test.cmj test/webpack_config.cmi test/webpack_config.cmj
diff --git a/jscomp/test/gpr_5557.js b/jscomp/test/gpr_5557.js
new file mode 100644
index 0000000000..14fcdbe75f
--- /dev/null
+++ b/jscomp/test/gpr_5557.js
@@ -0,0 +1,23 @@
+'use strict';
+
+
+function isA(c) {
+  if (c === 97) {
+    return true;
+  }
+  throw {
+        RE_EXN_ID: "Match_failure",
+        _1: [
+          "gpr_5557.res",
+          5,
+          2
+        ],
+        Error: new Error()
+      };
+}
+
+var h = /* 'a' */97;
+
+exports.isA = isA;
+exports.h = h;
+/* No side effect */
diff --git a/jscomp/test/gpr_5557.res b/jscomp/test/gpr_5557.res
new file mode 100644
index 0000000000..a9342cfcf0
--- /dev/null
+++ b/jscomp/test/gpr_5557.res
@@ -0,0 +1,9 @@
+@@config({
+  flags : ["-w", "-8"]
+})
+let isA = c =>
+  switch c {
+  | 'a' => true
+  }
+
+let h : int = ('a' :> int)  
diff --git a/jscomp/test/gpr_5753.js b/jscomp/test/gpr_5753.js
new file mode 100644
index 0000000000..beabaa708e
--- /dev/null
+++ b/jscomp/test/gpr_5753.js
@@ -0,0 +1,6 @@
+'use strict';
+
+
+console.log(/* '文' */25991);
+
+/*  Not a pure module */
diff --git a/jscomp/test/gpr_5753.res b/jscomp/test/gpr_5753.res
new file mode 100644
index 0000000000..27eb975ef7
--- /dev/null
+++ b/jscomp/test/gpr_5753.res
@@ -0,0 +1,5 @@
+@@config({
+  flags : ["-w", "-8"]
+})
+
+'文'-> Js.log
\ No newline at end of file
diff --git a/jscomp/test/res_debug.js b/jscomp/test/res_debug.js
index bd4779d995..af0d0fa941 100644
--- a/jscomp/test/res_debug.js
+++ b/jscomp/test/res_debug.js
@@ -70,7 +70,7 @@ var v1 = {
   z: 3
 };
 
-var h = /* '\522' */128522;
+var h = /* '😊' */128522;
 
 var hey = "hello, 世界";
 
diff --git a/jscomp/test/string_unicode_test.js b/jscomp/test/string_unicode_test.js
index 46cda2dc3a..e423a44a7b 100644
--- a/jscomp/test/string_unicode_test.js
+++ b/jscomp/test/string_unicode_test.js
@@ -47,9 +47,9 @@ function f(x) {
 
 eq("File \"string_unicode_test.ml\", line 27, characters 7-14", f(/* '{' */123), 0);
 
-eq("File \"string_unicode_test.ml\", line 28, characters 7-14", f(/* '\333' */333), 2);
+eq("File \"string_unicode_test.ml\", line 28, characters 7-14", f(/* 'ō' */333), 2);
 
-eq("File \"string_unicode_test.ml\", line 29, characters 7-14", f(/* '\444' */444), 3);
+eq("File \"string_unicode_test.ml\", line 29, characters 7-14", f(/* 'Ƽ' */444), 3);
 
 Mt.from_pair_suites("string_unicode_test.ml", suites.contents);
 
diff --git a/lib/4.06.1/rescript.ml b/lib/4.06.1/rescript.ml
index 7bfb38d172..ea4a79a1da 100644
--- a/lib/4.06.1/rescript.ml
+++ b/lib/4.06.1/rescript.ml
@@ -6472,6 +6472,184 @@ let real_path p =
 
 let is_same_paths_via_io a b = if a = b then true else real_path a = real_path b
 
+end
+module Ext_utf8 : sig 
+#1 "ext_utf8.mli"
+(* Copyright (C) 2015-2016 Bloomberg Finance L.P.
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
+
+type byte = Single of int | Cont of int | Leading of int * int | Invalid
+
+val classify : char -> byte
+
+val follow : string -> int -> int -> int -> int * int
+
+val next : string -> remaining:int -> int -> int
+(** 
+   return [-1] if failed 
+*)
+
+exception Invalid_utf8 of string
+
+val decode_utf8_string : string -> int list
+
+val encode_codepoint : int -> string
+
+end = struct
+#1 "ext_utf8.ml"
+(* Copyright (C) 2015-2016 Bloomberg Finance L.P.
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
+
+type byte = Single of int | Cont of int | Leading of int * int | Invalid
+
+(** [classify chr] returns the {!byte} corresponding to [chr] *)
+let classify chr =
+  let c = int_of_char chr in
+  (* Classify byte according to leftmost 0 bit *)
+  if c land 0b1000_0000 = 0 then Single c
+  else if (* c 0b0____*)
+          c land 0b0100_0000 = 0 then Cont (c land 0b0011_1111)
+  else if (* c 0b10___*)
+          c land 0b0010_0000 = 0 then Leading (1, c land 0b0001_1111)
+  else if (* c 0b110__*)
+          c land 0b0001_0000 = 0 then Leading (2, c land 0b0000_1111)
+  else if (* c 0b1110_ *)
+          c land 0b0000_1000 = 0 then Leading (3, c land 0b0000_0111)
+  else if (* c 0b1111_0___*)
+          c land 0b0000_0100 = 0 then Leading (4, c land 0b0000_0011)
+  else if (* c 0b1111_10__*)
+          c land 0b0000_0010 = 0 then Leading (5, c land 0b0000_0001)
+    (* c 0b1111_110__ *)
+  else Invalid
+
+exception Invalid_utf8 of string
+
+(* when the first char is [Leading],
+   TODO: need more error checking
+   when out of bond
+*)
+let rec follow s n (c : int) offset =
+  if n = 0 then (c, offset)
+  else
+    match classify s.[offset + 1] with
+    | Cont cc -> follow s (n - 1) ((c lsl 6) lor (cc land 0x3f)) (offset + 1)
+    | _ -> raise (Invalid_utf8 "Continuation byte expected")
+
+let rec next s ~remaining offset =
+  if remaining = 0 then offset
+  else
+    match classify s.[offset + 1] with
+    | Cont _cc -> next s ~remaining:(remaining - 1) (offset + 1)
+    | _ -> -1
+    | exception _ -> -1
+(* it can happen when out of bound *)
+
+let decode_utf8_string s =
+  let lst = ref [] in
+  let add elem = lst := elem :: !lst in
+  let rec decode_utf8_cont s i s_len =
+    if i = s_len then ()
+    else
+      match classify s.[i] with
+      | Single c ->
+          add c;
+          decode_utf8_cont s (i + 1) s_len
+      | Cont _ -> raise (Invalid_utf8 "Unexpected continuation byte")
+      | Leading (n, c) ->
+          let c', i' = follow s n c i in
+          add c';
+          decode_utf8_cont s (i' + 1) s_len
+      | Invalid -> raise (Invalid_utf8 "Invalid byte")
+  in
+  decode_utf8_cont s 0 (String.length s);
+  List.rev !lst
+
+(** To decode {j||j} we need verify in the ast so that we have better error 
+    location, then we do the decode later
+*)
+
+(* let verify s loc =
+   assert false *)
+
+let encode_codepoint c =
+  (* reused from syntax/src/res_utf8.ml *)
+  let h2 = 0b1100_0000 in
+  let h3 = 0b1110_0000 in
+  let h4 = 0b1111_0000 in
+  let cont_mask = 0b0011_1111 in
+  if c <= 127 then (
+    let bytes = (Bytes.create [@doesNotRaise]) 1 in
+    Bytes.unsafe_set bytes 0 (Char.unsafe_chr c);
+    Bytes.unsafe_to_string bytes)
+  else if c <= 2047 then (
+    let bytes = (Bytes.create [@doesNotRaise]) 2 in
+    Bytes.unsafe_set bytes 0 (Char.unsafe_chr (h2 lor (c lsr 6)));
+    Bytes.unsafe_set bytes 1
+      (Char.unsafe_chr (0b1000_0000 lor (c land cont_mask)));
+    Bytes.unsafe_to_string bytes)
+  else if c <= 65535 then (
+    let bytes = (Bytes.create [@doesNotRaise]) 3 in
+    Bytes.unsafe_set bytes 0 (Char.unsafe_chr (h3 lor (c lsr 12)));
+    Bytes.unsafe_set bytes 1
+      (Char.unsafe_chr (0b1000_0000 lor ((c lsr 6) land cont_mask)));
+    Bytes.unsafe_set bytes 2
+      (Char.unsafe_chr (0b1000_0000 lor (c land cont_mask)));
+    Bytes.unsafe_to_string bytes)
+  else
+    (* if c <= max then *)
+    let bytes = (Bytes.create [@doesNotRaise]) 4 in
+    Bytes.unsafe_set bytes 0 (Char.unsafe_chr (h4 lor (c lsr 18)));
+    Bytes.unsafe_set bytes 1
+      (Char.unsafe_chr (0b1000_0000 lor ((c lsr 12) land cont_mask)));
+    Bytes.unsafe_set bytes 2
+      (Char.unsafe_chr (0b1000_0000 lor ((c lsr 6) land cont_mask)));
+    Bytes.unsafe_set bytes 3
+      (Char.unsafe_chr (0b1000_0000 lor (c land cont_mask)));
+    Bytes.unsafe_to_string bytes
+
+
 end
 module Ext_util : sig 
 #1 "ext_util.mli"
@@ -6503,6 +6681,9 @@ val power_2_above : int -> int -> int
 
 val stats_to_string : Hashtbl.statistics -> string
 
+val string_of_int_as_char : int -> string
+
+
 end = struct
 #1 "ext_util.ml"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
@@ -6548,6 +6729,25 @@ let stats_to_string
     (String.concat ","
        (Array.to_list (Array.map string_of_int bucket_histogram)))
 
+let string_of_int_as_char (i : int) : string =
+  if i <= 255 && i >= 0 then Format.asprintf "%C" (Char.unsafe_chr i)
+  else
+    let str =
+      match Char.unsafe_chr i with
+      | '\'' -> "\\'"
+      | '\\' -> "\\\\"
+      | '\n' -> "\\n"
+      | '\t' -> "\\t"
+      | '\r' -> "\\r"
+      | '\b' -> "\\b"
+      | ' ' .. '~' as c ->
+          let s = (Bytes.create [@doesNotRaise]) 1 in
+          Bytes.unsafe_set s 0 c;
+          Bytes.unsafe_to_string s
+      | _ -> Ext_utf8.encode_codepoint i
+    in
+    Printf.sprintf "\'%s\'" str
+
 end
 module Hash_gen
 = struct
diff --git a/lib/4.06.1/rescript.ml.d b/lib/4.06.1/rescript.ml.d
index ebfcb8e90e..f195047559 100644
--- a/lib/4.06.1/rescript.ml.d
+++ b/lib/4.06.1/rescript.ml.d
@@ -115,6 +115,8 @@
 ../lib/4.06.1/rescript.ml: ./ext/ext_string.pp.mli
 ../lib/4.06.1/rescript.ml: ./ext/ext_sys.mli
 ../lib/4.06.1/rescript.ml: ./ext/ext_sys.pp.ml
+../lib/4.06.1/rescript.ml: ./ext/ext_utf8.ml
+../lib/4.06.1/rescript.ml: ./ext/ext_utf8.mli
 ../lib/4.06.1/rescript.ml: ./ext/ext_util.ml
 ../lib/4.06.1/rescript.ml: ./ext/ext_util.mli
 ../lib/4.06.1/rescript.ml: ./ext/hash.ml
diff --git a/lib/4.06.1/unstable/all_ounit_tests.ml b/lib/4.06.1/unstable/all_ounit_tests.ml
index ec50f41a69..9c35d9db45 100644
--- a/lib/4.06.1/unstable/all_ounit_tests.ml
+++ b/lib/4.06.1/unstable/all_ounit_tests.ml
@@ -6388,6 +6388,184 @@ external set_as_old_file : string -> unit = "caml_stale_file"
 
 
 
+end
+module Ext_utf8 : sig 
+#1 "ext_utf8.mli"
+(* Copyright (C) 2015-2016 Bloomberg Finance L.P.
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
+
+type byte = Single of int | Cont of int | Leading of int * int | Invalid
+
+val classify : char -> byte
+
+val follow : string -> int -> int -> int -> int * int
+
+val next : string -> remaining:int -> int -> int
+(** 
+   return [-1] if failed 
+*)
+
+exception Invalid_utf8 of string
+
+val decode_utf8_string : string -> int list
+
+val encode_codepoint : int -> string
+
+end = struct
+#1 "ext_utf8.ml"
+(* Copyright (C) 2015-2016 Bloomberg Finance L.P.
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
+
+type byte = Single of int | Cont of int | Leading of int * int | Invalid
+
+(** [classify chr] returns the {!byte} corresponding to [chr] *)
+let classify chr =
+  let c = int_of_char chr in
+  (* Classify byte according to leftmost 0 bit *)
+  if c land 0b1000_0000 = 0 then Single c
+  else if (* c 0b0____*)
+          c land 0b0100_0000 = 0 then Cont (c land 0b0011_1111)
+  else if (* c 0b10___*)
+          c land 0b0010_0000 = 0 then Leading (1, c land 0b0001_1111)
+  else if (* c 0b110__*)
+          c land 0b0001_0000 = 0 then Leading (2, c land 0b0000_1111)
+  else if (* c 0b1110_ *)
+          c land 0b0000_1000 = 0 then Leading (3, c land 0b0000_0111)
+  else if (* c 0b1111_0___*)
+          c land 0b0000_0100 = 0 then Leading (4, c land 0b0000_0011)
+  else if (* c 0b1111_10__*)
+          c land 0b0000_0010 = 0 then Leading (5, c land 0b0000_0001)
+    (* c 0b1111_110__ *)
+  else Invalid
+
+exception Invalid_utf8 of string
+
+(* when the first char is [Leading],
+   TODO: need more error checking
+   when out of bond
+*)
+let rec follow s n (c : int) offset =
+  if n = 0 then (c, offset)
+  else
+    match classify s.[offset + 1] with
+    | Cont cc -> follow s (n - 1) ((c lsl 6) lor (cc land 0x3f)) (offset + 1)
+    | _ -> raise (Invalid_utf8 "Continuation byte expected")
+
+let rec next s ~remaining offset =
+  if remaining = 0 then offset
+  else
+    match classify s.[offset + 1] with
+    | Cont _cc -> next s ~remaining:(remaining - 1) (offset + 1)
+    | _ -> -1
+    | exception _ -> -1
+(* it can happen when out of bound *)
+
+let decode_utf8_string s =
+  let lst = ref [] in
+  let add elem = lst := elem :: !lst in
+  let rec decode_utf8_cont s i s_len =
+    if i = s_len then ()
+    else
+      match classify s.[i] with
+      | Single c ->
+          add c;
+          decode_utf8_cont s (i + 1) s_len
+      | Cont _ -> raise (Invalid_utf8 "Unexpected continuation byte")
+      | Leading (n, c) ->
+          let c', i' = follow s n c i in
+          add c';
+          decode_utf8_cont s (i' + 1) s_len
+      | Invalid -> raise (Invalid_utf8 "Invalid byte")
+  in
+  decode_utf8_cont s 0 (String.length s);
+  List.rev !lst
+
+(** To decode {j||j} we need verify in the ast so that we have better error 
+    location, then we do the decode later
+*)
+
+(* let verify s loc =
+   assert false *)
+
+let encode_codepoint c =
+  (* reused from syntax/src/res_utf8.ml *)
+  let h2 = 0b1100_0000 in
+  let h3 = 0b1110_0000 in
+  let h4 = 0b1111_0000 in
+  let cont_mask = 0b0011_1111 in
+  if c <= 127 then (
+    let bytes = (Bytes.create [@doesNotRaise]) 1 in
+    Bytes.unsafe_set bytes 0 (Char.unsafe_chr c);
+    Bytes.unsafe_to_string bytes)
+  else if c <= 2047 then (
+    let bytes = (Bytes.create [@doesNotRaise]) 2 in
+    Bytes.unsafe_set bytes 0 (Char.unsafe_chr (h2 lor (c lsr 6)));
+    Bytes.unsafe_set bytes 1
+      (Char.unsafe_chr (0b1000_0000 lor (c land cont_mask)));
+    Bytes.unsafe_to_string bytes)
+  else if c <= 65535 then (
+    let bytes = (Bytes.create [@doesNotRaise]) 3 in
+    Bytes.unsafe_set bytes 0 (Char.unsafe_chr (h3 lor (c lsr 12)));
+    Bytes.unsafe_set bytes 1
+      (Char.unsafe_chr (0b1000_0000 lor ((c lsr 6) land cont_mask)));
+    Bytes.unsafe_set bytes 2
+      (Char.unsafe_chr (0b1000_0000 lor (c land cont_mask)));
+    Bytes.unsafe_to_string bytes)
+  else
+    (* if c <= max then *)
+    let bytes = (Bytes.create [@doesNotRaise]) 4 in
+    Bytes.unsafe_set bytes 0 (Char.unsafe_chr (h4 lor (c lsr 18)));
+    Bytes.unsafe_set bytes 1
+      (Char.unsafe_chr (0b1000_0000 lor ((c lsr 12) land cont_mask)));
+    Bytes.unsafe_set bytes 2
+      (Char.unsafe_chr (0b1000_0000 lor ((c lsr 6) land cont_mask)));
+    Bytes.unsafe_set bytes 3
+      (Char.unsafe_chr (0b1000_0000 lor (c land cont_mask)));
+    Bytes.unsafe_to_string bytes
+
+
 end
 module Ext_util : sig 
 #1 "ext_util.mli"
@@ -6419,6 +6597,9 @@ val power_2_above : int -> int -> int
 
 val stats_to_string : Hashtbl.statistics -> string
 
+val string_of_int_as_char : int -> string
+
+
 end = struct
 #1 "ext_util.ml"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
@@ -6464,6 +6645,25 @@ let stats_to_string
     (String.concat ","
        (Array.to_list (Array.map string_of_int bucket_histogram)))
 
+let string_of_int_as_char (i : int) : string =
+  if i <= 255 && i >= 0 then Format.asprintf "%C" (Char.unsafe_chr i)
+  else
+    let str =
+      match Char.unsafe_chr i with
+      | '\'' -> "\\'"
+      | '\\' -> "\\\\"
+      | '\n' -> "\\n"
+      | '\t' -> "\\t"
+      | '\r' -> "\\r"
+      | '\b' -> "\\b"
+      | ' ' .. '~' as c ->
+          let s = (Bytes.create [@doesNotRaise]) 1 in
+          Bytes.unsafe_set s 0 c;
+          Bytes.unsafe_to_string s
+      | _ -> Ext_utf8.encode_codepoint i
+    in
+    Printf.sprintf "\'%s\'" str
+
 end
 module Hash_gen
 = struct
@@ -10698,7 +10898,7 @@ module Asttypes
 
 type constant =
     Const_int of int
-  | Const_char of char
+  | Const_char of int
   | Const_string of string * string option
   | Const_float of string
   | Const_int32 of int32
@@ -10752,6 +10952,7 @@ let same_arg_label (x : arg_label) y =
       | Optional s0 -> s = s0
       | _ -> false  
       end  
+
 end
 module Longident : sig 
 #1 "longident.mli"
@@ -10879,7 +11080,7 @@ type constant =
      Suffixes [g-z][G-Z] are accepted by the parser.
      Suffixes except 'l', 'L' and 'n' are rejected by the typechecker
   *)
-  | Pconst_char of char
+  | Pconst_char of int
   (* 'c' *)
   | Pconst_string of string * string option
   (* "constant"
@@ -13983,7 +14184,7 @@ module Const = struct
   let int64 ?(suffix='L') i = integer ~suffix (Int64.to_string i)
   let nativeint ?(suffix='n') i = integer ~suffix (Nativeint.to_string i)
   let float ?suffix f = Pconst_float (f, suffix)
-  let char c = Pconst_char c
+  let char c = Pconst_char (Char.code c)
   let string ?quotation_delimiter s = Pconst_string (s, quotation_delimiter)
 end
 
@@ -25657,7 +25858,7 @@ let yyact = [|
     let _1 = (Parsing.peek_val __caml_parser_env 0 : char) in
     Obj.repr(
 # 2155 "ml/parser.mly"
-                 ( Pconst_char _1 )
+                 ( Pconst_char (Char.code _1) )
 # 11020 "ml/parser.ml"
                : 'constant))
 ; (fun __caml_parser_env ->
@@ -34095,145 +34296,6 @@ let suites =
         end
     ]
 end
-module Ext_utf8 : sig 
-#1 "ext_utf8.mli"
-(* Copyright (C) 2015-2016 Bloomberg Finance L.P.
- *
- * This program is free software: you can redistribute it and/or modify
- * it under the terms of the GNU Lesser General Public License as published by
- * the Free Software Foundation, either version 3 of the License, or
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public License
- * along with this program; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
-
-type byte = Single of int | Cont of int | Leading of int * int | Invalid
-
-val classify : char -> byte
-
-val follow : string -> int -> int -> int -> int * int
-
-val next : string -> remaining:int -> int -> int
-(** 
-   return [-1] if failed 
-*)
-
-exception Invalid_utf8 of string
-
-val decode_utf8_string : string -> int list
-
-end = struct
-#1 "ext_utf8.ml"
-(* Copyright (C) 2015-2016 Bloomberg Finance L.P.
- *
- * This program is free software: you can redistribute it and/or modify
- * it under the terms of the GNU Lesser General Public License as published by
- * the Free Software Foundation, either version 3 of the License, or
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public License
- * along with this program; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
-
-type byte = Single of int | Cont of int | Leading of int * int | Invalid
-
-(** [classify chr] returns the {!byte} corresponding to [chr] *)
-let classify chr =
-  let c = int_of_char chr in
-  (* Classify byte according to leftmost 0 bit *)
-  if c land 0b1000_0000 = 0 then Single c
-  else if (* c 0b0____*)
-          c land 0b0100_0000 = 0 then Cont (c land 0b0011_1111)
-  else if (* c 0b10___*)
-          c land 0b0010_0000 = 0 then Leading (1, c land 0b0001_1111)
-  else if (* c 0b110__*)
-          c land 0b0001_0000 = 0 then Leading (2, c land 0b0000_1111)
-  else if (* c 0b1110_ *)
-          c land 0b0000_1000 = 0 then Leading (3, c land 0b0000_0111)
-  else if (* c 0b1111_0___*)
-          c land 0b0000_0100 = 0 then Leading (4, c land 0b0000_0011)
-  else if (* c 0b1111_10__*)
-          c land 0b0000_0010 = 0 then Leading (5, c land 0b0000_0001)
-    (* c 0b1111_110__ *)
-  else Invalid
-
-exception Invalid_utf8 of string
-
-(* when the first char is [Leading],
-   TODO: need more error checking
-   when out of bond
-*)
-let rec follow s n (c : int) offset =
-  if n = 0 then (c, offset)
-  else
-    match classify s.[offset + 1] with
-    | Cont cc -> follow s (n - 1) ((c lsl 6) lor (cc land 0x3f)) (offset + 1)
-    | _ -> raise (Invalid_utf8 "Continuation byte expected")
-
-let rec next s ~remaining offset =
-  if remaining = 0 then offset
-  else
-    match classify s.[offset + 1] with
-    | Cont _cc -> next s ~remaining:(remaining - 1) (offset + 1)
-    | _ -> -1
-    | exception _ -> -1
-(* it can happen when out of bound *)
-
-let decode_utf8_string s =
-  let lst = ref [] in
-  let add elem = lst := elem :: !lst in
-  let rec decode_utf8_cont s i s_len =
-    if i = s_len then ()
-    else
-      match classify s.[i] with
-      | Single c ->
-          add c;
-          decode_utf8_cont s (i + 1) s_len
-      | Cont _ -> raise (Invalid_utf8 "Unexpected continuation byte")
-      | Leading (n, c) ->
-          let c', i' = follow s n c i in
-          add c';
-          decode_utf8_cont s (i' + 1) s_len
-      | Invalid -> raise (Invalid_utf8 "Invalid byte")
-  in
-  decode_utf8_cont s 0 (String.length s);
-  List.rev !lst
-
-(** To decode {j||j} we need verify in the ast so that we have better error 
-    location, then we do the decode later
-*)
-
-(* let verify s loc =
-   assert false *)
-
-end
 module Ext_js_regex : sig 
 #1 "ext_js_regex.mli"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
@@ -51154,7 +51216,7 @@ type float_lit = { f : string } [@@unboxed]
 
 type number =
   | Float of float_lit
-  | Int of { i : int32; c : char option }
+  | Int of { i : int32; c : int option }
   | Uint of int32
 
 (* becareful when constant folding +/-,
diff --git a/lib/4.06.1/unstable/js_compiler.ml b/lib/4.06.1/unstable/js_compiler.ml
index 65064ce4aa..0b2dc20e7b 100644
--- a/lib/4.06.1/unstable/js_compiler.ml
+++ b/lib/4.06.1/unstable/js_compiler.ml
@@ -3122,7 +3122,7 @@ module Asttypes
 
 type constant =
     Const_int of int
-  | Const_char of char
+  | Const_char of int
   | Const_string of string * string option
   | Const_float of string
   | Const_int32 of int32
@@ -3176,6 +3176,7 @@ let same_arg_label (x : arg_label) y =
       | Optional s0 -> s = s0
       | _ -> false  
       end  
+
 end
 module Identifiable : sig 
 #1 "identifiable.mli"
@@ -4000,7 +4001,7 @@ type constant =
      Suffixes [g-z][G-Z] are accepted by the parser.
      Suffixes except 'l', 'L' and 'n' are rejected by the typechecker
   *)
-  | Pconst_char of char
+  | Pconst_char of int
   (* 'c' *)
   | Pconst_string of string * string option
   (* "constant"
@@ -12153,7 +12154,7 @@ module Const = struct
   let int64 ?(suffix='L') i = integer ~suffix (Int64.to_string i)
   let nativeint ?(suffix='n') i = integer ~suffix (Nativeint.to_string i)
   let float ?suffix f = Pconst_float (f, suffix)
-  let char c = Pconst_char c
+  let char c = Pconst_char (Char.code c)
   let string ?quotation_delimiter s = Pconst_string (s, quotation_delimiter)
 end
 
@@ -24864,6 +24865,1748 @@ let lam_of_loc kind loc =
 let reset () =
   raise_count := 0
 
+end
+module Ext_utf8 : sig 
+#1 "ext_utf8.mli"
+(* Copyright (C) 2015-2016 Bloomberg Finance L.P.
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
+
+type byte = Single of int | Cont of int | Leading of int * int | Invalid
+
+val classify : char -> byte
+
+val follow : string -> int -> int -> int -> int * int
+
+val next : string -> remaining:int -> int -> int
+(** 
+   return [-1] if failed 
+*)
+
+exception Invalid_utf8 of string
+
+val decode_utf8_string : string -> int list
+
+val encode_codepoint : int -> string
+
+end = struct
+#1 "ext_utf8.ml"
+(* Copyright (C) 2015-2016 Bloomberg Finance L.P.
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
+
+type byte = Single of int | Cont of int | Leading of int * int | Invalid
+
+(** [classify chr] returns the {!byte} corresponding to [chr] *)
+let classify chr =
+  let c = int_of_char chr in
+  (* Classify byte according to leftmost 0 bit *)
+  if c land 0b1000_0000 = 0 then Single c
+  else if (* c 0b0____*)
+          c land 0b0100_0000 = 0 then Cont (c land 0b0011_1111)
+  else if (* c 0b10___*)
+          c land 0b0010_0000 = 0 then Leading (1, c land 0b0001_1111)
+  else if (* c 0b110__*)
+          c land 0b0001_0000 = 0 then Leading (2, c land 0b0000_1111)
+  else if (* c 0b1110_ *)
+          c land 0b0000_1000 = 0 then Leading (3, c land 0b0000_0111)
+  else if (* c 0b1111_0___*)
+          c land 0b0000_0100 = 0 then Leading (4, c land 0b0000_0011)
+  else if (* c 0b1111_10__*)
+          c land 0b0000_0010 = 0 then Leading (5, c land 0b0000_0001)
+    (* c 0b1111_110__ *)
+  else Invalid
+
+exception Invalid_utf8 of string
+
+(* when the first char is [Leading],
+   TODO: need more error checking
+   when out of bond
+*)
+let rec follow s n (c : int) offset =
+  if n = 0 then (c, offset)
+  else
+    match classify s.[offset + 1] with
+    | Cont cc -> follow s (n - 1) ((c lsl 6) lor (cc land 0x3f)) (offset + 1)
+    | _ -> raise (Invalid_utf8 "Continuation byte expected")
+
+let rec next s ~remaining offset =
+  if remaining = 0 then offset
+  else
+    match classify s.[offset + 1] with
+    | Cont _cc -> next s ~remaining:(remaining - 1) (offset + 1)
+    | _ -> -1
+    | exception _ -> -1
+(* it can happen when out of bound *)
+
+let decode_utf8_string s =
+  let lst = ref [] in
+  let add elem = lst := elem :: !lst in
+  let rec decode_utf8_cont s i s_len =
+    if i = s_len then ()
+    else
+      match classify s.[i] with
+      | Single c ->
+          add c;
+          decode_utf8_cont s (i + 1) s_len
+      | Cont _ -> raise (Invalid_utf8 "Unexpected continuation byte")
+      | Leading (n, c) ->
+          let c', i' = follow s n c i in
+          add c';
+          decode_utf8_cont s (i' + 1) s_len
+      | Invalid -> raise (Invalid_utf8 "Invalid byte")
+  in
+  decode_utf8_cont s 0 (String.length s);
+  List.rev !lst
+
+(** To decode {j||j} we need verify in the ast so that we have better error 
+    location, then we do the decode later
+*)
+
+(* let verify s loc =
+   assert false *)
+
+let encode_codepoint c =
+  (* reused from syntax/src/res_utf8.ml *)
+  let h2 = 0b1100_0000 in
+  let h3 = 0b1110_0000 in
+  let h4 = 0b1111_0000 in
+  let cont_mask = 0b0011_1111 in
+  if c <= 127 then (
+    let bytes = (Bytes.create [@doesNotRaise]) 1 in
+    Bytes.unsafe_set bytes 0 (Char.unsafe_chr c);
+    Bytes.unsafe_to_string bytes)
+  else if c <= 2047 then (
+    let bytes = (Bytes.create [@doesNotRaise]) 2 in
+    Bytes.unsafe_set bytes 0 (Char.unsafe_chr (h2 lor (c lsr 6)));
+    Bytes.unsafe_set bytes 1
+      (Char.unsafe_chr (0b1000_0000 lor (c land cont_mask)));
+    Bytes.unsafe_to_string bytes)
+  else if c <= 65535 then (
+    let bytes = (Bytes.create [@doesNotRaise]) 3 in
+    Bytes.unsafe_set bytes 0 (Char.unsafe_chr (h3 lor (c lsr 12)));
+    Bytes.unsafe_set bytes 1
+      (Char.unsafe_chr (0b1000_0000 lor ((c lsr 6) land cont_mask)));
+    Bytes.unsafe_set bytes 2
+      (Char.unsafe_chr (0b1000_0000 lor (c land cont_mask)));
+    Bytes.unsafe_to_string bytes)
+  else
+    (* if c <= max then *)
+    let bytes = (Bytes.create [@doesNotRaise]) 4 in
+    Bytes.unsafe_set bytes 0 (Char.unsafe_chr (h4 lor (c lsr 18)));
+    Bytes.unsafe_set bytes 1
+      (Char.unsafe_chr (0b1000_0000 lor ((c lsr 12) land cont_mask)));
+    Bytes.unsafe_set bytes 2
+      (Char.unsafe_chr (0b1000_0000 lor ((c lsr 6) land cont_mask)));
+    Bytes.unsafe_set bytes 3
+      (Char.unsafe_chr (0b1000_0000 lor (c land cont_mask)));
+    Bytes.unsafe_to_string bytes
+
+
+end
+module Ext_util : sig 
+#1 "ext_util.mli"
+(* Copyright (C) 2015-2016 Bloomberg Finance L.P.
+ * 
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ * 
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
+
+val power_2_above : int -> int -> int
+
+val stats_to_string : Hashtbl.statistics -> string
+
+val string_of_int_as_char : int -> string
+
+
+end = struct
+#1 "ext_util.ml"
+(* Copyright (C) 2015-2016 Bloomberg Finance L.P.
+ * 
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ * 
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
+
+(**
+   {[
+     (power_2_above 16 63 = 64)
+       (power_2_above 16 76 = 128)
+   ]}
+*)
+let rec power_2_above x n =
+  if x >= n then x
+  else if x * 2 > Sys.max_array_length then x
+  else power_2_above (x * 2) n
+
+let stats_to_string
+    ({ num_bindings; num_buckets; max_bucket_length; bucket_histogram } :
+      Hashtbl.statistics) =
+  Printf.sprintf "bindings: %d,buckets: %d, longest: %d, hist:[%s]" num_bindings
+    num_buckets max_bucket_length
+    (String.concat ","
+       (Array.to_list (Array.map string_of_int bucket_histogram)))
+
+let string_of_int_as_char (i : int) : string =
+  if i <= 255 && i >= 0 then Format.asprintf "%C" (Char.unsafe_chr i)
+  else
+    let str =
+      match Char.unsafe_chr i with
+      | '\'' -> "\\'"
+      | '\\' -> "\\\\"
+      | '\n' -> "\\n"
+      | '\t' -> "\\t"
+      | '\r' -> "\\r"
+      | '\b' -> "\\b"
+      | ' ' .. '~' as c ->
+          let s = (Bytes.create [@doesNotRaise]) 1 in
+          Bytes.unsafe_set s 0 c;
+          Bytes.unsafe_to_string s
+      | _ -> Ext_utf8.encode_codepoint i
+    in
+    Printf.sprintf "\'%s\'" str
+
+end
+module Pprintast : sig 
+#1 "pprintast.mli"
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Hongbo Zhang (University of Pennsylvania)                  *)
+(*                                                                        *)
+(*   Copyright 1996 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+type space_formatter = (unit, Format.formatter, unit) format
+
+
+val expression : Format.formatter -> Parsetree.expression -> unit
+val string_of_expression : Parsetree.expression -> string
+
+val core_type: Format.formatter -> Parsetree.core_type -> unit
+val pattern: Format.formatter -> Parsetree.pattern -> unit
+val signature: Format.formatter -> Parsetree.signature -> unit
+val structure: Format.formatter -> Parsetree.structure -> unit
+val string_of_structure: Parsetree.structure -> string
+val string_of_int_as_char: int -> string
+
+end = struct
+#1 "pprintast.pp.ml"
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                      Thomas Gazagnaire, OCamlPro                       *)
+(*                   Fabrice Le Fessant, INRIA Saclay                     *)
+(*               Hongbo Zhang, University of Pennsylvania                 *)
+(*                                                                        *)
+(*   Copyright 2007 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Original Code from Ber-metaocaml, modified for 3.12.0 and fixed *)
+(* Printing code expressions *)
+(* Authors:  Ed Pizzi, Fabrice Le Fessant *)
+(* Extensive Rewrite: Hongbo Zhang: University of Pennsylvania *)
+(* TODO more fine-grained precedence pretty-printing *)
+
+open Asttypes
+open Format
+open Location
+open Longident
+open Parsetree
+open Ast_helper
+
+let prefix_symbols  = [ '!'; '?'; '~' ] ;;
+let infix_symbols = [ '='; '<'; '>'; '@'; '^'; '|'; '&'; '+'; '-'; '*'; '/';
+                      '$'; '%'; '#' ]
+
+(* type fixity = Infix| Prefix  *)
+let special_infix_strings =
+  ["asr"; "land"; "lor"; "lsl"; "lsr"; "lxor"; "mod"; "or"; ":="; "!="; "::" ]
+
+(* determines if the string is an infix string.
+   checks backwards, first allowing a renaming postfix ("_102") which
+   may have resulted from Pexp -> Texp -> Pexp translation, then checking
+   if all the characters in the beginning of the string are valid infix
+   characters. *)
+let fixity_of_string  = function
+  | s when List.mem s special_infix_strings -> `Infix s
+  | s when List.mem s.[0] infix_symbols -> `Infix s
+  | s when List.mem s.[0] prefix_symbols -> `Prefix s
+  | s when s.[0] = '.' -> `Mixfix s
+  | _ -> `Normal
+
+let view_fixity_of_exp = function
+  | {pexp_desc = Pexp_ident {txt=Lident l;_}; pexp_attributes = []} ->
+      fixity_of_string l
+  | _ -> `Normal
+
+let is_infix  = function  | `Infix _ -> true | _  -> false
+let is_mixfix = function `Mixfix _ -> true | _ -> false
+
+(* which identifiers are in fact operators needing parentheses *)
+let needs_parens txt =
+  let fix = fixity_of_string txt in
+  is_infix fix
+  || is_mixfix fix
+  || List.mem txt.[0] prefix_symbols
+
+(* some infixes need spaces around parens to avoid clashes with comment
+   syntax *)
+let needs_spaces txt =
+  txt.[0]='*' || txt.[String.length txt - 1] = '*'
+
+(* add parentheses to binders when they are in fact infix or prefix operators *)
+let protect_ident ppf txt =
+  let format : (_, _, _) format =
+    if not (needs_parens txt) then "%s"
+    else if needs_spaces txt then "(@;%s@;)"
+    else "(%s)"
+  in fprintf ppf format txt
+
+let protect_longident ppf print_longident longprefix txt =
+  let format : (_, _, _) format =
+    if not (needs_parens txt) then "%a.%s"
+    else if needs_spaces txt then  "%a.(@;%s@;)"
+    else "%a.(%s)" in
+  fprintf ppf format print_longident longprefix txt
+
+type space_formatter = (unit, Format.formatter, unit) format
+
+let override = function
+  | Override -> "!"
+  | Fresh -> ""
+
+(* variance encoding: need to sync up with the [parser.mly] *)
+let type_variance = function
+  | Invariant -> ""
+  | Covariant -> "+"
+  | Contravariant -> "-"
+
+type construct =
+  [ `cons of expression list
+  | `list of expression list
+  | `nil
+  | `normal
+  | `simple of Longident.t
+  | `tuple ]
+
+let view_expr x =
+  match x.pexp_desc with
+  | Pexp_construct ( {txt= Lident "()"; _},_) -> `tuple
+  | Pexp_construct ( {txt= Lident "[]";_},_) -> `nil
+  | Pexp_construct ( {txt= Lident"::";_},Some _) ->
+      let rec loop exp acc = match exp with
+          | {pexp_desc=Pexp_construct ({txt=Lident "[]";_},_);
+             pexp_attributes = []} ->
+              (List.rev acc,true)
+          | {pexp_desc=
+             Pexp_construct ({txt=Lident "::";_},
+                             Some ({pexp_desc= Pexp_tuple([e1;e2]);
+                                    pexp_attributes = []}));
+             pexp_attributes = []}
+            ->
+              loop e2 (e1::acc)
+          | e -> (List.rev (e::acc),false) in
+      let (ls,b) = loop x []  in
+      if b then
+        `list ls
+      else `cons ls
+  | Pexp_construct (x,None) -> `simple (x.txt)
+  | _ -> `normal
+
+let is_simple_construct :construct -> bool = function
+  | `nil | `tuple | `list _ | `simple _  -> true
+  | `cons _ | `normal -> false
+
+let pp = fprintf
+
+type ctxt = {
+  pipe : bool;
+  semi : bool;
+  ifthenelse : bool;
+}
+
+let reset_ctxt = { pipe=false; semi=false; ifthenelse=false }
+let under_pipe ctxt = { ctxt with pipe=true }
+let under_semi ctxt = { ctxt with semi=true }
+let under_ifthenelse ctxt = { ctxt with ifthenelse=true }
+(*
+let reset_semi ctxt = { ctxt with semi=false }
+let reset_ifthenelse ctxt = { ctxt with ifthenelse=false }
+let reset_pipe ctxt = { ctxt with pipe=false }
+*)
+
+let list : 'a . ?sep:space_formatter -> ?first:space_formatter ->
+  ?last:space_formatter -> (Format.formatter -> 'a -> unit) ->
+  Format.formatter -> 'a list -> unit
+  = fun ?sep ?first ?last fu f xs ->
+    let first = match first with Some x -> x |None -> ("": _ format6)
+    and last = match last with Some x -> x |None -> ("": _ format6)
+    and sep = match sep with Some x -> x |None -> ("@ ": _ format6) in
+    let aux f = function
+      | [] -> ()
+      | [x] -> fu f x
+      | xs ->
+          let rec loop  f = function
+            | [x] -> fu f x
+            | x::xs ->  fu f x; pp f sep; loop f xs;
+            | _ -> assert false in begin
+            pp f first; loop f xs; pp f last;
+          end in
+    aux f xs
+
+let option : 'a. ?first:space_formatter -> ?last:space_formatter ->
+  (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a option -> unit
+  = fun  ?first  ?last fu f a ->
+    let first = match first with Some x -> x | None -> ("": _ format6)
+    and last = match last with Some x -> x | None -> ("": _ format6) in
+    match a with
+    | None -> ()
+    | Some x -> pp f first; fu f x; pp f last
+
+let paren: 'a . ?first:space_formatter -> ?last:space_formatter ->
+  bool -> (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a -> unit
+  = fun  ?(first=("": _ format6)) ?(last=("": _ format6)) b fu f x ->
+    if b then (pp f "("; pp f first; fu f x; pp f last; pp f ")")
+    else fu f x
+
+let rec longident f = function
+  | Lident s -> protect_ident f s
+  | Ldot(y,s) -> protect_longident f longident y s
+  | Lapply (y,s) ->
+      pp f "%a(%a)" longident y longident s
+
+let longident_loc f x = pp f "%a" longident x.txt
+
+let string_of_int_as_char i = Ext_util.string_of_int_as_char i
+
+let constant f = function
+  | Pconst_char i -> pp f "%s"  (string_of_int_as_char i)
+  | Pconst_string (i, None) -> pp f "%S" i
+  | Pconst_string (i, Some delim) -> pp f "{%s|%s|%s}" delim i delim
+  | Pconst_integer (i, None) -> paren (i.[0]='-') (fun f -> pp f "%s") f i
+  | Pconst_integer (i, Some m) ->
+    paren (i.[0]='-') (fun f (i, m) -> pp f "%s%c" i m) f (i,m)
+  | Pconst_float (i, None) -> paren (i.[0]='-') (fun f -> pp f "%s") f i
+  | Pconst_float (i, Some m) -> paren (i.[0]='-') (fun f (i,m) ->
+      pp f "%s%c" i m) f (i,m)
+
+(* trailing space*)
+let mutable_flag f = function
+  | Immutable -> ()
+  | Mutable -> pp f "mutable@;"
+let virtual_flag f  = function
+  | Concrete -> ()
+  | Virtual -> pp f "virtual@;"
+
+(* trailing space added *)
+let rec_flag f rf =
+  match rf with
+  | Nonrecursive -> ()
+  | Recursive -> pp f "rec "
+let nonrec_flag f rf =
+  match rf with
+  | Nonrecursive -> pp f "nonrec "
+  | Recursive -> ()
+let direction_flag f = function
+  | Upto -> pp f "to@ "
+  | Downto -> pp f "downto@ "
+let private_flag f = function
+  | Public -> ()
+  | Private -> pp f "private@ "
+
+let constant_string f s = pp f "%S" s
+let tyvar f str = pp f "'%s" str
+let tyvar_loc f str = pp f "'%s" str.txt
+let string_quot f x = pp f "`%s" x
+
+(* c ['a,'b] *)
+let rec class_params_def ctxt f =  function
+  | [] -> ()
+  | l ->
+      pp f "[%a] " (* space *)
+        (list (type_param ctxt) ~sep:",") l
+
+and type_with_label ctxt f (label, c) =
+  match label with
+  | Nolabel    -> core_type1 ctxt f c (* otherwise parenthesize *)
+  | Labelled s -> pp f "%s:%a" s (core_type1 ctxt) c
+  | Optional s -> pp f "?%s:%a" s (core_type1 ctxt) c
+
+and core_type ctxt f x =
+  if x.ptyp_attributes <> [] then begin
+    pp f "((%a)%a)" (core_type ctxt) {x with ptyp_attributes=[]}
+      (attributes ctxt) x.ptyp_attributes
+  end
+  else match x.ptyp_desc with
+    | Ptyp_arrow (l, ct1, ct2) ->
+        pp f "@[<2>%a@;->@;%a@]" (* FIXME remove parens later *)
+          (type_with_label ctxt) (l,ct1) (core_type ctxt) ct2
+    | Ptyp_alias (ct, s) ->
+        pp f "@[<2>%a@;as@;'%s@]" (core_type1 ctxt) ct s
+    | Ptyp_poly ([], ct) ->
+        core_type ctxt f ct
+    | Ptyp_poly (sl, ct) ->
+        pp f "@[<2>%a%a@]"
+          (fun f l ->
+             pp f "%a"
+               (fun f l -> match l with
+                  | [] -> ()
+                  | _ ->
+                      pp f "%a@;.@;"
+                        (list tyvar_loc ~sep:"@;")  l)
+               l)
+          sl (core_type ctxt) ct
+    | _ -> pp f "@[<2>%a@]" (core_type1 ctxt) x
+
+and core_type1 ctxt f x =
+  if x.ptyp_attributes <> [] then core_type ctxt f x
+  else match x.ptyp_desc with
+    | Ptyp_any -> pp f "_";
+    | Ptyp_var s -> tyvar f  s;
+    | Ptyp_tuple l ->  pp f "(%a)" (list (core_type1 ctxt) ~sep:"@;*@;") l
+    | Ptyp_constr (li, l) ->
+        pp f (* "%a%a@;" *) "%a%a"
+          (fun f l -> match l with
+             |[] -> ()
+             |[x]-> pp f "%a@;" (core_type1 ctxt)  x
+             | _ -> list ~first:"(" ~last:")@;" (core_type ctxt) ~sep:",@;" f l)
+          l longident_loc li
+    | Ptyp_variant (l, closed, low) ->
+        let type_variant_helper f x =
+          match x with
+          | Rtag (l, attrs, _, ctl) ->
+              pp f "@[<2>%a%a@;%a@]" string_quot l.txt
+                (fun f l -> match l with
+                   |[] -> ()
+                   | _ -> pp f "@;of@;%a"
+                            (list (core_type ctxt) ~sep:"&")  ctl) ctl
+                (attributes ctxt) attrs
+          | Rinherit ct -> core_type ctxt f ct in
+        pp f "@[<2>[%a%a]@]"
+          (fun f l ->
+             match l, closed with
+             | [], Closed -> ()
+             | [], Open -> pp f ">" (* Cf #7200: print [>] correctly *)
+             | _ ->
+                 pp f "%s@;%a"
+                   (match (closed,low) with
+                    | (Closed,None) -> ""
+                    | (Closed,Some _) -> "<" (* FIXME desugar the syntax sugar*)
+                    | (Open,_) -> ">")
+                   (list type_variant_helper ~sep:"@;<1 -2>| ") l) l
+          (fun f low -> match low with
+             |Some [] |None -> ()
+             |Some xs ->
+                 pp f ">@ %a"
+                   (list string_quot) xs) low
+    | Ptyp_object (l, o) ->
+        let core_field_type f = function
+          | Otag (l, attrs, ct) ->
+            pp f "@[<hov2>%s: %a@ %a@ @]" l.txt
+              (core_type ctxt) ct (attributes ctxt) attrs (* Cf #7200 *)
+          | Oinherit ct ->
+            pp f "@[<hov2>%a@ @]" (core_type ctxt) ct
+        in
+        let field_var f = function
+          | Asttypes.Closed -> ()
+          | Asttypes.Open ->
+              match l with
+              | [] -> pp f ".."
+              | _ -> pp f " ;.."
+        in
+        pp f "@[<hov2><@ %a%a@ > @]" (list core_field_type ~sep:";") l
+          field_var o (* Cf #7200 *)
+    | Ptyp_class (li, l) ->   (*FIXME*)
+        pp f "@[<hov2>%a#%a@]"
+          (list (core_type ctxt) ~sep:"," ~first:"(" ~last:")") l
+          longident_loc li
+    | Ptyp_package (lid, cstrs) ->
+        let aux f (s, ct) =
+          pp f "type %a@ =@ %a" longident_loc s (core_type ctxt) ct  in
+        (match cstrs with
+         |[] -> pp f "@[<hov2>(module@ %a)@]" longident_loc lid
+         |_ ->
+             pp f "@[<hov2>(module@ %a@ with@ %a)@]" longident_loc lid
+               (list aux  ~sep:"@ and@ ")  cstrs)
+    | Ptyp_extension e -> extension ctxt f e
+    | _ -> paren true (core_type ctxt) f x
+
+(********************pattern********************)
+(* be cautious when use [pattern], [pattern1] is preferred *)
+and pattern ctxt f x =
+  let rec list_of_pattern acc = function (* only consider ((A|B)|C)*)
+    | {ppat_desc= Ppat_or (p1,p2); ppat_attributes = []} ->
+        list_of_pattern  (p2::acc) p1
+    | x -> x::acc
+  in
+  if x.ppat_attributes <> [] then begin
+    pp f "((%a)%a)" (pattern ctxt) {x with ppat_attributes=[]}
+      (attributes ctxt) x.ppat_attributes
+  end
+  else match x.ppat_desc with
+    | Ppat_alias (p, s) ->
+        pp f "@[<2>%a@;as@;%a@]" (pattern ctxt) p protect_ident s.txt (* RA*)
+    | Ppat_or _ -> (* *)
+        pp f "@[<hov0>%a@]" (list ~sep:"@,|" (pattern ctxt))
+          (list_of_pattern [] x)
+    | _ -> pattern1 ctxt f x
+
+and pattern1 ctxt (f:Format.formatter) (x:pattern) : unit =
+  let rec pattern_list_helper f = function
+    | {ppat_desc =
+         Ppat_construct
+           ({ txt = Lident("::") ;_},
+            Some ({ppat_desc = Ppat_tuple([pat1; pat2]);_}));
+       ppat_attributes = []}
+
+      ->
+        pp f "%a::%a" (simple_pattern ctxt) pat1 pattern_list_helper pat2 (*RA*)
+    | p -> pattern1 ctxt f p
+  in
+  if x.ppat_attributes <> [] then pattern ctxt f x
+  else match x.ppat_desc with
+    | Ppat_variant (l, Some p) ->
+        pp f "@[<2>`%s@;%a@]" l (simple_pattern ctxt) p
+    | Ppat_construct (({txt=Lident("()"|"[]");_}), _) -> simple_pattern ctxt f x
+    | Ppat_construct (({txt;_} as li), po) ->
+        (* FIXME The third field always false *)
+        if txt = Lident "::" then
+          pp f "%a" pattern_list_helper x
+        else
+          (match po with
+           | Some x -> pp f "%a@;%a"  longident_loc li (simple_pattern ctxt) x
+           | None -> pp f "%a" longident_loc li)
+    | _ -> simple_pattern ctxt f x
+
+and simple_pattern ctxt (f:Format.formatter) (x:pattern) : unit =
+  if x.ppat_attributes <> [] then pattern ctxt f x
+  else match x.ppat_desc with
+    | Ppat_construct (({txt=Lident ("()"|"[]" as x);_}), _) -> pp f  "%s" x
+    | Ppat_any -> pp f "_";
+    | Ppat_var ({txt = txt;_}) -> protect_ident f txt
+    | Ppat_array l ->
+        pp f "@[<2>[|%a|]@]"  (list (pattern1 ctxt) ~sep:";") l
+    | Ppat_unpack (s) ->
+        pp f "(module@ %s)@ " s.txt
+    | Ppat_type li ->
+        pp f "#%a" longident_loc li
+    | Ppat_record (l, closed) ->
+        let longident_x_pattern f (li, p) =
+          match (li,p) with
+          | ({txt=Lident s;_ },
+             {ppat_desc=Ppat_var {txt;_};
+              ppat_attributes=[]; _})
+            when s = txt ->
+              pp f "@[<2>%a@]"  longident_loc li
+          | _ ->
+              pp f "@[<2>%a@;=@;%a@]" longident_loc li (pattern1 ctxt) p
+        in
+        begin match closed with
+        | Closed ->
+            pp f "@[<2>{@;%a@;}@]" (list longident_x_pattern ~sep:";@;") l
+        | _ ->
+            pp f "@[<2>{@;%a;_}@]" (list longident_x_pattern ~sep:";@;") l
+        end
+    | Ppat_tuple l ->
+        pp f "@[<1>(%a)@]" (list  ~sep:",@;" (pattern1 ctxt))  l (* level1*)
+    | Ppat_constant (c) -> pp f "%a" constant c
+    | Ppat_interval (c1, c2) -> pp f "%a..%a" constant c1 constant c2
+    | Ppat_variant (l,None) ->  pp f "`%s" l
+    | Ppat_constraint (p, ct) ->
+        pp f "@[<2>(%a@;:@;%a)@]" (pattern1 ctxt) p (core_type ctxt) ct
+    | Ppat_lazy p ->
+        pp f "@[<2>(lazy@;%a)@]" (pattern1 ctxt) p
+    | Ppat_exception p ->
+        pp f "@[<2>exception@;%a@]" (pattern1 ctxt) p
+    | Ppat_extension e -> extension ctxt f e
+    | Ppat_open (lid, p) ->
+        let with_paren =
+        match p.ppat_desc with
+        | Ppat_array _ | Ppat_record _
+        | Ppat_construct (({txt=Lident ("()"|"[]");_}), _) -> false
+        | _ -> true in
+        pp f "@[<2>%a.%a @]" longident_loc lid
+          (paren with_paren @@ pattern1 ctxt) p
+    | _ -> paren true (pattern ctxt) f x
+
+and label_exp ctxt f (l,opt,p) =
+  match l with
+  | Nolabel ->
+      (* single case pattern parens needed here *)
+      pp f "%a@ " (simple_pattern ctxt) p
+  | Optional rest ->
+      begin match p with
+      | {ppat_desc = Ppat_var {txt;_}; ppat_attributes = []}
+        when txt = rest ->
+          (match opt with
+           | Some o -> pp f "?(%s=@;%a)@;" rest  (expression ctxt) o
+           | None -> pp f "?%s@ " rest)
+      | _ ->
+          (match opt with
+           | Some o ->
+               pp f "?%s:(%a=@;%a)@;"
+                 rest (pattern1 ctxt) p (expression ctxt) o
+           | None -> pp f "?%s:%a@;" rest (simple_pattern ctxt) p)
+      end
+  | Labelled l -> match p with
+    | {ppat_desc  = Ppat_var {txt;_}; ppat_attributes = []}
+      when txt = l ->
+        pp f "~%s@;" l
+    | _ ->  pp f "~%s:%a@;" l (simple_pattern ctxt) p
+
+and sugar_expr ctxt f e =
+  if e.pexp_attributes <> [] then false
+  else match e.pexp_desc with
+  | Pexp_apply ({ pexp_desc = Pexp_ident {txt = id; _};
+                  pexp_attributes=[]; _}, args)
+    when List.for_all (fun (lab, _) -> lab = Nolabel) args -> begin
+      let print_indexop a path_prefix assign left right print_index indices
+          rem_args =
+        let print_path ppf = function
+          | None -> ()
+          | Some m -> pp ppf ".%a" longident m in
+        match assign, rem_args with
+            | false, [] ->
+              pp f "@[%a%a%s%a%s@]"
+                (simple_expr ctxt) a print_path path_prefix
+                left (list ~sep:"," print_index) indices right; true
+            | true, [v] ->
+              pp f "@[%a%a%s%a%s@ <-@;<1 2>%a@]"
+                (simple_expr ctxt) a print_path path_prefix
+                left (list ~sep:"," print_index) indices right
+                (simple_expr ctxt) v; true
+            | _ -> false in
+      match id, List.map snd args with
+      | Lident "!", [e] ->
+        pp f "@[<hov>!%a@]" (simple_expr ctxt) e; true
+      | Ldot (path, ("get"|"set" as func)), a :: other_args -> begin
+          let assign = func = "set" in
+          let print = print_indexop a None assign in
+          match path, other_args with
+          | Lident "Array", i :: rest ->
+            print ".(" ")" (expression ctxt) [i] rest
+          | Lident "String", i :: rest ->
+            print ".[" "]" (expression ctxt) [i] rest
+          | Ldot (Lident "Bigarray", "Array1"), i1 :: rest ->
+            print ".{" "}" (simple_expr ctxt) [i1] rest
+          | Ldot (Lident "Bigarray", "Array2"), i1 :: i2 :: rest ->
+            print ".{" "}" (simple_expr ctxt) [i1; i2] rest
+          | Ldot (Lident "Bigarray", "Array3"), i1 :: i2 :: i3 :: rest ->
+            print ".{" "}" (simple_expr ctxt) [i1; i2; i3] rest
+          | Ldot (Lident "Bigarray", "Genarray"),
+            {pexp_desc = Pexp_array indexes; pexp_attributes = []} :: rest ->
+              print ".{" "}" (simple_expr ctxt) indexes rest
+          | _ -> false
+        end
+      | (Lident s | Ldot(_,s)) , a :: i :: rest
+        when s.[0] = '.' ->
+          let n = String.length s in
+          (* extract operator:
+             assignment operators end with [right_bracket ^ "<-"],
+             access operators end with [right_bracket] directly
+          *)
+          let assign = s.[n - 1] = '-'  in
+          let kind =
+            (* extract the right end bracket *)
+            if assign then s.[n - 3] else s.[n - 1] in
+          let left, right = match kind with
+            | ')' -> '(', ")"
+            | ']' -> '[', "]"
+            | '}' -> '{', "}"
+            | _ -> assert false in
+          let path_prefix = match id with
+            | Ldot(m,_) -> Some m
+            | _ -> None in
+          let left = String.sub s 0 (1+String.index s left) in
+          print_indexop a path_prefix assign left right
+            (expression ctxt) [i] rest
+      | _ -> false
+    end
+  | _ -> false
+
+and expression ctxt f x =
+  if x.pexp_attributes <> [] then
+    pp f "((%a)@,%a)" (expression ctxt) {x with pexp_attributes=[]}
+      (attributes ctxt) x.pexp_attributes
+  else match x.pexp_desc with
+    | Pexp_function _ | Pexp_fun _ | Pexp_match _ | Pexp_try _ | Pexp_sequence _
+      when ctxt.pipe || ctxt.semi ->
+        paren true (expression reset_ctxt) f x
+    | Pexp_ifthenelse _ | Pexp_sequence _ when ctxt.ifthenelse ->
+        paren true (expression reset_ctxt) f x
+    | Pexp_let _ | Pexp_letmodule _ | Pexp_open _ | Pexp_letexception _
+        when ctxt.semi ->
+        paren true (expression reset_ctxt) f x
+    | Pexp_fun (l, e0, p, e) ->
+        pp f "@[<2>fun@;%a->@;%a@]"
+          (label_exp ctxt) (l, e0, p)
+          (expression ctxt) e
+    | Pexp_function l ->
+        pp f "@[<hv>function%a@]" (case_list ctxt) l
+    | Pexp_match (e, l) ->
+        pp f "@[<hv0>@[<hv0>@[<2>match %a@]@ with@]%a@]"
+          (expression reset_ctxt) e (case_list ctxt) l
+
+    | Pexp_try (e, l) ->
+        pp f "@[<0>@[<hv2>try@ %a@]@ @[<0>with%a@]@]"
+             (* "try@;@[<2>%a@]@\nwith@\n%a"*)
+          (expression reset_ctxt) e  (case_list ctxt) l
+    | Pexp_let (rf, l, e) ->
+        (* pp f "@[<2>let %a%a in@;<1 -2>%a@]"
+           (*no indentation here, a new line*) *)
+        (*   rec_flag rf *)
+        pp f "@[<2>%a in@;<1 -2>%a@]"
+          (bindings reset_ctxt) (rf,l)
+          (expression ctxt) e
+    | Pexp_apply (e, l) ->
+        begin if not (sugar_expr ctxt f x) then
+            match view_fixity_of_exp e with
+            | `Infix s ->
+                begin match l with
+                | [ (Nolabel, _) as arg1; (Nolabel, _) as arg2 ] ->
+                    (* FIXME associativity label_x_expression_param *)
+                    pp f "@[<2>%a@;%s@;%a@]"
+                      (label_x_expression_param reset_ctxt) arg1 s
+                      (label_x_expression_param ctxt) arg2
+                | _ ->
+                    pp f "@[<2>%a %a@]"
+                      (simple_expr ctxt) e
+                      (list (label_x_expression_param ctxt)) l
+                end
+            | `Prefix s ->
+                let s =
+                  if List.mem s ["~+";"~-";"~+.";"~-."] &&
+                   (match l with
+                    (* See #7200: avoid turning (~- 1) into (- 1) which is
+                       parsed as an int literal *)
+                    |[(_,{pexp_desc=Pexp_constant _})] -> false
+                    | _ -> true)
+                  then String.sub s 1 (String.length s -1)
+                  else s in
+                begin match l with
+                | [(Nolabel, x)] ->
+                  pp f "@[<2>%s@;%a@]" s (simple_expr ctxt) x
+                | _   ->
+                  pp f "@[<2>%a %a@]" (simple_expr ctxt) e
+                    (list (label_x_expression_param ctxt)) l
+                end
+            | _ ->
+                pp f "@[<hov2>%a@]" begin fun f (e,l) ->
+                  pp f "%a@ %a" (expression2 ctxt) e
+                    (list (label_x_expression_param reset_ctxt))  l
+                    (* reset here only because [function,match,try,sequence]
+                       are lower priority *)
+                end (e,l)
+        end
+
+    | Pexp_construct (li, Some eo)
+      when not (is_simple_construct (view_expr x))-> (* Not efficient FIXME*)
+        (match view_expr x with
+         | `cons ls -> list (simple_expr ctxt) f ls ~sep:"@;::@;"
+         | `normal ->
+             pp f "@[<2>%a@;%a@]" longident_loc li
+               (simple_expr ctxt) eo
+         | _ -> assert false)
+    | Pexp_setfield (e1, li, e2) ->
+        pp f "@[<2>%a.%a@ <-@ %a@]"
+          (simple_expr ctxt) e1 longident_loc li (simple_expr ctxt) e2
+    | Pexp_ifthenelse (e1, e2, eo) ->
+        (* @;@[<2>else@ %a@]@] *)
+        let fmt:(_,_,_)format ="@[<hv0>@[<2>if@ %a@]@;@[<2>then@ %a@]%a@]" in
+        let expression_under_ifthenelse = expression (under_ifthenelse ctxt) in
+        pp f fmt expression_under_ifthenelse e1 expression_under_ifthenelse e2
+          (fun f eo -> match eo with
+             | Some x ->
+                 pp f "@;@[<2>else@;%a@]" (expression (under_semi ctxt)) x
+             | None -> () (* pp f "()" *)) eo
+    | Pexp_sequence _ ->
+        let rec sequence_helper acc = function
+          | {pexp_desc=Pexp_sequence(e1,e2); pexp_attributes = []} ->
+              sequence_helper (e1::acc) e2
+          | v -> List.rev (v::acc) in
+        let lst = sequence_helper [] x in
+        pp f "@[<hv>%a@]"
+          (list (expression (under_semi ctxt)) ~sep:";@;") lst
+    | Pexp_new (li) ->
+        pp f "@[<hov2>new@ %a@]" longident_loc li;
+    | Pexp_setinstvar (s, e) ->
+        pp f "@[<hov2>%s@ <-@ %a@]" s.txt (expression ctxt) e
+    | Pexp_override l -> (* FIXME *)
+        let string_x_expression f (s, e) =
+          pp f "@[<hov2>%s@ =@ %a@]" s.txt (expression ctxt) e in
+        pp f "@[<hov2>{<%a>}@]"
+          (list string_x_expression  ~sep:";"  )  l;
+    | Pexp_letmodule (s, me, e) ->
+        pp f "@[<hov2>let@ module@ %s@ =@ %a@ in@ %a@]" s.txt
+          (module_expr reset_ctxt) me (expression ctxt) e
+    | Pexp_letexception (cd, e) ->
+        pp f "@[<hov2>let@ exception@ %a@ in@ %a@]"
+          (extension_constructor ctxt) cd
+          (expression ctxt) e
+    | Pexp_assert e ->
+        pp f "@[<hov2>assert@ %a@]" (simple_expr ctxt) e
+    | Pexp_lazy (e) ->
+        pp f "@[<hov2>lazy@ %a@]" (simple_expr ctxt) e
+    (* Pexp_poly: impossible but we should print it anyway, rather than
+       assert false *)
+    | Pexp_poly (e, None) ->
+        pp f "@[<hov2>!poly!@ %a@]" (simple_expr ctxt) e
+    | Pexp_poly (e, Some ct) ->
+        pp f "@[<hov2>(!poly!@ %a@ : %a)@]"
+          (simple_expr ctxt) e (core_type ctxt) ct
+    | Pexp_open (ovf, lid, e) ->
+        pp f "@[<2>let open%s %a in@;%a@]" (override ovf) longident_loc lid
+          (expression ctxt) e
+    | Pexp_variant (l,Some eo) ->
+        pp f "@[<2>`%s@;%a@]" l (simple_expr ctxt) eo
+    | Pexp_extension e -> extension ctxt f e
+    | Pexp_unreachable -> pp f "."
+    | _ -> expression1 ctxt f x
+
+and expression1 ctxt f x =
+  if x.pexp_attributes <> [] then expression ctxt f x
+  else match x.pexp_desc with
+    | Pexp_object cs -> pp f "%a" (class_structure ctxt) cs
+    | _ -> expression2 ctxt f x
+(* used in [Pexp_apply] *)
+
+and expression2 ctxt f x =
+  if x.pexp_attributes <> [] then expression ctxt f x
+  else match x.pexp_desc with
+    | Pexp_field (e, li) ->
+        pp f "@[<hov2>%a.%a@]" (simple_expr ctxt) e longident_loc li
+    | Pexp_send (e, s) -> pp f "@[<hov2>%a#%s@]" (simple_expr ctxt) e s.txt
+
+    | _ -> simple_expr ctxt f x
+
+and simple_expr ctxt f x =
+  if x.pexp_attributes <> [] then expression ctxt f x
+  else match x.pexp_desc with
+    | Pexp_construct _  when is_simple_construct (view_expr x) ->
+        (match view_expr x with
+         | `nil -> pp f "[]"
+         | `tuple -> pp f "()"
+         | `list xs ->
+             pp f "@[<hv0>[%a]@]"
+               (list (expression (under_semi ctxt)) ~sep:";@;") xs
+         | `simple x -> longident f x
+         | _ -> assert false)
+    | Pexp_ident li ->
+        longident_loc f li
+    (* (match view_fixity_of_exp x with *)
+    (* |`Normal -> longident_loc f li *)
+    (* | `Prefix _ | `Infix _ -> pp f "( %a )" longident_loc li) *)
+    | Pexp_constant c -> constant f c;
+    | Pexp_pack me ->
+        pp f "(module@;%a)" (module_expr ctxt) me
+    | Pexp_newtype (lid, e) ->
+        pp f "fun@;(type@;%s)@;->@;%a" lid.txt (expression ctxt) e
+    | Pexp_tuple l ->
+        pp f "@[<hov2>(%a)@]" (list (simple_expr ctxt) ~sep:",@;") l
+    | Pexp_constraint (e, ct) ->
+        pp f "(%a : %a)" (expression ctxt) e (core_type ctxt) ct
+    | Pexp_coerce (e, cto1, ct) ->
+        pp f "(%a%a :> %a)" (expression ctxt) e
+          (option (core_type ctxt) ~first:" : " ~last:" ") cto1 (* no sep hint*)
+          (core_type ctxt) ct
+    | Pexp_variant (l, None) -> pp f "`%s" l
+    | Pexp_record (l, eo) ->
+        let longident_x_expression f ( li, e) =
+          match e with
+          |  {pexp_desc=Pexp_ident {txt;_};
+              pexp_attributes=[]; _} when li.txt = txt ->
+              pp f "@[<hov2>%a@]" longident_loc li
+          | _ ->
+              pp f "@[<hov2>%a@;=@;%a@]" longident_loc li (simple_expr ctxt) e
+        in
+        pp f "@[<hv0>@[<hv2>{@;%a%a@]@;}@]"(* "@[<hov2>{%a%a}@]" *)
+          (option ~last:" with@;" (simple_expr ctxt)) eo
+          (list longident_x_expression ~sep:";@;") l
+    | Pexp_array (l) ->
+        pp f "@[<0>@[<2>[|%a|]@]@]"
+          (list (simple_expr (under_semi ctxt)) ~sep:";") l
+    | Pexp_while (e1, e2) ->
+        let fmt : (_,_,_) format = "@[<2>while@;%a@;do@;%a@;done@]" in
+        pp f fmt (expression ctxt) e1 (expression ctxt) e2
+    | Pexp_for (s, e1, e2, df, e3) ->
+        let fmt:(_,_,_)format =
+          "@[<hv0>@[<hv2>@[<2>for %a =@;%a@;%a%a@;do@]@;%a@]@;done@]" in
+        let expression = expression ctxt in
+        pp f fmt (pattern ctxt) s expression e1 direction_flag
+          df expression e2 expression e3
+    | _ ->  paren true (expression ctxt) f x
+
+and attributes ctxt f l =
+  List.iter (attribute ctxt f) l
+
+and item_attributes ctxt f l =
+  List.iter (item_attribute ctxt f) l
+
+and attribute ctxt f (s, e) =
+  pp f "@[<2>[@@%s@ %a]@]" s.txt (payload ctxt) e
+
+and item_attribute ctxt f (s, e) =
+  pp f "@[<2>[@@@@%s@ %a]@]" s.txt (payload ctxt) e
+
+and floating_attribute ctxt f (s, e) =
+  pp f "@[<2>[@@@@@@%s@ %a]@]" s.txt (payload ctxt) e
+
+and value_description ctxt f x =
+  (* note: value_description has an attribute field,
+           but they're already printed by the callers this method *)
+  pp f "@[<hov2>%a%a@]" (core_type ctxt) x.pval_type
+    (fun f x ->
+        
+       if x.pval_prim <> []
+       then pp f "@ =@ %a" (list constant_string) x.pval_prim
+
+    ) x
+
+and extension ctxt f (s, e) =
+  pp f "@[<2>[%%%s@ %a]@]" s.txt (payload ctxt) e
+
+and item_extension ctxt f (s, e) =
+  pp f "@[<2>[%%%%%s@ %a]@]" s.txt (payload ctxt) e
+
+and exception_declaration ctxt f ext =
+  pp f "@[<hov2>exception@ %a@]" (extension_constructor ctxt) ext
+
+and class_signature ctxt f { pcsig_self = ct; pcsig_fields = l ;_} =
+  let class_type_field f x =
+    match x.pctf_desc with
+    | Pctf_inherit (ct) ->
+        pp f "@[<2>inherit@ %a@]%a" (class_type ctxt) ct
+          (item_attributes ctxt) x.pctf_attributes
+    | Pctf_val (s, mf, vf, ct) ->
+        pp f "@[<2>val @ %a%a%s@ :@ %a@]%a"
+          mutable_flag mf virtual_flag vf s.txt (core_type ctxt) ct
+          (item_attributes ctxt) x.pctf_attributes
+    | Pctf_method (s, pf, vf, ct) ->
+        pp f "@[<2>method %a %a%s :@;%a@]%a"
+          private_flag pf virtual_flag vf s.txt (core_type ctxt) ct
+          (item_attributes ctxt) x.pctf_attributes
+    | Pctf_constraint (ct1, ct2) ->
+        pp f "@[<2>constraint@ %a@ =@ %a@]%a"
+          (core_type ctxt) ct1 (core_type ctxt) ct2
+          (item_attributes ctxt) x.pctf_attributes
+    | Pctf_attribute a -> floating_attribute ctxt f a
+    | Pctf_extension e ->
+        item_extension ctxt f e;
+        item_attributes ctxt f x.pctf_attributes
+  in
+  pp f "@[<hv0>@[<hv2>object@[<1>%a@]@ %a@]@ end@]"
+    (fun f -> function
+         {ptyp_desc=Ptyp_any; ptyp_attributes=[]; _} -> ()
+       | ct -> pp f " (%a)" (core_type ctxt) ct) ct
+    (list class_type_field ~sep:"@;") l
+
+(* call [class_signature] called by [class_signature] *)
+and class_type ctxt f x =
+  match x.pcty_desc with
+  | Pcty_signature cs ->
+      class_signature ctxt f cs;
+      attributes ctxt f x.pcty_attributes
+  | Pcty_constr (li, l) ->
+      pp f "%a%a%a"
+        (fun f l -> match l with
+           | [] -> ()
+           | _  -> pp f "[%a]@ " (list (core_type ctxt) ~sep:"," ) l) l
+        longident_loc li
+        (attributes ctxt) x.pcty_attributes
+  | Pcty_arrow (l, co, cl) ->
+      pp f "@[<2>%a@;->@;%a@]" (* FIXME remove parens later *)
+        (type_with_label ctxt) (l,co)
+        (class_type ctxt) cl
+  | Pcty_extension e ->
+      extension ctxt f e;
+      attributes ctxt f x.pcty_attributes
+  | Pcty_open (ovf, lid, e) ->
+      pp f "@[<2>let open%s %a in@;%a@]" (override ovf) longident_loc lid
+        (class_type ctxt) e
+
+(* [class type a = object end] *)
+and class_type_declaration_list ctxt f l =
+  let class_type_declaration kwd f x =
+    let { pci_params=ls; pci_name={ txt; _ }; _ } = x in
+    pp f "@[<2>%s %a%a%s@ =@ %a@]%a" kwd
+      virtual_flag x.pci_virt
+      (class_params_def ctxt) ls txt
+      (class_type ctxt) x.pci_expr
+      (item_attributes ctxt) x.pci_attributes
+  in
+  match l with
+  | [] -> ()
+  | [x] -> class_type_declaration "class type" f x
+  | x :: xs ->
+      pp f "@[<v>%a@,%a@]"
+        (class_type_declaration "class type") x
+        (list ~sep:"@," (class_type_declaration "and")) xs
+
+and class_field ctxt f x =
+  match x.pcf_desc with
+  | Pcf_inherit () -> ()  
+  | Pcf_val (s, mf, Cfk_concrete (ovf, e)) ->
+      pp f "@[<2>val%s %a%s =@;%a@]%a" (override ovf)
+        mutable_flag mf s.txt
+        (expression ctxt) e
+        (item_attributes ctxt) x.pcf_attributes
+  | Pcf_method (s, pf, Cfk_virtual ct) ->
+      pp f "@[<2>method virtual %a %s :@;%a@]%a"
+        private_flag pf s.txt
+        (core_type ctxt) ct
+        (item_attributes ctxt) x.pcf_attributes
+  | Pcf_val (s, mf, Cfk_virtual ct) ->
+      pp f "@[<2>val virtual %a%s :@ %a@]%a"
+        mutable_flag mf s.txt
+        (core_type ctxt) ct
+        (item_attributes ctxt) x.pcf_attributes
+  | Pcf_method (s, pf, Cfk_concrete (ovf, e)) ->
+      let bind e =
+        binding ctxt f
+          {pvb_pat=
+             {ppat_desc=Ppat_var s;ppat_loc=Location.none;ppat_attributes=[]};
+           pvb_expr=e;
+           pvb_attributes=[];
+           pvb_loc=Location.none;
+          }
+      in
+      pp f "@[<2>method%s %a%a@]%a"
+        (override ovf)
+        private_flag pf
+        (fun f -> function
+           | {pexp_desc=Pexp_poly (e, Some ct); pexp_attributes=[]; _} ->
+               pp f "%s :@;%a=@;%a"
+                 s.txt (core_type ctxt) ct (expression ctxt) e
+           | {pexp_desc=Pexp_poly (e, None); pexp_attributes=[]; _} ->
+               bind e
+           | _ -> bind e) e
+        (item_attributes ctxt) x.pcf_attributes
+  | Pcf_constraint (ct1, ct2) ->
+      pp f "@[<2>constraint %a =@;%a@]%a"
+        (core_type ctxt) ct1
+        (core_type ctxt) ct2
+        (item_attributes ctxt) x.pcf_attributes
+  | Pcf_initializer (e) ->
+      pp f "@[<2>initializer@ %a@]%a"
+        (expression ctxt) e
+        (item_attributes ctxt) x.pcf_attributes
+  | Pcf_attribute a -> floating_attribute ctxt f a
+  | Pcf_extension e ->
+      item_extension ctxt f e;
+      item_attributes ctxt f x.pcf_attributes
+
+and class_structure ctxt f { pcstr_self = p; pcstr_fields =  l } =
+  pp f "@[<hv0>@[<hv2>object%a@;%a@]@;end@]"
+    (fun f p -> match p.ppat_desc with
+       | Ppat_any -> ()
+       | Ppat_constraint _ -> pp f " %a" (pattern ctxt) p
+       | _ -> pp f " (%a)" (pattern ctxt) p) p
+    (list (class_field ctxt)) l
+
+and module_type ctxt f x =
+  if x.pmty_attributes <> [] then begin
+    pp f "((%a)%a)" (module_type ctxt) {x with pmty_attributes=[]}
+      (attributes ctxt) x.pmty_attributes
+  end else
+    match x.pmty_desc with
+    | Pmty_ident li ->
+        pp f "%a" longident_loc li;
+    | Pmty_alias li ->
+        pp f "(module %a)" longident_loc li;
+    | Pmty_signature (s) ->
+        pp f "@[<hv0>@[<hv2>sig@ %a@]@ end@]" (* "@[<hov>sig@ %a@ end@]" *)
+          (list (signature_item ctxt)) s (* FIXME wrong indentation*)
+    | Pmty_functor (_, None, mt2) ->
+        pp f "@[<hov2>functor () ->@ %a@]" (module_type ctxt) mt2
+    | Pmty_functor (s, Some mt1, mt2) ->
+        if s.txt = "_" then
+          pp f "@[<hov2>%a@ ->@ %a@]"
+            (module_type ctxt) mt1 (module_type ctxt) mt2
+        else
+          pp f "@[<hov2>functor@ (%s@ :@ %a)@ ->@ %a@]" s.txt
+            (module_type ctxt) mt1 (module_type ctxt) mt2
+    | Pmty_with (mt, l) ->
+        let with_constraint f = function
+          | Pwith_type (li, ({ptype_params= ls ;_} as td)) ->
+              let ls = List.map fst ls in
+              pp f "type@ %a %a =@ %a"
+                (list (core_type ctxt) ~sep:"," ~first:"(" ~last:")")
+                ls longident_loc li (type_declaration ctxt) td
+          | Pwith_module (li, li2) ->
+              pp f "module %a =@ %a" longident_loc li longident_loc li2;
+          | Pwith_typesubst (li, ({ptype_params=ls;_} as td)) ->
+              let ls = List.map fst ls in
+              pp f "type@ %a %a :=@ %a"
+                (list (core_type ctxt) ~sep:"," ~first:"(" ~last:")")
+                ls longident_loc li
+                (type_declaration ctxt) td
+          | Pwith_modsubst (li, li2) ->
+             pp f "module %a :=@ %a" longident_loc li longident_loc li2 in
+        (match l with
+         | [] -> pp f "@[<hov2>%a@]" (module_type ctxt) mt
+         | _ -> pp f "@[<hov2>(%a@ with@ %a)@]"
+                  (module_type ctxt) mt (list with_constraint ~sep:"@ and@ ") l)
+    | Pmty_typeof me ->
+        pp f "@[<hov2>module@ type@ of@ %a@]" (module_expr ctxt) me
+    | Pmty_extension e -> extension ctxt f e
+
+and signature ctxt f x =  list ~sep:"@\n" (signature_item ctxt) f x
+
+and signature_item ctxt f x : unit =
+  match x.psig_desc with
+  | Psig_type (rf, l) ->
+      type_def_list ctxt f (rf, l)
+  | Psig_value vd ->
+      let intro = if vd.pval_prim = [] then "val" else "external" in
+      pp f "@[<2>%s@ %a@ :@ %a@]%a" intro
+        protect_ident vd.pval_name.txt
+        (value_description ctxt) vd
+        (item_attributes ctxt) vd.pval_attributes
+  | Psig_typext te ->
+      type_extension ctxt f te
+  | Psig_exception ed ->
+      exception_declaration ctxt f ed
+  | Psig_class () ->
+    ()
+  | Psig_module ({pmd_type={pmty_desc=Pmty_alias alias;
+                            pmty_attributes=[]; _};_} as pmd) ->
+      pp f "@[<hov>module@ %s@ =@ %a@]%a" pmd.pmd_name.txt
+        longident_loc alias
+        (item_attributes ctxt) pmd.pmd_attributes
+  | Psig_module pmd ->
+      pp f "@[<hov>module@ %s@ :@ %a@]%a"
+        pmd.pmd_name.txt
+        (module_type ctxt) pmd.pmd_type
+        (item_attributes ctxt) pmd.pmd_attributes
+  | Psig_open od ->
+      pp f "@[<hov2>open%s@ %a@]%a"
+        (override od.popen_override)
+        longident_loc od.popen_lid
+        (item_attributes ctxt) od.popen_attributes
+  | Psig_include incl ->
+      pp f "@[<hov2>include@ %a@]%a"
+        (module_type ctxt) incl.pincl_mod
+        (item_attributes ctxt) incl.pincl_attributes
+  | Psig_modtype {pmtd_name=s; pmtd_type=md; pmtd_attributes=attrs} ->
+      pp f "@[<hov2>module@ type@ %s%a@]%a"
+        s.txt
+        (fun f md -> match md with
+           | None -> ()
+           | Some mt ->
+               pp_print_space f () ;
+               pp f "@ =@ %a" (module_type ctxt) mt
+        ) md
+        (item_attributes ctxt) attrs
+  | Psig_class_type (l) -> class_type_declaration_list ctxt f l
+  | Psig_recmodule decls ->
+      let rec  string_x_module_type_list f ?(first=true) l =
+        match l with
+        | [] -> () ;
+        | pmd :: tl ->
+            if not first then
+              pp f "@ @[<hov2>and@ %s:@ %a@]%a" pmd.pmd_name.txt
+                (module_type ctxt) pmd.pmd_type
+                (item_attributes ctxt) pmd.pmd_attributes
+            else
+              pp f "@[<hov2>module@ rec@ %s:@ %a@]%a" pmd.pmd_name.txt
+                (module_type ctxt) pmd.pmd_type
+                (item_attributes ctxt) pmd.pmd_attributes;
+            string_x_module_type_list f ~first:false tl
+      in
+      string_x_module_type_list f decls
+  | Psig_attribute a -> floating_attribute ctxt f a
+  | Psig_extension(e, a) ->
+      item_extension ctxt f e;
+      item_attributes ctxt f a
+
+and module_expr ctxt f x =
+  if x.pmod_attributes <> [] then
+    pp f "((%a)%a)" (module_expr ctxt) {x with pmod_attributes=[]}
+      (attributes ctxt) x.pmod_attributes
+  else match x.pmod_desc with
+    | Pmod_structure (s) ->
+        pp f "@[<hv2>struct@;@[<0>%a@]@;<1 -2>end@]"
+          (list (structure_item ctxt) ~sep:"@\n") s;
+    | Pmod_constraint (me, mt) ->
+        pp f "@[<hov2>(%a@ :@ %a)@]"
+          (module_expr ctxt) me
+          (module_type ctxt) mt
+    | Pmod_ident (li) ->
+        pp f "%a" longident_loc li;
+    | Pmod_functor (_, None, me) ->
+        pp f "functor ()@;->@;%a" (module_expr ctxt) me
+    | Pmod_functor (s, Some mt, me) ->
+        pp f "functor@ (%s@ :@ %a)@;->@;%a"
+          s.txt (module_type ctxt) mt (module_expr ctxt) me
+    | Pmod_apply (me1, me2) ->
+        pp f "(%a)(%a)" (module_expr ctxt) me1 (module_expr ctxt) me2
+        (* Cf: #7200 *)
+    | Pmod_unpack e ->
+        pp f "(val@ %a)" (expression ctxt) e
+    | Pmod_extension e -> extension ctxt f e
+
+and structure ctxt f x = list ~sep:"@\n" (structure_item ctxt) f x
+
+and payload ctxt f = function
+  | PStr [{pstr_desc = Pstr_eval (e, attrs)}] ->
+      pp f "@[<2>%a@]%a"
+        (expression ctxt) e
+        (item_attributes ctxt) attrs
+  | PStr x -> structure ctxt f x
+  | PTyp x -> pp f ":"; core_type ctxt f x
+  | PSig x -> pp f ":"; signature ctxt f x
+  | PPat (x, None) -> pp f "?"; pattern ctxt f x
+  | PPat (x, Some e) ->
+      pp f "?"; pattern ctxt f x;
+      pp f " when "; expression ctxt f e
+
+(* transform [f = fun g h -> ..] to [f g h = ... ] could be improved *)
+and binding ctxt f {pvb_pat=p; pvb_expr=x; _} =
+  (* .pvb_attributes have already been printed by the caller, #bindings *)
+  let rec pp_print_pexp_function f x =
+    if x.pexp_attributes <> [] then pp f "=@;%a" (expression ctxt) x
+    else match x.pexp_desc with
+      | Pexp_fun (label, eo, p, e) ->
+          if label=Nolabel then
+            pp f "%a@ %a" (simple_pattern ctxt) p pp_print_pexp_function e
+          else
+            pp f "%a@ %a"
+              (label_exp ctxt) (label,eo,p) pp_print_pexp_function e
+      | Pexp_newtype (str,e) ->
+          pp f "(type@ %s)@ %a" str.txt pp_print_pexp_function e
+      | _ -> pp f "=@;%a" (expression ctxt) x
+  in
+  let tyvars_str tyvars = List.map (fun v -> v.txt) tyvars in
+  let is_desugared_gadt p e =
+    let gadt_pattern =
+      match p with
+      | {ppat_desc=Ppat_constraint({ppat_desc=Ppat_var _} as pat,
+                                   {ptyp_desc=Ptyp_poly (args_tyvars, rt)});
+         ppat_attributes=[]}->
+          Some (pat, args_tyvars, rt)
+      | _ -> None in
+    let rec gadt_exp tyvars e =
+      match e with
+      | {pexp_desc=Pexp_newtype (tyvar, e); pexp_attributes=[]} ->
+          gadt_exp (tyvar :: tyvars) e
+      | {pexp_desc=Pexp_constraint (e, ct); pexp_attributes=[]} ->
+          Some (List.rev tyvars, e, ct)
+      | _ -> None in
+    let gadt_exp = gadt_exp [] e in
+    match gadt_pattern, gadt_exp with
+    | Some (p, pt_tyvars, pt_ct), Some (e_tyvars, e, e_ct)
+      when tyvars_str pt_tyvars = tyvars_str e_tyvars ->
+      let ety = Typ.varify_constructors e_tyvars e_ct in
+      if ety = pt_ct then
+      Some (p, pt_tyvars, e_ct, e) else None
+    | _ -> None in
+  if x.pexp_attributes <> []
+  then pp f "%a@;=@;%a" (pattern ctxt) p (expression ctxt) x else
+  match is_desugared_gadt p x with
+  | Some (p, [], ct, e) ->
+      pp f "%a@;: %a@;=@;%a"
+        (simple_pattern ctxt) p (core_type ctxt) ct (expression ctxt) e
+  | Some (p, tyvars, ct, e) -> begin
+    pp f "%a@;: type@;%a.@;%a@;=@;%a"
+    (simple_pattern ctxt) p (list pp_print_string ~sep:"@;")
+    (tyvars_str tyvars) (core_type ctxt) ct (expression ctxt) e
+    end
+  | None -> begin
+      match p with
+      | {ppat_desc=Ppat_constraint(p ,ty);
+         ppat_attributes=[]} -> (* special case for the first*)
+          begin match ty with
+          | {ptyp_desc=Ptyp_poly _; ptyp_attributes=[]} ->
+              pp f "%a@;:@;%a@;=@;%a" (simple_pattern ctxt) p
+                (core_type ctxt) ty (expression ctxt) x
+          | _ ->
+              pp f "(%a@;:@;%a)@;=@;%a" (simple_pattern ctxt) p
+                (core_type ctxt) ty (expression ctxt) x
+          end
+      | {ppat_desc=Ppat_var _; ppat_attributes=[]} ->
+          pp f "%a@ %a" (simple_pattern ctxt) p pp_print_pexp_function x
+      | _ ->
+          pp f "%a@;=@;%a" (pattern ctxt) p (expression ctxt) x
+    end
+
+(* [in] is not printed *)
+and bindings ctxt f (rf,l) =
+  let binding kwd rf f x =
+    pp f "@[<2>%s %a%a@]%a" kwd rec_flag rf
+      (binding ctxt) x (item_attributes ctxt) x.pvb_attributes
+  in
+  match l with
+  | [] -> ()
+  | [x] -> binding "let" rf f x
+  | x::xs ->
+      pp f "@[<v>%a@,%a@]"
+        (binding "let" rf) x
+        (list ~sep:"@," (binding "and" Nonrecursive)) xs
+
+and structure_item ctxt f x =
+  match x.pstr_desc with
+  | Pstr_eval (e, attrs) ->
+      pp f "@[<hov2>;;%a@]%a"
+        (expression ctxt) e
+        (item_attributes ctxt) attrs
+  | Pstr_type (_, []) -> assert false
+  | Pstr_type (rf, l)  -> type_def_list ctxt f (rf, l)
+  | Pstr_value (rf, l) ->
+      (* pp f "@[<hov2>let %a%a@]"  rec_flag rf bindings l *)
+      pp f "@[<2>%a@]" (bindings ctxt) (rf,l)
+  | Pstr_typext te -> type_extension ctxt f te
+  | Pstr_exception ed -> exception_declaration ctxt f ed
+  | Pstr_module x ->
+      let rec module_helper = function
+        | {pmod_desc=Pmod_functor(s,mt,me'); pmod_attributes = []} ->
+            if mt = None then pp f "()"
+            else Misc.may (pp f "(%s:%a)" s.txt (module_type ctxt)) mt;
+            module_helper me'
+        | me -> me
+      in
+      pp f "@[<hov2>module %s%a@]%a"
+        x.pmb_name.txt
+        (fun f me ->
+           let me = module_helper me in
+           match me with
+           | {pmod_desc=
+                Pmod_constraint
+                  (me',
+                   ({pmty_desc=(Pmty_ident (_)
+                               | Pmty_signature (_));_} as mt));
+              pmod_attributes = []} ->
+               pp f " :@;%a@;=@;%a@;"
+                 (module_type ctxt) mt (module_expr ctxt) me'
+           | _ -> pp f " =@ %a" (module_expr ctxt) me
+        ) x.pmb_expr
+        (item_attributes ctxt) x.pmb_attributes
+  | Pstr_open od ->
+      pp f "@[<2>open%s@;%a@]%a"
+        (override od.popen_override)
+        longident_loc od.popen_lid
+        (item_attributes ctxt) od.popen_attributes
+  | Pstr_modtype {pmtd_name=s; pmtd_type=md; pmtd_attributes=attrs} ->
+      pp f "@[<hov2>module@ type@ %s%a@]%a"
+        s.txt
+        (fun f md -> match md with
+           | None -> ()
+           | Some mt ->
+               pp_print_space f () ;
+               pp f "@ =@ %a" (module_type ctxt) mt
+        ) md
+        (item_attributes ctxt) attrs
+  | Pstr_class () -> ()
+  | Pstr_class_type l -> class_type_declaration_list ctxt f l
+  | Pstr_primitive vd ->
+      pp f "@[<hov2>external@ %a@ :@ %a@]%a"
+        protect_ident vd.pval_name.txt
+        (value_description ctxt) vd
+        (item_attributes ctxt) vd.pval_attributes
+  | Pstr_include incl ->
+      pp f "@[<hov2>include@ %a@]%a"
+        (module_expr ctxt) incl.pincl_mod
+        (item_attributes ctxt) incl.pincl_attributes
+  | Pstr_recmodule decls -> (* 3.07 *)
+      let aux f = function
+        | ({pmb_expr={pmod_desc=Pmod_constraint (expr, typ)}} as pmb) ->
+            pp f "@[<hov2>@ and@ %s:%a@ =@ %a@]%a" pmb.pmb_name.txt
+              (module_type ctxt) typ
+              (module_expr ctxt) expr
+              (item_attributes ctxt) pmb.pmb_attributes
+        | _ -> assert false
+      in
+      begin match decls with
+      | ({pmb_expr={pmod_desc=Pmod_constraint (expr, typ)}} as pmb) :: l2 ->
+          pp f "@[<hv>@[<hov2>module@ rec@ %s:%a@ =@ %a@]%a@ %a@]"
+            pmb.pmb_name.txt
+            (module_type ctxt) typ
+            (module_expr ctxt) expr
+            (item_attributes ctxt) pmb.pmb_attributes
+            (fun f l2 -> List.iter (aux f) l2) l2
+      | _ -> assert false
+      end
+  | Pstr_attribute a -> floating_attribute ctxt f a
+  | Pstr_extension(e, a) ->
+      item_extension ctxt f e;
+      item_attributes ctxt f a
+
+and type_param ctxt f (ct, a) =
+  pp f "%s%a" (type_variance a) (core_type ctxt) ct
+
+and type_params ctxt f = function
+  | [] -> ()
+  | l -> pp f "%a " (list (type_param ctxt) ~first:"(" ~last:")" ~sep:",@;") l
+
+and type_def_list ctxt f (rf, l) =
+  let type_decl kwd rf f x =
+    let eq =
+      if (x.ptype_kind = Ptype_abstract)
+         && (x.ptype_manifest = None) then ""
+      else " ="
+    in
+    pp f "@[<2>%s %a%a%s%s%a@]%a" kwd
+      nonrec_flag rf
+      (type_params ctxt) x.ptype_params
+      x.ptype_name.txt eq
+      (type_declaration ctxt) x
+      (item_attributes ctxt) x.ptype_attributes
+  in
+  match l with
+  | [] -> assert false
+  | [x] -> type_decl "type" rf f x
+  | x :: xs -> pp f "@[<v>%a@,%a@]"
+                 (type_decl "type" rf) x
+                 (list ~sep:"@," (type_decl "and" Recursive)) xs
+
+and record_declaration ctxt f lbls =
+  let type_record_field f pld =
+    pp f "@[<2>%a%s:@;%a@;%a@]"
+      mutable_flag pld.pld_mutable
+      pld.pld_name.txt
+      (core_type ctxt) pld.pld_type
+      (attributes ctxt) pld.pld_attributes
+  in
+  pp f "{@\n%a}"
+    (list type_record_field ~sep:";@\n" )  lbls
+
+and type_declaration ctxt f x =
+  (* type_declaration has an attribute field,
+     but it's been printed by the caller of this method *)
+  let priv f =
+    match x.ptype_private with
+    | Public -> ()
+    | Private -> pp f "@;private"
+  in
+  let manifest f =
+    match x.ptype_manifest with
+    | None -> ()
+    | Some y ->
+        if x.ptype_kind = Ptype_abstract then
+          pp f "%t@;%a" priv (core_type ctxt) y
+        else
+          pp f "@;%a" (core_type ctxt) y
+  in
+  let constructor_declaration f pcd =
+    pp f "|@;";
+    constructor_declaration ctxt f
+      (pcd.pcd_name.txt, pcd.pcd_args, pcd.pcd_res, pcd.pcd_attributes)
+  in
+  let repr f =
+    let intro f =
+      if x.ptype_manifest = None then ()
+      else pp f "@;="
+    in
+    match x.ptype_kind with
+    | Ptype_variant xs ->
+        pp f "%t%t@\n%a" intro priv
+          (list ~sep:"@\n" constructor_declaration) xs
+    | Ptype_abstract -> ()
+    | Ptype_record l ->
+        pp f "%t%t@;%a" intro priv (record_declaration ctxt) l
+    | Ptype_open -> pp f "%t%t@;.." intro priv
+  in
+  let constraints f =
+    List.iter
+      (fun (ct1,ct2,_) ->
+         pp f "@[<hov2>@ constraint@ %a@ =@ %a@]"
+           (core_type ctxt) ct1 (core_type ctxt) ct2)
+      x.ptype_cstrs
+  in
+  pp f "%t%t%t" manifest repr constraints
+
+and type_extension ctxt f x =
+  let extension_constructor f x =
+    pp f "@\n|@;%a" (extension_constructor ctxt) x
+  in
+  pp f "@[<2>type %a%a += %a@ %a@]%a"
+    (fun f -> function
+       | [] -> ()
+       | l ->
+           pp f "%a@;" (list (type_param ctxt) ~first:"(" ~last:")" ~sep:",") l)
+    x.ptyext_params
+    longident_loc x.ptyext_path
+    private_flag x.ptyext_private (* Cf: #7200 *)
+    (list ~sep:"" extension_constructor)
+    x.ptyext_constructors
+    (item_attributes ctxt) x.ptyext_attributes
+
+and constructor_declaration ctxt f (name, args, res, attrs) =
+  let name =
+    match name with
+    | "::" -> "(::)"
+    | s -> s in
+  match res with
+  | None ->
+      pp f "%s%a@;%a" name
+        (fun f -> function
+           | Pcstr_tuple [] -> ()
+           | Pcstr_tuple l ->
+             pp f "@;of@;%a" (list (core_type1 ctxt) ~sep:"@;*@;") l
+           | Pcstr_record l -> pp f "@;of@;%a" (record_declaration ctxt) l
+        ) args
+        (attributes ctxt) attrs
+  | Some r ->
+      pp f "%s:@;%a@;%a" name
+        (fun f -> function
+           | Pcstr_tuple [] -> core_type1 ctxt f r
+           | Pcstr_tuple l -> pp f "%a@;->@;%a"
+                                (list (core_type1 ctxt) ~sep:"@;*@;") l
+                                (core_type1 ctxt) r
+           | Pcstr_record l ->
+               pp f "%a@;->@;%a" (record_declaration ctxt) l (core_type1 ctxt) r
+        )
+        args
+        (attributes ctxt) attrs
+
+and extension_constructor ctxt f x =
+  (* Cf: #7200 *)
+  match x.pext_kind with
+  | Pext_decl(l, r) ->
+      constructor_declaration ctxt f (x.pext_name.txt, l, r, x.pext_attributes)
+  | Pext_rebind li ->
+      pp f "%s%a@;=@;%a" x.pext_name.txt
+        (attributes ctxt) x.pext_attributes
+        longident_loc li
+
+and case_list ctxt f l : unit =
+  let aux f {pc_lhs; pc_guard; pc_rhs} =
+    pp f "@;| @[<2>%a%a@;->@;%a@]"
+      (pattern ctxt) pc_lhs (option (expression ctxt) ~first:"@;when@;")
+      pc_guard (expression (under_pipe ctxt)) pc_rhs
+  in
+  list aux f l ~sep:""
+
+and label_x_expression_param ctxt f (l,e) =
+  let simple_name = match e with
+    | {pexp_desc=Pexp_ident {txt=Lident l;_};
+       pexp_attributes=[]} -> Some l
+    | _ -> None
+  in match l with
+  | Nolabel  -> expression2 ctxt f e (* level 2*)
+  | Optional str ->
+      if Some str = simple_name then
+        pp f "?%s" str
+      else
+        pp f "?%s:%a" str (simple_expr ctxt) e
+  | Labelled lbl ->
+      if Some lbl = simple_name then
+        pp f "~%s" lbl
+      else
+        pp f "~%s:%a" lbl (simple_expr ctxt) e
+
+
+
+let expression f x =
+  pp f "@[%a@]" (expression reset_ctxt) x
+
+let string_of_expression x =
+  ignore (flush_str_formatter ()) ;
+  let f = str_formatter in
+  expression f x;
+  flush_str_formatter ()
+
+let string_of_structure x =
+  ignore (flush_str_formatter ());
+  let f = str_formatter in
+  structure reset_ctxt f x;
+  flush_str_formatter ()
+
+
+let core_type = core_type reset_ctxt
+let pattern = pattern reset_ctxt
+let signature = signature reset_ctxt
+let structure = structure reset_ctxt
+
 end
 module TypedtreeIter : sig 
 #1 "typedtreeIter.mli"
@@ -26839,7 +28582,7 @@ let is_cons = function
 
 let pretty_const c = match c with
 | Const_int i -> Printf.sprintf "%d" i
-| Const_char c -> Printf.sprintf "%C" c
+| Const_char i -> Printf.sprintf "%s" (Pprintast.string_of_int_as_char i)
 | Const_string (s, _) -> Printf.sprintf "%S" s
 | Const_float f -> Printf.sprintf "%s" f
 | Const_int32 i -> Printf.sprintf "%ldl" i
@@ -27497,7 +29240,7 @@ let build_other_constant proj make first next p env =
 
 let some_other_tag = "<some other tag>"
 
-let build_other ext env = match env with
+let build_other ext env : Typedtree.pattern = match env with
 | ({pat_desc = Tpat_construct (lid, {cstr_tag=Cstr_extension _},_)},_) :: _ ->
         (* let c = {c with cstr_name = "*extension*"} in *) (* PR#7330 *)
         make_pat (Tpat_var (Ident.create "*extension*",
@@ -27539,13 +29282,19 @@ let build_other ext env = match env with
             make_pat (Tpat_or (pat, p_res, None)) p.pat_type p.pat_env)
           pat other_pats
     end
-| ({pat_desc=(Tpat_constant (Const_int _ | Const_char _))} as p,_) :: _ ->
+| ({pat_desc=(Tpat_constant (Const_int _ ))} as p,_) :: _ ->
     build_other_constant
       (function Tpat_constant(Const_int i) -> i 
-      | Tpat_constant (Const_char i) -> Char.code i
       | _ -> assert false)
       (function i -> Tpat_constant(Const_int i))
       0 succ p env
+| ({pat_desc=(Tpat_constant (Const_char _ ))} as p,_) :: _ ->
+        build_other_constant
+          (function 
+          | Tpat_constant (Const_char i) -> i
+          | _ -> assert false)
+          (function i -> Tpat_constant(Const_char i))
+          0 succ p env      
 | ({pat_desc=(Tpat_constant (Const_int32 _))} as p,_) :: _ ->
     build_other_constant
       (function Tpat_constant(Const_int32 i) -> i | _ -> assert false)
@@ -29124,7 +30873,7 @@ open Lambda
 
 let rec struct_const ppf = function
   | Const_base(Const_int n) -> fprintf ppf "%i" n
-  | Const_base(Const_char c) -> fprintf ppf "%C" c
+  | Const_base(Const_char i) -> fprintf ppf "%s" (Pprintast.string_of_int_as_char i)
   | Const_base(Const_string (s, _)) -> fprintf ppf "%S" s
   | Const_immstring s -> fprintf ppf "#%S" s
   | Const_base(Const_float f) -> fprintf ppf "%s" f
@@ -39962,7 +41711,7 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env
         else
           or_ ~loc:gloc
             (constant ~loc:gloc (Pconst_char c1))
-            (loop (Char.chr(Char.code c1 + 1)) c2)
+            (loop (c1 + 1) c2)
       in
       let p = if c1 <= c2 then loop c1 c2 else loop c2 c1 in
       let p = {p with ppat_loc=loc} in
@@ -45055,7 +46804,7 @@ let combine_constant names loc arg cst partial ctx def
         call_switcher loc fail arg min_int max_int int_lambda_list names
     | Const_char _ ->
         let int_lambda_list =
-          List.map (function Const_char c, l -> (Char.code c, l)
+          List.map (function Const_char c, l -> (c, l)
             | _ -> assert false)
             const_lambda_list in
         call_switcher loc fail arg 0 max_int int_lambda_list names
@@ -50864,7 +52613,7 @@ type t =
   | Open
   | True
   | False
-  | Codepoint of {c: char; original: string}
+  | Codepoint of {c: int; original: string}
   | Int of {i: string; suffix: char option}
   | Float of {f: string; suffix: char option}
   | String of string
@@ -51867,7 +53616,7 @@ let printConstant ?(templateLiteral = false) c =
   | Pconst_float (s, _) -> Doc.text s
   | Pconst_char c ->
     let str =
-      match c with
+      match Char.unsafe_chr c with
       | '\'' -> "\\'"
       | '\\' -> "\\\\"
       | '\n' -> "\\n"
@@ -51878,7 +53627,7 @@ let printConstant ?(templateLiteral = false) c =
         let s = (Bytes.create [@doesNotRaise]) 1 in
         Bytes.unsafe_set s 0 c;
         Bytes.unsafe_to_string s
-      | c -> Res_utf8.encodeCodePoint (Obj.magic c)
+      | _ -> Res_utf8.encodeCodePoint c
     in
     Doc.text ("'" ^ str ^ "'")
 
@@ -57026,82 +58775,6 @@ let print_pattern typed =
   let doc = Res_printer.printPattern pat Res_comments_table.empty in
   Res_doc.toString ~width:80 doc
 
-end
-module Ext_util : sig 
-#1 "ext_util.mli"
-(* Copyright (C) 2015-2016 Bloomberg Finance L.P.
- * 
- * This program is free software: you can redistribute it and/or modify
- * it under the terms of the GNU Lesser General Public License as published by
- * the Free Software Foundation, either version 3 of the License, or
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU Lesser General Public License for more details.
- * 
- * You should have received a copy of the GNU Lesser General Public License
- * along with this program; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
-
-val power_2_above : int -> int -> int
-
-val stats_to_string : Hashtbl.statistics -> string
-
-end = struct
-#1 "ext_util.ml"
-(* Copyright (C) 2015-2016 Bloomberg Finance L.P.
- * 
- * This program is free software: you can redistribute it and/or modify
- * it under the terms of the GNU Lesser General Public License as published by
- * the Free Software Foundation, either version 3 of the License, or
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU Lesser General Public License for more details.
- * 
- * You should have received a copy of the GNU Lesser General Public License
- * along with this program; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
-
-(**
-   {[
-     (power_2_above 16 63 = 64)
-       (power_2_above 16 76 = 128)
-   ]}
-*)
-let rec power_2_above x n =
-  if x >= n then x
-  else if x * 2 > Sys.max_array_length then x
-  else power_2_above (x * 2) n
-
-let stats_to_string
-    ({ num_bindings; num_buckets; max_bucket_length; bucket_histogram } :
-      Hashtbl.statistics) =
-  Printf.sprintf "bindings: %d,buckets: %d, longest: %d, hist:[%s]" num_bindings
-    num_buckets max_bucket_length
-    (String.concat ","
-       (Array.to_list (Array.map string_of_int bucket_histogram)))
-
 end
 module Hash_gen
 = struct
@@ -69577,7 +71250,7 @@ let yyact = [|
     let _1 = (Parsing.peek_val __caml_parser_env 0 : char) in
     Obj.repr(
 # 2155 "ml/parser.mly"
-                 ( Pconst_char _1 )
+                 ( Pconst_char (Char.code _1) )
 # 11020 "ml/parser.ml"
                : 'constant))
 ; (fun __caml_parser_env ->
@@ -75137,7 +76810,7 @@ type float_lit = { f : string } [@@unboxed]
 
 type number =
   | Float of float_lit
-  | Int of { i : int32; c : char option }
+  | Int of { i : int32; c : int option }
   | Uint of int32
 
 (* becareful when constant folding +/-,
@@ -77077,7 +78750,7 @@ val method_ :
 
 val econd : ?comment:string -> t -> t -> t -> t
 
-val int : ?comment:string -> ?c:char -> int32 -> t
+val int : ?comment:string -> ?c:int -> int32 -> t
 
 val uint32 : ?comment:string -> int32 -> t
 
@@ -79886,7 +81559,7 @@ and expression_desc cxt ~(level : int) f x : cxt =
         match v with
         | Float { f } -> Js_number.caml_float_literal_to_js_string f
         (* attach string here for float constant folding?*)
-        | Int { i; c = Some c } -> Format.asprintf "/* %C */%ld" c i
+        | Int { i; c = Some c } -> Format.asprintf "/* %s */%ld" (Ext_util.string_of_int_as_char c) i
         | Int { i; c = None } ->
             Int32.to_string i
             (* check , js convention with ocaml lexical convention *)
@@ -82407,145 +84080,6 @@ let is_lower_case c =
   || (c >= '\224' && c <= '\246')
   || (c >= '\248' && c <= '\254')
 
-end
-module Ext_utf8 : sig 
-#1 "ext_utf8.mli"
-(* Copyright (C) 2015-2016 Bloomberg Finance L.P.
- *
- * This program is free software: you can redistribute it and/or modify
- * it under the terms of the GNU Lesser General Public License as published by
- * the Free Software Foundation, either version 3 of the License, or
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public License
- * along with this program; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
-
-type byte = Single of int | Cont of int | Leading of int * int | Invalid
-
-val classify : char -> byte
-
-val follow : string -> int -> int -> int -> int * int
-
-val next : string -> remaining:int -> int -> int
-(** 
-   return [-1] if failed 
-*)
-
-exception Invalid_utf8 of string
-
-val decode_utf8_string : string -> int list
-
-end = struct
-#1 "ext_utf8.ml"
-(* Copyright (C) 2015-2016 Bloomberg Finance L.P.
- *
- * This program is free software: you can redistribute it and/or modify
- * it under the terms of the GNU Lesser General Public License as published by
- * the Free Software Foundation, either version 3 of the License, or
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public License
- * along with this program; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
-
-type byte = Single of int | Cont of int | Leading of int * int | Invalid
-
-(** [classify chr] returns the {!byte} corresponding to [chr] *)
-let classify chr =
-  let c = int_of_char chr in
-  (* Classify byte according to leftmost 0 bit *)
-  if c land 0b1000_0000 = 0 then Single c
-  else if (* c 0b0____*)
-          c land 0b0100_0000 = 0 then Cont (c land 0b0011_1111)
-  else if (* c 0b10___*)
-          c land 0b0010_0000 = 0 then Leading (1, c land 0b0001_1111)
-  else if (* c 0b110__*)
-          c land 0b0001_0000 = 0 then Leading (2, c land 0b0000_1111)
-  else if (* c 0b1110_ *)
-          c land 0b0000_1000 = 0 then Leading (3, c land 0b0000_0111)
-  else if (* c 0b1111_0___*)
-          c land 0b0000_0100 = 0 then Leading (4, c land 0b0000_0011)
-  else if (* c 0b1111_10__*)
-          c land 0b0000_0010 = 0 then Leading (5, c land 0b0000_0001)
-    (* c 0b1111_110__ *)
-  else Invalid
-
-exception Invalid_utf8 of string
-
-(* when the first char is [Leading],
-   TODO: need more error checking
-   when out of bond
-*)
-let rec follow s n (c : int) offset =
-  if n = 0 then (c, offset)
-  else
-    match classify s.[offset + 1] with
-    | Cont cc -> follow s (n - 1) ((c lsl 6) lor (cc land 0x3f)) (offset + 1)
-    | _ -> raise (Invalid_utf8 "Continuation byte expected")
-
-let rec next s ~remaining offset =
-  if remaining = 0 then offset
-  else
-    match classify s.[offset + 1] with
-    | Cont _cc -> next s ~remaining:(remaining - 1) (offset + 1)
-    | _ -> -1
-    | exception _ -> -1
-(* it can happen when out of bound *)
-
-let decode_utf8_string s =
-  let lst = ref [] in
-  let add elem = lst := elem :: !lst in
-  let rec decode_utf8_cont s i s_len =
-    if i = s_len then ()
-    else
-      match classify s.[i] with
-      | Single c ->
-          add c;
-          decode_utf8_cont s (i + 1) s_len
-      | Cont _ -> raise (Invalid_utf8 "Unexpected continuation byte")
-      | Leading (n, c) ->
-          let c', i' = follow s n c i in
-          add c';
-          decode_utf8_cont s (i' + 1) s_len
-      | Invalid -> raise (Invalid_utf8 "Invalid byte")
-  in
-  decode_utf8_cont s 0 (String.length s);
-  List.rev !lst
-
-(** To decode {j||j} we need verify in the ast so that we have better error 
-    location, then we do the decode later
-*)
-
-(* let verify s loc =
-   assert false *)
-
 end
 module Ast_utf8_string : sig 
 #1 "ast_utf8_string.mli"
@@ -83624,7 +85158,7 @@ type t =
   | Const_js_true
   | Const_js_false
   | Const_int of { i : int32; comment : pointer_info }
-  | Const_char of char
+  | Const_char of int
   | Const_string of { s : string; unicode : bool }
   | Const_float of string
   | Const_int64 of int64
@@ -83687,7 +85221,7 @@ type t =
   | Const_js_true
   | Const_js_false
   | Const_int of { i : int32; comment : pointer_info }
-  | Const_char of char
+  | Const_char of int
   | Const_string of { s : string; unicode : bool }
   | Const_float of string
   | Const_int64 of int64
@@ -85479,7 +87013,7 @@ let prim ~primitive:(prim : Lam_primitive.t) ~args loc : t =
       | ( (Pstringrefs | Pstringrefu),
           Const_string { s = a; unicode = false },
           Const_int { i = b } ) -> (
-          try Lift.char (String.get a (Int32.to_int b)) with _ -> default ())
+          try Lift.char (Char.code (String.get a (Int32.to_int b))) with _ -> default ())
       | _ -> default ())
   | _ -> (
       match prim with
@@ -85550,7 +87084,7 @@ let rec complete_range (sw_consts : (int * _) list) ~(start : int) ~finish =
 let rec eval_const_as_bool (v : Lam_constant.t) : bool =
   match v with
   | Const_int { i = x } -> x <> 0l
-  | Const_char x -> Char.code x <> 0
+  | Const_char x -> x <> 0
   | Const_int64 x -> x <> 0L
   | Const_js_false | Const_js_null | Const_module_alias | Const_js_undefined ->
       false
@@ -92324,7 +93858,7 @@ let rec struct_const ppf (cst : Lam_constant.t) =
   | Const_module_alias -> fprintf ppf "#alias"
   | Const_js_undefined -> fprintf ppf "#undefined"
   | Const_int { i } -> fprintf ppf "%ld" i
-  | Const_char c -> fprintf ppf "%C" c
+  | Const_char i -> fprintf ppf "%s" (Ext_util.string_of_int_as_char i)
   | Const_string { s } -> fprintf ppf "%S" s
   | Const_float f -> fprintf ppf "%s" f
   | Const_int64 n -> fprintf ppf "%LiL" n
@@ -95126,7 +96660,7 @@ val ref_byte : J.expression -> J.expression -> J.expression
 
 val set_byte : J.expression -> J.expression -> J.expression -> J.expression
 
-val const_char : char -> J.expression
+val const_char : int -> J.expression
 
 val bytes_to_string : J.expression -> J.expression
 
@@ -95163,7 +96697,7 @@ module E = Js_exp_make
     currently, it follows the same patten of ocaml, [char] is [int]
 *)
 
-let const_char (i : char) = E.int ~c:i (Int32.of_int @@ Char.code i)
+let const_char (i : int) = E.int ~c:i (Int32.of_int @@ i)
 
 (* string [s[i]] expects to return a [ocaml_char] *)
 let ref_string e e1 = E.string_index e e1
@@ -258459,7 +259993,7 @@ let lets_helper (count_var : Ident.t -> Lam_pass_count.used_info) lam : Lam.t =
           |Lconst((Const_int {i})) -> 
             let i = Int32.to_int i in
             if i < String.length l_s && i >= 0  then
-              Lam.const ((Const_char l_s.[i]))
+              Lam.const ((Const_char (Char.code l_s.[i])))
             else 
               Lam.prim ~primitive ~args:[l';r'] loc 
           | _ -> 
diff --git a/lib/4.06.1/unstable/js_compiler.ml.d b/lib/4.06.1/unstable/js_compiler.ml.d
index d9c1e6e21b..a16f0b5d82 100644
--- a/lib/4.06.1/unstable/js_compiler.ml.d
+++ b/lib/4.06.1/unstable/js_compiler.ml.d
@@ -513,6 +513,8 @@
 ../lib/4.06.1/unstable/js_compiler.ml: ./ml/parsetree.ml
 ../lib/4.06.1/unstable/js_compiler.ml: ./ml/path.ml
 ../lib/4.06.1/unstable/js_compiler.ml: ./ml/path.mli
+../lib/4.06.1/unstable/js_compiler.ml: ./ml/pprintast.mli
+../lib/4.06.1/unstable/js_compiler.ml: ./ml/pprintast.pp.ml
 ../lib/4.06.1/unstable/js_compiler.ml: ./ml/predef.ml
 ../lib/4.06.1/unstable/js_compiler.ml: ./ml/predef.mli
 ../lib/4.06.1/unstable/js_compiler.ml: ./ml/primitive.ml
diff --git a/lib/4.06.1/unstable/js_playground_compiler.ml b/lib/4.06.1/unstable/js_playground_compiler.ml
index c1f57abc76..d026870552 100644
--- a/lib/4.06.1/unstable/js_playground_compiler.ml
+++ b/lib/4.06.1/unstable/js_playground_compiler.ml
@@ -2847,7 +2847,7 @@ module Asttypes
 
 type constant =
     Const_int of int
-  | Const_char of char
+  | Const_char of int
   | Const_string of string * string option
   | Const_float of string
   | Const_int32 of int32
@@ -2901,6 +2901,7 @@ let same_arg_label (x : arg_label) y =
       | Optional s0 -> s = s0
       | _ -> false  
       end  
+
 end
 module Builtin_cmi_datasets : sig 
 #1 "builtin_cmi_datasets.mli"
@@ -4000,7 +4001,7 @@ type constant =
      Suffixes [g-z][G-Z] are accepted by the parser.
      Suffixes except 'l', 'L' and 'n' are rejected by the typechecker
   *)
-  | Pconst_char of char
+  | Pconst_char of int
   (* 'c' *)
   | Pconst_string of string * string option
   (* "constant"
@@ -12153,7 +12154,7 @@ module Const = struct
   let int64 ?(suffix='L') i = integer ~suffix (Int64.to_string i)
   let nativeint ?(suffix='n') i = integer ~suffix (Nativeint.to_string i)
   let float ?suffix f = Pconst_float (f, suffix)
-  let char c = Pconst_char c
+  let char c = Pconst_char (Char.code c)
   let string ?quotation_delimiter s = Pconst_string (s, quotation_delimiter)
 end
 
@@ -24865,15 +24866,291 @@ let reset () =
   raise_count := 0
 
 end
-module TypedtreeIter : sig 
-#1 "typedtreeIter.mli"
+module Ext_utf8 : sig 
+#1 "ext_utf8.mli"
+(* Copyright (C) 2015-2016 Bloomberg Finance L.P.
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
+
+type byte = Single of int | Cont of int | Leading of int * int | Invalid
+
+val classify : char -> byte
+
+val follow : string -> int -> int -> int -> int * int
+
+val next : string -> remaining:int -> int -> int
+(** 
+   return [-1] if failed 
+*)
+
+exception Invalid_utf8 of string
+
+val decode_utf8_string : string -> int list
+
+val encode_codepoint : int -> string
+
+end = struct
+#1 "ext_utf8.ml"
+(* Copyright (C) 2015-2016 Bloomberg Finance L.P.
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
+
+type byte = Single of int | Cont of int | Leading of int * int | Invalid
+
+(** [classify chr] returns the {!byte} corresponding to [chr] *)
+let classify chr =
+  let c = int_of_char chr in
+  (* Classify byte according to leftmost 0 bit *)
+  if c land 0b1000_0000 = 0 then Single c
+  else if (* c 0b0____*)
+          c land 0b0100_0000 = 0 then Cont (c land 0b0011_1111)
+  else if (* c 0b10___*)
+          c land 0b0010_0000 = 0 then Leading (1, c land 0b0001_1111)
+  else if (* c 0b110__*)
+          c land 0b0001_0000 = 0 then Leading (2, c land 0b0000_1111)
+  else if (* c 0b1110_ *)
+          c land 0b0000_1000 = 0 then Leading (3, c land 0b0000_0111)
+  else if (* c 0b1111_0___*)
+          c land 0b0000_0100 = 0 then Leading (4, c land 0b0000_0011)
+  else if (* c 0b1111_10__*)
+          c land 0b0000_0010 = 0 then Leading (5, c land 0b0000_0001)
+    (* c 0b1111_110__ *)
+  else Invalid
+
+exception Invalid_utf8 of string
+
+(* when the first char is [Leading],
+   TODO: need more error checking
+   when out of bond
+*)
+let rec follow s n (c : int) offset =
+  if n = 0 then (c, offset)
+  else
+    match classify s.[offset + 1] with
+    | Cont cc -> follow s (n - 1) ((c lsl 6) lor (cc land 0x3f)) (offset + 1)
+    | _ -> raise (Invalid_utf8 "Continuation byte expected")
+
+let rec next s ~remaining offset =
+  if remaining = 0 then offset
+  else
+    match classify s.[offset + 1] with
+    | Cont _cc -> next s ~remaining:(remaining - 1) (offset + 1)
+    | _ -> -1
+    | exception _ -> -1
+(* it can happen when out of bound *)
+
+let decode_utf8_string s =
+  let lst = ref [] in
+  let add elem = lst := elem :: !lst in
+  let rec decode_utf8_cont s i s_len =
+    if i = s_len then ()
+    else
+      match classify s.[i] with
+      | Single c ->
+          add c;
+          decode_utf8_cont s (i + 1) s_len
+      | Cont _ -> raise (Invalid_utf8 "Unexpected continuation byte")
+      | Leading (n, c) ->
+          let c', i' = follow s n c i in
+          add c';
+          decode_utf8_cont s (i' + 1) s_len
+      | Invalid -> raise (Invalid_utf8 "Invalid byte")
+  in
+  decode_utf8_cont s 0 (String.length s);
+  List.rev !lst
+
+(** To decode {j||j} we need verify in the ast so that we have better error 
+    location, then we do the decode later
+*)
+
+(* let verify s loc =
+   assert false *)
+
+let encode_codepoint c =
+  (* reused from syntax/src/res_utf8.ml *)
+  let h2 = 0b1100_0000 in
+  let h3 = 0b1110_0000 in
+  let h4 = 0b1111_0000 in
+  let cont_mask = 0b0011_1111 in
+  if c <= 127 then (
+    let bytes = (Bytes.create [@doesNotRaise]) 1 in
+    Bytes.unsafe_set bytes 0 (Char.unsafe_chr c);
+    Bytes.unsafe_to_string bytes)
+  else if c <= 2047 then (
+    let bytes = (Bytes.create [@doesNotRaise]) 2 in
+    Bytes.unsafe_set bytes 0 (Char.unsafe_chr (h2 lor (c lsr 6)));
+    Bytes.unsafe_set bytes 1
+      (Char.unsafe_chr (0b1000_0000 lor (c land cont_mask)));
+    Bytes.unsafe_to_string bytes)
+  else if c <= 65535 then (
+    let bytes = (Bytes.create [@doesNotRaise]) 3 in
+    Bytes.unsafe_set bytes 0 (Char.unsafe_chr (h3 lor (c lsr 12)));
+    Bytes.unsafe_set bytes 1
+      (Char.unsafe_chr (0b1000_0000 lor ((c lsr 6) land cont_mask)));
+    Bytes.unsafe_set bytes 2
+      (Char.unsafe_chr (0b1000_0000 lor (c land cont_mask)));
+    Bytes.unsafe_to_string bytes)
+  else
+    (* if c <= max then *)
+    let bytes = (Bytes.create [@doesNotRaise]) 4 in
+    Bytes.unsafe_set bytes 0 (Char.unsafe_chr (h4 lor (c lsr 18)));
+    Bytes.unsafe_set bytes 1
+      (Char.unsafe_chr (0b1000_0000 lor ((c lsr 12) land cont_mask)));
+    Bytes.unsafe_set bytes 2
+      (Char.unsafe_chr (0b1000_0000 lor ((c lsr 6) land cont_mask)));
+    Bytes.unsafe_set bytes 3
+      (Char.unsafe_chr (0b1000_0000 lor (c land cont_mask)));
+    Bytes.unsafe_to_string bytes
+
+
+end
+module Ext_util : sig 
+#1 "ext_util.mli"
+(* Copyright (C) 2015-2016 Bloomberg Finance L.P.
+ * 
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ * 
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
+
+val power_2_above : int -> int -> int
+
+val stats_to_string : Hashtbl.statistics -> string
+
+val string_of_int_as_char : int -> string
+
+
+end = struct
+#1 "ext_util.ml"
+(* Copyright (C) 2015-2016 Bloomberg Finance L.P.
+ * 
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ * 
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
+
+(**
+   {[
+     (power_2_above 16 63 = 64)
+       (power_2_above 16 76 = 128)
+   ]}
+*)
+let rec power_2_above x n =
+  if x >= n then x
+  else if x * 2 > Sys.max_array_length then x
+  else power_2_above (x * 2) n
+
+let stats_to_string
+    ({ num_bindings; num_buckets; max_bucket_length; bucket_histogram } :
+      Hashtbl.statistics) =
+  Printf.sprintf "bindings: %d,buckets: %d, longest: %d, hist:[%s]" num_bindings
+    num_buckets max_bucket_length
+    (String.concat ","
+       (Array.to_list (Array.map string_of_int bucket_histogram)))
+
+let string_of_int_as_char (i : int) : string =
+  if i <= 255 && i >= 0 then Format.asprintf "%C" (Char.unsafe_chr i)
+  else
+    let str =
+      match Char.unsafe_chr i with
+      | '\'' -> "\\'"
+      | '\\' -> "\\\\"
+      | '\n' -> "\\n"
+      | '\t' -> "\\t"
+      | '\r' -> "\\r"
+      | '\b' -> "\\b"
+      | ' ' .. '~' as c ->
+          let s = (Bytes.create [@doesNotRaise]) 1 in
+          Bytes.unsafe_set s 0 c;
+          Bytes.unsafe_to_string s
+      | _ -> Ext_utf8.encode_codepoint i
+    in
+    Printf.sprintf "\'%s\'" str
+
+end
+module Pprintast : sig 
+#1 "pprintast.mli"
 (**************************************************************************)
 (*                                                                        *)
 (*                                 OCaml                                  *)
 (*                                                                        *)
-(*    Thomas Gazagnaire (OCamlPro), Fabrice Le Fessant (INRIA Saclay)     *)
+(*             Hongbo Zhang (University of Pennsylvania)                  *)
 (*                                                                        *)
-(*   Copyright 2007 Institut National de Recherche en Informatique et     *)
+(*   Copyright 1996 Institut National de Recherche en Informatique et     *)
 (*     en Automatique.                                                    *)
 (*                                                                        *)
 (*   All rights reserved.  This file is distributed under the terms of    *)
@@ -24882,87 +25159,28 @@ module TypedtreeIter : sig
 (*                                                                        *)
 (**************************************************************************)
 
-open Asttypes
-open Typedtree
-
-
-module type IteratorArgument = sig
-    val enter_structure : structure -> unit
-    val enter_value_description : value_description -> unit
-    val enter_type_extension : type_extension -> unit
-    val enter_extension_constructor : extension_constructor -> unit
-    val enter_pattern : pattern -> unit
-    val enter_expression : expression -> unit
-    val enter_package_type : package_type -> unit
-    val enter_signature : signature -> unit
-    val enter_signature_item : signature_item -> unit
-    val enter_module_type_declaration : module_type_declaration -> unit
-    val enter_module_type : module_type -> unit
-    val enter_module_expr : module_expr -> unit
-    val enter_with_constraint : with_constraint -> unit
-    val enter_class_signature : class_signature -> unit
-    val enter_class_description : class_description -> unit
-    val enter_class_type_declaration : class_type_declaration -> unit
-    val enter_class_type : class_type -> unit
-    val enter_class_type_field : class_type_field -> unit
-    val enter_core_type : core_type -> unit
-    val enter_structure_item : structure_item -> unit
-
-
-    val leave_structure : structure -> unit
-    val leave_value_description : value_description -> unit
-    val leave_type_extension : type_extension -> unit
-    val leave_extension_constructor : extension_constructor -> unit
-    val leave_pattern : pattern -> unit
-    val leave_expression : expression -> unit
-    val leave_package_type : package_type -> unit
-    val leave_signature : signature -> unit
-    val leave_signature_item : signature_item -> unit
-    val leave_module_type_declaration : module_type_declaration -> unit
-    val leave_module_type : module_type -> unit
-    val leave_module_expr : module_expr -> unit
-    val leave_with_constraint : with_constraint -> unit
-    val leave_class_signature : class_signature -> unit
-    val leave_class_description : class_description -> unit
-    val leave_class_type_declaration : class_type_declaration -> unit
-    val leave_class_type : class_type -> unit
-    val leave_class_type_field : class_type_field -> unit
-    val leave_core_type : core_type -> unit
-    val leave_structure_item : structure_item -> unit
-
-    val enter_bindings : rec_flag -> unit
-    val enter_binding : value_binding -> unit
-    val leave_binding : value_binding -> unit
-    val leave_bindings : rec_flag -> unit
-
-    val enter_type_declarations : rec_flag -> unit
-    val enter_type_declaration : type_declaration -> unit
-    val leave_type_declaration : type_declaration -> unit
-    val leave_type_declarations : rec_flag -> unit
+type space_formatter = (unit, Format.formatter, unit) format
 
-end
 
-module [@warning "-67"] MakeIterator :
-  functor (Iter : IteratorArgument) ->
-    sig
-      val iter_structure : structure -> unit
-      val iter_signature : signature -> unit
-      val iter_structure_item : structure_item -> unit
-      val iter_signature_item : signature_item -> unit
-      val iter_expression : expression -> unit
-      val iter_module_type : module_type -> unit
-      val iter_pattern : pattern -> unit
-    end
+val expression : Format.formatter -> Parsetree.expression -> unit
+val string_of_expression : Parsetree.expression -> string
 
-module DefaultIteratorArgument : IteratorArgument
+val core_type: Format.formatter -> Parsetree.core_type -> unit
+val pattern: Format.formatter -> Parsetree.pattern -> unit
+val signature: Format.formatter -> Parsetree.signature -> unit
+val structure: Format.formatter -> Parsetree.structure -> unit
+val string_of_structure: Parsetree.structure -> string
+val string_of_int_as_char: int -> string
 
 end = struct
-#1 "typedtreeIter.ml"
+#1 "pprintast.pp.ml"
 (**************************************************************************)
 (*                                                                        *)
 (*                                 OCaml                                  *)
 (*                                                                        *)
-(*    Thomas Gazagnaire (OCamlPro), Fabrice Le Fessant (INRIA Saclay)     *)
+(*                      Thomas Gazagnaire, OCamlPro                       *)
+(*                   Fabrice Le Fessant, INRIA Saclay                     *)
+(*               Hongbo Zhang, University of Pennsylvania                 *)
 (*                                                                        *)
 (*   Copyright 2007 Institut National de Recherche en Informatique et     *)
 (*     en Automatique.                                                    *)
@@ -24973,378 +25191,1903 @@ end = struct
 (*                                                                        *)
 (**************************************************************************)
 
-(*
-TODO:
- - 2012/05/10: Follow camlp4 way of building map and iter using classes
-     and inheritance ?
-*)
+(* Original Code from Ber-metaocaml, modified for 3.12.0 and fixed *)
+(* Printing code expressions *)
+(* Authors:  Ed Pizzi, Fabrice Le Fessant *)
+(* Extensive Rewrite: Hongbo Zhang: University of Pennsylvania *)
+(* TODO more fine-grained precedence pretty-printing *)
 
 open Asttypes
-open Typedtree
+open Format
+open Location
+open Longident
+open Parsetree
+open Ast_helper
 
-module type IteratorArgument = sig
+let prefix_symbols  = [ '!'; '?'; '~' ] ;;
+let infix_symbols = [ '='; '<'; '>'; '@'; '^'; '|'; '&'; '+'; '-'; '*'; '/';
+                      '$'; '%'; '#' ]
 
-    val enter_structure : structure -> unit
-    val enter_value_description : value_description -> unit
-    val enter_type_extension : type_extension -> unit
-    val enter_extension_constructor : extension_constructor -> unit
-    val enter_pattern : pattern -> unit
-    val enter_expression : expression -> unit
-    val enter_package_type : package_type -> unit
-    val enter_signature : signature -> unit
-    val enter_signature_item : signature_item -> unit
-    val enter_module_type_declaration : module_type_declaration -> unit
-    val enter_module_type : module_type -> unit
-    val enter_module_expr : module_expr -> unit
-    val enter_with_constraint : with_constraint -> unit
-    val enter_class_signature : class_signature -> unit
+(* type fixity = Infix| Prefix  *)
+let special_infix_strings =
+  ["asr"; "land"; "lor"; "lsl"; "lsr"; "lxor"; "mod"; "or"; ":="; "!="; "::" ]
 
-    val enter_class_description : class_description -> unit
-    val enter_class_type_declaration : class_type_declaration -> unit
-    val enter_class_type : class_type -> unit
-    val enter_class_type_field : class_type_field -> unit
-    val enter_core_type : core_type -> unit
-    val enter_structure_item : structure_item -> unit
+(* determines if the string is an infix string.
+   checks backwards, first allowing a renaming postfix ("_102") which
+   may have resulted from Pexp -> Texp -> Pexp translation, then checking
+   if all the characters in the beginning of the string are valid infix
+   characters. *)
+let fixity_of_string  = function
+  | s when List.mem s special_infix_strings -> `Infix s
+  | s when List.mem s.[0] infix_symbols -> `Infix s
+  | s when List.mem s.[0] prefix_symbols -> `Prefix s
+  | s when s.[0] = '.' -> `Mixfix s
+  | _ -> `Normal
 
+let view_fixity_of_exp = function
+  | {pexp_desc = Pexp_ident {txt=Lident l;_}; pexp_attributes = []} ->
+      fixity_of_string l
+  | _ -> `Normal
 
-    val leave_structure : structure -> unit
-    val leave_value_description : value_description -> unit
-    val leave_type_extension : type_extension -> unit
-    val leave_extension_constructor : extension_constructor -> unit
-    val leave_pattern : pattern -> unit
-    val leave_expression : expression -> unit
-    val leave_package_type : package_type -> unit
-    val leave_signature : signature -> unit
-    val leave_signature_item : signature_item -> unit
-    val leave_module_type_declaration : module_type_declaration -> unit
-    val leave_module_type : module_type -> unit
-    val leave_module_expr : module_expr -> unit
-    val leave_with_constraint : with_constraint -> unit
-    val leave_class_signature : class_signature -> unit
+let is_infix  = function  | `Infix _ -> true | _  -> false
+let is_mixfix = function `Mixfix _ -> true | _ -> false
 
-    val leave_class_description : class_description -> unit
-    val leave_class_type_declaration : class_type_declaration -> unit
-    val leave_class_type : class_type -> unit
-    val leave_class_type_field : class_type_field -> unit
-    val leave_core_type : core_type -> unit
-    val leave_structure_item : structure_item -> unit
+(* which identifiers are in fact operators needing parentheses *)
+let needs_parens txt =
+  let fix = fixity_of_string txt in
+  is_infix fix
+  || is_mixfix fix
+  || List.mem txt.[0] prefix_symbols
 
-    val enter_bindings : rec_flag -> unit
-    val enter_binding : value_binding -> unit
-    val leave_binding : value_binding -> unit
-    val leave_bindings : rec_flag -> unit
+(* some infixes need spaces around parens to avoid clashes with comment
+   syntax *)
+let needs_spaces txt =
+  txt.[0]='*' || txt.[String.length txt - 1] = '*'
 
-    val enter_type_declarations : rec_flag -> unit
-    val enter_type_declaration : type_declaration -> unit
-    val leave_type_declaration : type_declaration -> unit
-    val leave_type_declarations : rec_flag -> unit
+(* add parentheses to binders when they are in fact infix or prefix operators *)
+let protect_ident ppf txt =
+  let format : (_, _, _) format =
+    if not (needs_parens txt) then "%s"
+    else if needs_spaces txt then "(@;%s@;)"
+    else "(%s)"
+  in fprintf ppf format txt
 
-      end
+let protect_longident ppf print_longident longprefix txt =
+  let format : (_, _, _) format =
+    if not (needs_parens txt) then "%a.%s"
+    else if needs_spaces txt then  "%a.(@;%s@;)"
+    else "%a.(%s)" in
+  fprintf ppf format print_longident longprefix txt
 
-module MakeIterator(Iter : IteratorArgument) : sig
+type space_formatter = (unit, Format.formatter, unit) format
 
-    val iter_structure : structure -> unit
-    val iter_signature : signature -> unit
-    val iter_structure_item : structure_item -> unit
-    val iter_signature_item : signature_item -> unit
-    val iter_expression : expression -> unit
-    val iter_module_type : module_type -> unit
-    val iter_pattern : pattern -> unit
+let override = function
+  | Override -> "!"
+  | Fresh -> ""
 
-  end = struct
+(* variance encoding: need to sync up with the [parser.mly] *)
+let type_variance = function
+  | Invariant -> ""
+  | Covariant -> "+"
+  | Contravariant -> "-"
 
-    let may_iter f v =
-      match v with
-        None -> ()
-      | Some x -> f x
+type construct =
+  [ `cons of expression list
+  | `list of expression list
+  | `nil
+  | `normal
+  | `simple of Longident.t
+  | `tuple ]
 
+let view_expr x =
+  match x.pexp_desc with
+  | Pexp_construct ( {txt= Lident "()"; _},_) -> `tuple
+  | Pexp_construct ( {txt= Lident "[]";_},_) -> `nil
+  | Pexp_construct ( {txt= Lident"::";_},Some _) ->
+      let rec loop exp acc = match exp with
+          | {pexp_desc=Pexp_construct ({txt=Lident "[]";_},_);
+             pexp_attributes = []} ->
+              (List.rev acc,true)
+          | {pexp_desc=
+             Pexp_construct ({txt=Lident "::";_},
+                             Some ({pexp_desc= Pexp_tuple([e1;e2]);
+                                    pexp_attributes = []}));
+             pexp_attributes = []}
+            ->
+              loop e2 (e1::acc)
+          | e -> (List.rev (e::acc),false) in
+      let (ls,b) = loop x []  in
+      if b then
+        `list ls
+      else `cons ls
+  | Pexp_construct (x,None) -> `simple (x.txt)
+  | _ -> `normal
 
-    let rec iter_structure str =
-      Iter.enter_structure str;
-      List.iter iter_structure_item str.str_items;
-      Iter.leave_structure str
+let is_simple_construct :construct -> bool = function
+  | `nil | `tuple | `list _ | `simple _  -> true
+  | `cons _ | `normal -> false
 
+let pp = fprintf
 
-    and iter_binding vb =
-      Iter.enter_binding vb;
-      iter_pattern vb.vb_pat;
-      iter_expression vb.vb_expr;
-      Iter.leave_binding vb
+type ctxt = {
+  pipe : bool;
+  semi : bool;
+  ifthenelse : bool;
+}
 
-    and iter_bindings rec_flag list =
-      Iter.enter_bindings rec_flag;
-      List.iter iter_binding list;
-      Iter.leave_bindings rec_flag
+let reset_ctxt = { pipe=false; semi=false; ifthenelse=false }
+let under_pipe ctxt = { ctxt with pipe=true }
+let under_semi ctxt = { ctxt with semi=true }
+let under_ifthenelse ctxt = { ctxt with ifthenelse=true }
+(*
+let reset_semi ctxt = { ctxt with semi=false }
+let reset_ifthenelse ctxt = { ctxt with ifthenelse=false }
+let reset_pipe ctxt = { ctxt with pipe=false }
+*)
 
-    and iter_case {c_lhs; c_guard; c_rhs} =
-      iter_pattern c_lhs;
-      may_iter iter_expression c_guard;
-      iter_expression c_rhs
+let list : 'a . ?sep:space_formatter -> ?first:space_formatter ->
+  ?last:space_formatter -> (Format.formatter -> 'a -> unit) ->
+  Format.formatter -> 'a list -> unit
+  = fun ?sep ?first ?last fu f xs ->
+    let first = match first with Some x -> x |None -> ("": _ format6)
+    and last = match last with Some x -> x |None -> ("": _ format6)
+    and sep = match sep with Some x -> x |None -> ("@ ": _ format6) in
+    let aux f = function
+      | [] -> ()
+      | [x] -> fu f x
+      | xs ->
+          let rec loop  f = function
+            | [x] -> fu f x
+            | x::xs ->  fu f x; pp f sep; loop f xs;
+            | _ -> assert false in begin
+            pp f first; loop f xs; pp f last;
+          end in
+    aux f xs
 
-    and iter_cases cases =
-      List.iter iter_case cases
+let option : 'a. ?first:space_formatter -> ?last:space_formatter ->
+  (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a option -> unit
+  = fun  ?first  ?last fu f a ->
+    let first = match first with Some x -> x | None -> ("": _ format6)
+    and last = match last with Some x -> x | None -> ("": _ format6) in
+    match a with
+    | None -> ()
+    | Some x -> pp f first; fu f x; pp f last
 
-    and iter_structure_item item =
-      Iter.enter_structure_item item;
-      begin
-        match item.str_desc with
-          Tstr_eval (exp, _attrs) -> iter_expression exp
-        | Tstr_value (rec_flag, list) ->
-            iter_bindings rec_flag list
-        | Tstr_primitive vd -> iter_value_description vd
-        | Tstr_type (rf, list) -> iter_type_declarations rf list
-        | Tstr_typext tyext -> iter_type_extension tyext
-        | Tstr_exception ext -> iter_extension_constructor ext
-        | Tstr_module x -> iter_module_binding x
-        | Tstr_recmodule list -> List.iter iter_module_binding list
-        | Tstr_modtype mtd -> iter_module_type_declaration mtd
-        | Tstr_open _ -> ()
-        | Tstr_class () -> ()
-        | Tstr_class_type list ->
-            List.iter
-              (fun (_, _, ct) -> iter_class_type_declaration ct)
-              list
-        | Tstr_include incl -> iter_module_expr incl.incl_mod
-        | Tstr_attribute _ ->
-            ()
-      end;
-      Iter.leave_structure_item item
+let paren: 'a . ?first:space_formatter -> ?last:space_formatter ->
+  bool -> (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a -> unit
+  = fun  ?(first=("": _ format6)) ?(last=("": _ format6)) b fu f x ->
+    if b then (pp f "("; pp f first; fu f x; pp f last; pp f ")")
+    else fu f x
 
-    and iter_module_binding x =
-      iter_module_expr x.mb_expr
+let rec longident f = function
+  | Lident s -> protect_ident f s
+  | Ldot(y,s) -> protect_longident f longident y s
+  | Lapply (y,s) ->
+      pp f "%a(%a)" longident y longident s
 
-    and iter_value_description v =
-      Iter.enter_value_description v;
-      iter_core_type v.val_desc;
-      Iter.leave_value_description v
+let longident_loc f x = pp f "%a" longident x.txt
 
-    and iter_constructor_arguments = function
-      | Cstr_tuple l -> List.iter iter_core_type l
-      | Cstr_record l -> List.iter (fun ld -> iter_core_type ld.ld_type) l
+let string_of_int_as_char i = Ext_util.string_of_int_as_char i
 
-    and iter_constructor_declaration cd =
-      iter_constructor_arguments cd.cd_args;
-      option iter_core_type cd.cd_res;
+let constant f = function
+  | Pconst_char i -> pp f "%s"  (string_of_int_as_char i)
+  | Pconst_string (i, None) -> pp f "%S" i
+  | Pconst_string (i, Some delim) -> pp f "{%s|%s|%s}" delim i delim
+  | Pconst_integer (i, None) -> paren (i.[0]='-') (fun f -> pp f "%s") f i
+  | Pconst_integer (i, Some m) ->
+    paren (i.[0]='-') (fun f (i, m) -> pp f "%s%c" i m) f (i,m)
+  | Pconst_float (i, None) -> paren (i.[0]='-') (fun f -> pp f "%s") f i
+  | Pconst_float (i, Some m) -> paren (i.[0]='-') (fun f (i,m) ->
+      pp f "%s%c" i m) f (i,m)
 
-    and iter_type_parameter (ct, _v) =
-      iter_core_type ct
+(* trailing space*)
+let mutable_flag f = function
+  | Immutable -> ()
+  | Mutable -> pp f "mutable@;"
+let virtual_flag f  = function
+  | Concrete -> ()
+  | Virtual -> pp f "virtual@;"
 
-    and iter_type_declaration decl =
-      Iter.enter_type_declaration decl;
-      List.iter iter_type_parameter decl.typ_params;
-      List.iter (fun (ct1, ct2, _loc) ->
-          iter_core_type ct1;
-          iter_core_type ct2
-      ) decl.typ_cstrs;
-      begin match decl.typ_kind with
-          Ttype_abstract -> ()
-        | Ttype_variant list ->
-            List.iter iter_constructor_declaration list
-        | Ttype_record list ->
-            List.iter
-              (fun ld ->
-                iter_core_type ld.ld_type
-            ) list
-        | Ttype_open -> ()
-      end;
-      option iter_core_type decl.typ_manifest;
-      Iter.leave_type_declaration decl
+(* trailing space added *)
+let rec_flag f rf =
+  match rf with
+  | Nonrecursive -> ()
+  | Recursive -> pp f "rec "
+let nonrec_flag f rf =
+  match rf with
+  | Nonrecursive -> pp f "nonrec "
+  | Recursive -> ()
+let direction_flag f = function
+  | Upto -> pp f "to@ "
+  | Downto -> pp f "downto@ "
+let private_flag f = function
+  | Public -> ()
+  | Private -> pp f "private@ "
 
-    and iter_type_declarations rec_flag decls =
-      Iter.enter_type_declarations rec_flag;
-      List.iter iter_type_declaration decls;
-      Iter.leave_type_declarations rec_flag
+let constant_string f s = pp f "%S" s
+let tyvar f str = pp f "'%s" str
+let tyvar_loc f str = pp f "'%s" str.txt
+let string_quot f x = pp f "`%s" x
 
-    and iter_extension_constructor ext =
-      Iter.enter_extension_constructor ext;
-      begin match ext.ext_kind with
-          Text_decl(args, ret) ->
-          iter_constructor_arguments args;
-            option iter_core_type ret
-        | Text_rebind _ -> ()
-      end;
-      Iter.leave_extension_constructor ext;
+(* c ['a,'b] *)
+let rec class_params_def ctxt f =  function
+  | [] -> ()
+  | l ->
+      pp f "[%a] " (* space *)
+        (list (type_param ctxt) ~sep:",") l
 
-    and iter_type_extension tyext =
-      Iter.enter_type_extension tyext;
-      List.iter iter_type_parameter tyext.tyext_params;
-      List.iter iter_extension_constructor tyext.tyext_constructors;
-      Iter.leave_type_extension tyext
+and type_with_label ctxt f (label, c) =
+  match label with
+  | Nolabel    -> core_type1 ctxt f c (* otherwise parenthesize *)
+  | Labelled s -> pp f "%s:%a" s (core_type1 ctxt) c
+  | Optional s -> pp f "?%s:%a" s (core_type1 ctxt) c
 
-    and iter_pattern pat =
-      Iter.enter_pattern pat;
-      List.iter (fun (cstr, _, _attrs) -> match cstr with
-              | Tpat_type _ -> ()
-              | Tpat_unpack -> ()
-              | Tpat_open _ -> ()
-              | Tpat_constraint ct -> iter_core_type ct) pat.pat_extra;
-      begin
-        match pat.pat_desc with
-          Tpat_any -> ()
-        | Tpat_var _ -> ()
-        | Tpat_alias (pat1, _, _) -> iter_pattern pat1
-        | Tpat_constant _ -> ()
-        | Tpat_tuple list ->
-            List.iter iter_pattern list
-        | Tpat_construct (_, _, args) ->
-            List.iter iter_pattern args
-        | Tpat_variant (_, pato, _) ->
-            begin match pato with
-                None -> ()
-              | Some pat -> iter_pattern pat
-            end
-        | Tpat_record (list, _closed) ->
-            List.iter (fun (_, _, pat) -> iter_pattern pat) list
-        | Tpat_array list -> List.iter iter_pattern list
-        | Tpat_or (p1, p2, _) -> iter_pattern p1; iter_pattern p2
-        | Tpat_lazy p -> iter_pattern p
-      end;
-      Iter.leave_pattern pat
+and core_type ctxt f x =
+  if x.ptyp_attributes <> [] then begin
+    pp f "((%a)%a)" (core_type ctxt) {x with ptyp_attributes=[]}
+      (attributes ctxt) x.ptyp_attributes
+  end
+  else match x.ptyp_desc with
+    | Ptyp_arrow (l, ct1, ct2) ->
+        pp f "@[<2>%a@;->@;%a@]" (* FIXME remove parens later *)
+          (type_with_label ctxt) (l,ct1) (core_type ctxt) ct2
+    | Ptyp_alias (ct, s) ->
+        pp f "@[<2>%a@;as@;'%s@]" (core_type1 ctxt) ct s
+    | Ptyp_poly ([], ct) ->
+        core_type ctxt f ct
+    | Ptyp_poly (sl, ct) ->
+        pp f "@[<2>%a%a@]"
+          (fun f l ->
+             pp f "%a"
+               (fun f l -> match l with
+                  | [] -> ()
+                  | _ ->
+                      pp f "%a@;.@;"
+                        (list tyvar_loc ~sep:"@;")  l)
+               l)
+          sl (core_type ctxt) ct
+    | _ -> pp f "@[<2>%a@]" (core_type1 ctxt) x
 
-    and option f x = match x with None -> () | Some e -> f e
+and core_type1 ctxt f x =
+  if x.ptyp_attributes <> [] then core_type ctxt f x
+  else match x.ptyp_desc with
+    | Ptyp_any -> pp f "_";
+    | Ptyp_var s -> tyvar f  s;
+    | Ptyp_tuple l ->  pp f "(%a)" (list (core_type1 ctxt) ~sep:"@;*@;") l
+    | Ptyp_constr (li, l) ->
+        pp f (* "%a%a@;" *) "%a%a"
+          (fun f l -> match l with
+             |[] -> ()
+             |[x]-> pp f "%a@;" (core_type1 ctxt)  x
+             | _ -> list ~first:"(" ~last:")@;" (core_type ctxt) ~sep:",@;" f l)
+          l longident_loc li
+    | Ptyp_variant (l, closed, low) ->
+        let type_variant_helper f x =
+          match x with
+          | Rtag (l, attrs, _, ctl) ->
+              pp f "@[<2>%a%a@;%a@]" string_quot l.txt
+                (fun f l -> match l with
+                   |[] -> ()
+                   | _ -> pp f "@;of@;%a"
+                            (list (core_type ctxt) ~sep:"&")  ctl) ctl
+                (attributes ctxt) attrs
+          | Rinherit ct -> core_type ctxt f ct in
+        pp f "@[<2>[%a%a]@]"
+          (fun f l ->
+             match l, closed with
+             | [], Closed -> ()
+             | [], Open -> pp f ">" (* Cf #7200: print [>] correctly *)
+             | _ ->
+                 pp f "%s@;%a"
+                   (match (closed,low) with
+                    | (Closed,None) -> ""
+                    | (Closed,Some _) -> "<" (* FIXME desugar the syntax sugar*)
+                    | (Open,_) -> ">")
+                   (list type_variant_helper ~sep:"@;<1 -2>| ") l) l
+          (fun f low -> match low with
+             |Some [] |None -> ()
+             |Some xs ->
+                 pp f ">@ %a"
+                   (list string_quot) xs) low
+    | Ptyp_object (l, o) ->
+        let core_field_type f = function
+          | Otag (l, attrs, ct) ->
+            pp f "@[<hov2>%s: %a@ %a@ @]" l.txt
+              (core_type ctxt) ct (attributes ctxt) attrs (* Cf #7200 *)
+          | Oinherit ct ->
+            pp f "@[<hov2>%a@ @]" (core_type ctxt) ct
+        in
+        let field_var f = function
+          | Asttypes.Closed -> ()
+          | Asttypes.Open ->
+              match l with
+              | [] -> pp f ".."
+              | _ -> pp f " ;.."
+        in
+        pp f "@[<hov2><@ %a%a@ > @]" (list core_field_type ~sep:";") l
+          field_var o (* Cf #7200 *)
+    | Ptyp_class (li, l) ->   (*FIXME*)
+        pp f "@[<hov2>%a#%a@]"
+          (list (core_type ctxt) ~sep:"," ~first:"(" ~last:")") l
+          longident_loc li
+    | Ptyp_package (lid, cstrs) ->
+        let aux f (s, ct) =
+          pp f "type %a@ =@ %a" longident_loc s (core_type ctxt) ct  in
+        (match cstrs with
+         |[] -> pp f "@[<hov2>(module@ %a)@]" longident_loc lid
+         |_ ->
+             pp f "@[<hov2>(module@ %a@ with@ %a)@]" longident_loc lid
+               (list aux  ~sep:"@ and@ ")  cstrs)
+    | Ptyp_extension e -> extension ctxt f e
+    | _ -> paren true (core_type ctxt) f x
 
-    and iter_expression exp =
-      Iter.enter_expression exp;
-      List.iter (function (cstr, _, _attrs) ->
-        match cstr with
-          Texp_constraint ct ->
-            iter_core_type ct
-        | Texp_coerce (cty1, cty2) ->
-            option iter_core_type cty1; iter_core_type cty2
-        | Texp_open _ -> ()
-        | Texp_poly cto -> option iter_core_type cto
-        | Texp_newtype _ -> ())
-        exp.exp_extra;
-      begin
-        match exp.exp_desc with
-          Texp_ident _ -> ()
-        | Texp_constant _ -> ()
-        | Texp_let (rec_flag, list, exp) ->
-            iter_bindings rec_flag list;
-            iter_expression exp
-        | Texp_function { cases; _ } ->
-            iter_cases cases
-        | Texp_apply (exp, list) ->
-            iter_expression exp;
-            List.iter (fun (_label, expo) ->
-                match expo with
-                  None -> ()
-                | Some exp -> iter_expression exp
-            ) list
-        | Texp_match (exp, list1, list2, _) ->
-            iter_expression exp;
-            iter_cases list1;
-            iter_cases list2;
-        | Texp_try (exp, list) ->
-            iter_expression exp;
-            iter_cases list
-        | Texp_tuple list ->
-            List.iter iter_expression list
-        | Texp_construct (_, _, args) ->
-            List.iter iter_expression args
-        | Texp_variant (_label, expo) ->
-            begin match expo with
-                None -> ()
-              | Some exp -> iter_expression exp
-            end
-        | Texp_record { fields; extended_expression; _ } ->
-            Array.iter (function
-                | _, Kept _ -> ()
-                | _, Overridden (_, exp) -> iter_expression exp)
-              fields;
-            begin match extended_expression with
-                None -> ()
-              | Some exp -> iter_expression exp
-            end
-        | Texp_field (exp, _, _label) ->
-            iter_expression exp
-        | Texp_setfield (exp1, _, _label, exp2) ->
-            iter_expression exp1;
-            iter_expression exp2
-        | Texp_array list ->
-            List.iter iter_expression list
-        | Texp_ifthenelse (exp1, exp2, expo) ->
-            iter_expression exp1;
-            iter_expression exp2;
-            begin match expo with
-                None -> ()
-              | Some exp -> iter_expression exp
-            end
-        | Texp_sequence (exp1, exp2) ->
-            iter_expression exp1;
-            iter_expression exp2
-        | Texp_while (exp1, exp2) ->
-            iter_expression exp1;
-            iter_expression exp2
-        | Texp_for (_id, _, exp1, exp2, _dir, exp3) ->
-            iter_expression exp1;
-            iter_expression exp2;
-            iter_expression exp3
-        | Texp_send (exp, _meth, expo) ->
-            iter_expression exp;
-          begin
-            match expo with
-                None -> ()
-              | Some exp -> iter_expression exp
-          end
-        | Texp_new _ 
-        | Texp_instvar _ 
-        | Texp_setinstvar _ 
-        | Texp_override _ -> ()
-        | Texp_letmodule (_id, _, mexpr, exp) ->
-            iter_module_expr mexpr;
-            iter_expression exp
-        | Texp_letexception (cd, exp) ->
-            iter_extension_constructor cd;
-            iter_expression exp
-        | Texp_assert exp -> iter_expression exp
-        | Texp_lazy exp -> iter_expression exp
-        | Texp_object () ->
-            ()
-        | Texp_pack (mexpr) ->
-            iter_module_expr mexpr
-        | Texp_unreachable ->
-            ()
-        | Texp_extension_constructor _ ->
-            ()
-      end;
-      Iter.leave_expression exp;
+(********************pattern********************)
+(* be cautious when use [pattern], [pattern1] is preferred *)
+and pattern ctxt f x =
+  let rec list_of_pattern acc = function (* only consider ((A|B)|C)*)
+    | {ppat_desc= Ppat_or (p1,p2); ppat_attributes = []} ->
+        list_of_pattern  (p2::acc) p1
+    | x -> x::acc
+  in
+  if x.ppat_attributes <> [] then begin
+    pp f "((%a)%a)" (pattern ctxt) {x with ppat_attributes=[]}
+      (attributes ctxt) x.ppat_attributes
+  end
+  else match x.ppat_desc with
+    | Ppat_alias (p, s) ->
+        pp f "@[<2>%a@;as@;%a@]" (pattern ctxt) p protect_ident s.txt (* RA*)
+    | Ppat_or _ -> (* *)
+        pp f "@[<hov0>%a@]" (list ~sep:"@,|" (pattern ctxt))
+          (list_of_pattern [] x)
+    | _ -> pattern1 ctxt f x
 
-    and iter_package_type pack =
-      Iter.enter_package_type pack;
-      List.iter (fun (_s, ct) -> iter_core_type ct) pack.pack_fields;
-      Iter.leave_package_type pack;
+and pattern1 ctxt (f:Format.formatter) (x:pattern) : unit =
+  let rec pattern_list_helper f = function
+    | {ppat_desc =
+         Ppat_construct
+           ({ txt = Lident("::") ;_},
+            Some ({ppat_desc = Ppat_tuple([pat1; pat2]);_}));
+       ppat_attributes = []}
 
-    and iter_signature sg =
-      Iter.enter_signature sg;
-      List.iter iter_signature_item sg.sig_items;
-      Iter.leave_signature sg;
+      ->
+        pp f "%a::%a" (simple_pattern ctxt) pat1 pattern_list_helper pat2 (*RA*)
+    | p -> pattern1 ctxt f p
+  in
+  if x.ppat_attributes <> [] then pattern ctxt f x
+  else match x.ppat_desc with
+    | Ppat_variant (l, Some p) ->
+        pp f "@[<2>`%s@;%a@]" l (simple_pattern ctxt) p
+    | Ppat_construct (({txt=Lident("()"|"[]");_}), _) -> simple_pattern ctxt f x
+    | Ppat_construct (({txt;_} as li), po) ->
+        (* FIXME The third field always false *)
+        if txt = Lident "::" then
+          pp f "%a" pattern_list_helper x
+        else
+          (match po with
+           | Some x -> pp f "%a@;%a"  longident_loc li (simple_pattern ctxt) x
+           | None -> pp f "%a" longident_loc li)
+    | _ -> simple_pattern ctxt f x
 
-    and iter_signature_item item =
-      Iter.enter_signature_item item;
-      begin
-        match item.sig_desc with
-          Tsig_value vd ->
-            iter_value_description vd
-        | Tsig_type (rf, list) ->
-            iter_type_declarations rf list
-        | Tsig_exception ext ->
-            iter_extension_constructor ext
-        | Tsig_typext tyext ->
-            iter_type_extension tyext
-        | Tsig_module md ->
-            iter_module_type md.md_type
-        | Tsig_recmodule list ->
-            List.iter (fun md -> iter_module_type md.md_type) list
-        | Tsig_modtype mtd ->
-            iter_module_type_declaration mtd
-        | Tsig_open _ -> ()
-        | Tsig_include incl -> iter_module_type incl.incl_mod
-        | Tsig_class () -> ()
-        | Tsig_class_type list ->
-            List.iter iter_class_type_declaration list
-        | Tsig_attribute _ -> ()
-      end;
+and simple_pattern ctxt (f:Format.formatter) (x:pattern) : unit =
+  if x.ppat_attributes <> [] then pattern ctxt f x
+  else match x.ppat_desc with
+    | Ppat_construct (({txt=Lident ("()"|"[]" as x);_}), _) -> pp f  "%s" x
+    | Ppat_any -> pp f "_";
+    | Ppat_var ({txt = txt;_}) -> protect_ident f txt
+    | Ppat_array l ->
+        pp f "@[<2>[|%a|]@]"  (list (pattern1 ctxt) ~sep:";") l
+    | Ppat_unpack (s) ->
+        pp f "(module@ %s)@ " s.txt
+    | Ppat_type li ->
+        pp f "#%a" longident_loc li
+    | Ppat_record (l, closed) ->
+        let longident_x_pattern f (li, p) =
+          match (li,p) with
+          | ({txt=Lident s;_ },
+             {ppat_desc=Ppat_var {txt;_};
+              ppat_attributes=[]; _})
+            when s = txt ->
+              pp f "@[<2>%a@]"  longident_loc li
+          | _ ->
+              pp f "@[<2>%a@;=@;%a@]" longident_loc li (pattern1 ctxt) p
+        in
+        begin match closed with
+        | Closed ->
+            pp f "@[<2>{@;%a@;}@]" (list longident_x_pattern ~sep:";@;") l
+        | _ ->
+            pp f "@[<2>{@;%a;_}@]" (list longident_x_pattern ~sep:";@;") l
+        end
+    | Ppat_tuple l ->
+        pp f "@[<1>(%a)@]" (list  ~sep:",@;" (pattern1 ctxt))  l (* level1*)
+    | Ppat_constant (c) -> pp f "%a" constant c
+    | Ppat_interval (c1, c2) -> pp f "%a..%a" constant c1 constant c2
+    | Ppat_variant (l,None) ->  pp f "`%s" l
+    | Ppat_constraint (p, ct) ->
+        pp f "@[<2>(%a@;:@;%a)@]" (pattern1 ctxt) p (core_type ctxt) ct
+    | Ppat_lazy p ->
+        pp f "@[<2>(lazy@;%a)@]" (pattern1 ctxt) p
+    | Ppat_exception p ->
+        pp f "@[<2>exception@;%a@]" (pattern1 ctxt) p
+    | Ppat_extension e -> extension ctxt f e
+    | Ppat_open (lid, p) ->
+        let with_paren =
+        match p.ppat_desc with
+        | Ppat_array _ | Ppat_record _
+        | Ppat_construct (({txt=Lident ("()"|"[]");_}), _) -> false
+        | _ -> true in
+        pp f "@[<2>%a.%a @]" longident_loc lid
+          (paren with_paren @@ pattern1 ctxt) p
+    | _ -> paren true (pattern ctxt) f x
+
+and label_exp ctxt f (l,opt,p) =
+  match l with
+  | Nolabel ->
+      (* single case pattern parens needed here *)
+      pp f "%a@ " (simple_pattern ctxt) p
+  | Optional rest ->
+      begin match p with
+      | {ppat_desc = Ppat_var {txt;_}; ppat_attributes = []}
+        when txt = rest ->
+          (match opt with
+           | Some o -> pp f "?(%s=@;%a)@;" rest  (expression ctxt) o
+           | None -> pp f "?%s@ " rest)
+      | _ ->
+          (match opt with
+           | Some o ->
+               pp f "?%s:(%a=@;%a)@;"
+                 rest (pattern1 ctxt) p (expression ctxt) o
+           | None -> pp f "?%s:%a@;" rest (simple_pattern ctxt) p)
+      end
+  | Labelled l -> match p with
+    | {ppat_desc  = Ppat_var {txt;_}; ppat_attributes = []}
+      when txt = l ->
+        pp f "~%s@;" l
+    | _ ->  pp f "~%s:%a@;" l (simple_pattern ctxt) p
+
+and sugar_expr ctxt f e =
+  if e.pexp_attributes <> [] then false
+  else match e.pexp_desc with
+  | Pexp_apply ({ pexp_desc = Pexp_ident {txt = id; _};
+                  pexp_attributes=[]; _}, args)
+    when List.for_all (fun (lab, _) -> lab = Nolabel) args -> begin
+      let print_indexop a path_prefix assign left right print_index indices
+          rem_args =
+        let print_path ppf = function
+          | None -> ()
+          | Some m -> pp ppf ".%a" longident m in
+        match assign, rem_args with
+            | false, [] ->
+              pp f "@[%a%a%s%a%s@]"
+                (simple_expr ctxt) a print_path path_prefix
+                left (list ~sep:"," print_index) indices right; true
+            | true, [v] ->
+              pp f "@[%a%a%s%a%s@ <-@;<1 2>%a@]"
+                (simple_expr ctxt) a print_path path_prefix
+                left (list ~sep:"," print_index) indices right
+                (simple_expr ctxt) v; true
+            | _ -> false in
+      match id, List.map snd args with
+      | Lident "!", [e] ->
+        pp f "@[<hov>!%a@]" (simple_expr ctxt) e; true
+      | Ldot (path, ("get"|"set" as func)), a :: other_args -> begin
+          let assign = func = "set" in
+          let print = print_indexop a None assign in
+          match path, other_args with
+          | Lident "Array", i :: rest ->
+            print ".(" ")" (expression ctxt) [i] rest
+          | Lident "String", i :: rest ->
+            print ".[" "]" (expression ctxt) [i] rest
+          | Ldot (Lident "Bigarray", "Array1"), i1 :: rest ->
+            print ".{" "}" (simple_expr ctxt) [i1] rest
+          | Ldot (Lident "Bigarray", "Array2"), i1 :: i2 :: rest ->
+            print ".{" "}" (simple_expr ctxt) [i1; i2] rest
+          | Ldot (Lident "Bigarray", "Array3"), i1 :: i2 :: i3 :: rest ->
+            print ".{" "}" (simple_expr ctxt) [i1; i2; i3] rest
+          | Ldot (Lident "Bigarray", "Genarray"),
+            {pexp_desc = Pexp_array indexes; pexp_attributes = []} :: rest ->
+              print ".{" "}" (simple_expr ctxt) indexes rest
+          | _ -> false
+        end
+      | (Lident s | Ldot(_,s)) , a :: i :: rest
+        when s.[0] = '.' ->
+          let n = String.length s in
+          (* extract operator:
+             assignment operators end with [right_bracket ^ "<-"],
+             access operators end with [right_bracket] directly
+          *)
+          let assign = s.[n - 1] = '-'  in
+          let kind =
+            (* extract the right end bracket *)
+            if assign then s.[n - 3] else s.[n - 1] in
+          let left, right = match kind with
+            | ')' -> '(', ")"
+            | ']' -> '[', "]"
+            | '}' -> '{', "}"
+            | _ -> assert false in
+          let path_prefix = match id with
+            | Ldot(m,_) -> Some m
+            | _ -> None in
+          let left = String.sub s 0 (1+String.index s left) in
+          print_indexop a path_prefix assign left right
+            (expression ctxt) [i] rest
+      | _ -> false
+    end
+  | _ -> false
+
+and expression ctxt f x =
+  if x.pexp_attributes <> [] then
+    pp f "((%a)@,%a)" (expression ctxt) {x with pexp_attributes=[]}
+      (attributes ctxt) x.pexp_attributes
+  else match x.pexp_desc with
+    | Pexp_function _ | Pexp_fun _ | Pexp_match _ | Pexp_try _ | Pexp_sequence _
+      when ctxt.pipe || ctxt.semi ->
+        paren true (expression reset_ctxt) f x
+    | Pexp_ifthenelse _ | Pexp_sequence _ when ctxt.ifthenelse ->
+        paren true (expression reset_ctxt) f x
+    | Pexp_let _ | Pexp_letmodule _ | Pexp_open _ | Pexp_letexception _
+        when ctxt.semi ->
+        paren true (expression reset_ctxt) f x
+    | Pexp_fun (l, e0, p, e) ->
+        pp f "@[<2>fun@;%a->@;%a@]"
+          (label_exp ctxt) (l, e0, p)
+          (expression ctxt) e
+    | Pexp_function l ->
+        pp f "@[<hv>function%a@]" (case_list ctxt) l
+    | Pexp_match (e, l) ->
+        pp f "@[<hv0>@[<hv0>@[<2>match %a@]@ with@]%a@]"
+          (expression reset_ctxt) e (case_list ctxt) l
+
+    | Pexp_try (e, l) ->
+        pp f "@[<0>@[<hv2>try@ %a@]@ @[<0>with%a@]@]"
+             (* "try@;@[<2>%a@]@\nwith@\n%a"*)
+          (expression reset_ctxt) e  (case_list ctxt) l
+    | Pexp_let (rf, l, e) ->
+        (* pp f "@[<2>let %a%a in@;<1 -2>%a@]"
+           (*no indentation here, a new line*) *)
+        (*   rec_flag rf *)
+        pp f "@[<2>%a in@;<1 -2>%a@]"
+          (bindings reset_ctxt) (rf,l)
+          (expression ctxt) e
+    | Pexp_apply (e, l) ->
+        begin if not (sugar_expr ctxt f x) then
+            match view_fixity_of_exp e with
+            | `Infix s ->
+                begin match l with
+                | [ (Nolabel, _) as arg1; (Nolabel, _) as arg2 ] ->
+                    (* FIXME associativity label_x_expression_param *)
+                    pp f "@[<2>%a@;%s@;%a@]"
+                      (label_x_expression_param reset_ctxt) arg1 s
+                      (label_x_expression_param ctxt) arg2
+                | _ ->
+                    pp f "@[<2>%a %a@]"
+                      (simple_expr ctxt) e
+                      (list (label_x_expression_param ctxt)) l
+                end
+            | `Prefix s ->
+                let s =
+                  if List.mem s ["~+";"~-";"~+.";"~-."] &&
+                   (match l with
+                    (* See #7200: avoid turning (~- 1) into (- 1) which is
+                       parsed as an int literal *)
+                    |[(_,{pexp_desc=Pexp_constant _})] -> false
+                    | _ -> true)
+                  then String.sub s 1 (String.length s -1)
+                  else s in
+                begin match l with
+                | [(Nolabel, x)] ->
+                  pp f "@[<2>%s@;%a@]" s (simple_expr ctxt) x
+                | _   ->
+                  pp f "@[<2>%a %a@]" (simple_expr ctxt) e
+                    (list (label_x_expression_param ctxt)) l
+                end
+            | _ ->
+                pp f "@[<hov2>%a@]" begin fun f (e,l) ->
+                  pp f "%a@ %a" (expression2 ctxt) e
+                    (list (label_x_expression_param reset_ctxt))  l
+                    (* reset here only because [function,match,try,sequence]
+                       are lower priority *)
+                end (e,l)
+        end
+
+    | Pexp_construct (li, Some eo)
+      when not (is_simple_construct (view_expr x))-> (* Not efficient FIXME*)
+        (match view_expr x with
+         | `cons ls -> list (simple_expr ctxt) f ls ~sep:"@;::@;"
+         | `normal ->
+             pp f "@[<2>%a@;%a@]" longident_loc li
+               (simple_expr ctxt) eo
+         | _ -> assert false)
+    | Pexp_setfield (e1, li, e2) ->
+        pp f "@[<2>%a.%a@ <-@ %a@]"
+          (simple_expr ctxt) e1 longident_loc li (simple_expr ctxt) e2
+    | Pexp_ifthenelse (e1, e2, eo) ->
+        (* @;@[<2>else@ %a@]@] *)
+        let fmt:(_,_,_)format ="@[<hv0>@[<2>if@ %a@]@;@[<2>then@ %a@]%a@]" in
+        let expression_under_ifthenelse = expression (under_ifthenelse ctxt) in
+        pp f fmt expression_under_ifthenelse e1 expression_under_ifthenelse e2
+          (fun f eo -> match eo with
+             | Some x ->
+                 pp f "@;@[<2>else@;%a@]" (expression (under_semi ctxt)) x
+             | None -> () (* pp f "()" *)) eo
+    | Pexp_sequence _ ->
+        let rec sequence_helper acc = function
+          | {pexp_desc=Pexp_sequence(e1,e2); pexp_attributes = []} ->
+              sequence_helper (e1::acc) e2
+          | v -> List.rev (v::acc) in
+        let lst = sequence_helper [] x in
+        pp f "@[<hv>%a@]"
+          (list (expression (under_semi ctxt)) ~sep:";@;") lst
+    | Pexp_new (li) ->
+        pp f "@[<hov2>new@ %a@]" longident_loc li;
+    | Pexp_setinstvar (s, e) ->
+        pp f "@[<hov2>%s@ <-@ %a@]" s.txt (expression ctxt) e
+    | Pexp_override l -> (* FIXME *)
+        let string_x_expression f (s, e) =
+          pp f "@[<hov2>%s@ =@ %a@]" s.txt (expression ctxt) e in
+        pp f "@[<hov2>{<%a>}@]"
+          (list string_x_expression  ~sep:";"  )  l;
+    | Pexp_letmodule (s, me, e) ->
+        pp f "@[<hov2>let@ module@ %s@ =@ %a@ in@ %a@]" s.txt
+          (module_expr reset_ctxt) me (expression ctxt) e
+    | Pexp_letexception (cd, e) ->
+        pp f "@[<hov2>let@ exception@ %a@ in@ %a@]"
+          (extension_constructor ctxt) cd
+          (expression ctxt) e
+    | Pexp_assert e ->
+        pp f "@[<hov2>assert@ %a@]" (simple_expr ctxt) e
+    | Pexp_lazy (e) ->
+        pp f "@[<hov2>lazy@ %a@]" (simple_expr ctxt) e
+    (* Pexp_poly: impossible but we should print it anyway, rather than
+       assert false *)
+    | Pexp_poly (e, None) ->
+        pp f "@[<hov2>!poly!@ %a@]" (simple_expr ctxt) e
+    | Pexp_poly (e, Some ct) ->
+        pp f "@[<hov2>(!poly!@ %a@ : %a)@]"
+          (simple_expr ctxt) e (core_type ctxt) ct
+    | Pexp_open (ovf, lid, e) ->
+        pp f "@[<2>let open%s %a in@;%a@]" (override ovf) longident_loc lid
+          (expression ctxt) e
+    | Pexp_variant (l,Some eo) ->
+        pp f "@[<2>`%s@;%a@]" l (simple_expr ctxt) eo
+    | Pexp_extension e -> extension ctxt f e
+    | Pexp_unreachable -> pp f "."
+    | _ -> expression1 ctxt f x
+
+and expression1 ctxt f x =
+  if x.pexp_attributes <> [] then expression ctxt f x
+  else match x.pexp_desc with
+    | Pexp_object cs -> pp f "%a" (class_structure ctxt) cs
+    | _ -> expression2 ctxt f x
+(* used in [Pexp_apply] *)
+
+and expression2 ctxt f x =
+  if x.pexp_attributes <> [] then expression ctxt f x
+  else match x.pexp_desc with
+    | Pexp_field (e, li) ->
+        pp f "@[<hov2>%a.%a@]" (simple_expr ctxt) e longident_loc li
+    | Pexp_send (e, s) -> pp f "@[<hov2>%a#%s@]" (simple_expr ctxt) e s.txt
+
+    | _ -> simple_expr ctxt f x
+
+and simple_expr ctxt f x =
+  if x.pexp_attributes <> [] then expression ctxt f x
+  else match x.pexp_desc with
+    | Pexp_construct _  when is_simple_construct (view_expr x) ->
+        (match view_expr x with
+         | `nil -> pp f "[]"
+         | `tuple -> pp f "()"
+         | `list xs ->
+             pp f "@[<hv0>[%a]@]"
+               (list (expression (under_semi ctxt)) ~sep:";@;") xs
+         | `simple x -> longident f x
+         | _ -> assert false)
+    | Pexp_ident li ->
+        longident_loc f li
+    (* (match view_fixity_of_exp x with *)
+    (* |`Normal -> longident_loc f li *)
+    (* | `Prefix _ | `Infix _ -> pp f "( %a )" longident_loc li) *)
+    | Pexp_constant c -> constant f c;
+    | Pexp_pack me ->
+        pp f "(module@;%a)" (module_expr ctxt) me
+    | Pexp_newtype (lid, e) ->
+        pp f "fun@;(type@;%s)@;->@;%a" lid.txt (expression ctxt) e
+    | Pexp_tuple l ->
+        pp f "@[<hov2>(%a)@]" (list (simple_expr ctxt) ~sep:",@;") l
+    | Pexp_constraint (e, ct) ->
+        pp f "(%a : %a)" (expression ctxt) e (core_type ctxt) ct
+    | Pexp_coerce (e, cto1, ct) ->
+        pp f "(%a%a :> %a)" (expression ctxt) e
+          (option (core_type ctxt) ~first:" : " ~last:" ") cto1 (* no sep hint*)
+          (core_type ctxt) ct
+    | Pexp_variant (l, None) -> pp f "`%s" l
+    | Pexp_record (l, eo) ->
+        let longident_x_expression f ( li, e) =
+          match e with
+          |  {pexp_desc=Pexp_ident {txt;_};
+              pexp_attributes=[]; _} when li.txt = txt ->
+              pp f "@[<hov2>%a@]" longident_loc li
+          | _ ->
+              pp f "@[<hov2>%a@;=@;%a@]" longident_loc li (simple_expr ctxt) e
+        in
+        pp f "@[<hv0>@[<hv2>{@;%a%a@]@;}@]"(* "@[<hov2>{%a%a}@]" *)
+          (option ~last:" with@;" (simple_expr ctxt)) eo
+          (list longident_x_expression ~sep:";@;") l
+    | Pexp_array (l) ->
+        pp f "@[<0>@[<2>[|%a|]@]@]"
+          (list (simple_expr (under_semi ctxt)) ~sep:";") l
+    | Pexp_while (e1, e2) ->
+        let fmt : (_,_,_) format = "@[<2>while@;%a@;do@;%a@;done@]" in
+        pp f fmt (expression ctxt) e1 (expression ctxt) e2
+    | Pexp_for (s, e1, e2, df, e3) ->
+        let fmt:(_,_,_)format =
+          "@[<hv0>@[<hv2>@[<2>for %a =@;%a@;%a%a@;do@]@;%a@]@;done@]" in
+        let expression = expression ctxt in
+        pp f fmt (pattern ctxt) s expression e1 direction_flag
+          df expression e2 expression e3
+    | _ ->  paren true (expression ctxt) f x
+
+and attributes ctxt f l =
+  List.iter (attribute ctxt f) l
+
+and item_attributes ctxt f l =
+  List.iter (item_attribute ctxt f) l
+
+and attribute ctxt f (s, e) =
+  pp f "@[<2>[@@%s@ %a]@]" s.txt (payload ctxt) e
+
+and item_attribute ctxt f (s, e) =
+  pp f "@[<2>[@@@@%s@ %a]@]" s.txt (payload ctxt) e
+
+and floating_attribute ctxt f (s, e) =
+  pp f "@[<2>[@@@@@@%s@ %a]@]" s.txt (payload ctxt) e
+
+and value_description ctxt f x =
+  (* note: value_description has an attribute field,
+           but they're already printed by the callers this method *)
+  pp f "@[<hov2>%a%a@]" (core_type ctxt) x.pval_type
+    (fun f x ->
+        
+       if x.pval_prim <> []
+       then pp f "@ =@ %a" (list constant_string) x.pval_prim
+
+    ) x
+
+and extension ctxt f (s, e) =
+  pp f "@[<2>[%%%s@ %a]@]" s.txt (payload ctxt) e
+
+and item_extension ctxt f (s, e) =
+  pp f "@[<2>[%%%%%s@ %a]@]" s.txt (payload ctxt) e
+
+and exception_declaration ctxt f ext =
+  pp f "@[<hov2>exception@ %a@]" (extension_constructor ctxt) ext
+
+and class_signature ctxt f { pcsig_self = ct; pcsig_fields = l ;_} =
+  let class_type_field f x =
+    match x.pctf_desc with
+    | Pctf_inherit (ct) ->
+        pp f "@[<2>inherit@ %a@]%a" (class_type ctxt) ct
+          (item_attributes ctxt) x.pctf_attributes
+    | Pctf_val (s, mf, vf, ct) ->
+        pp f "@[<2>val @ %a%a%s@ :@ %a@]%a"
+          mutable_flag mf virtual_flag vf s.txt (core_type ctxt) ct
+          (item_attributes ctxt) x.pctf_attributes
+    | Pctf_method (s, pf, vf, ct) ->
+        pp f "@[<2>method %a %a%s :@;%a@]%a"
+          private_flag pf virtual_flag vf s.txt (core_type ctxt) ct
+          (item_attributes ctxt) x.pctf_attributes
+    | Pctf_constraint (ct1, ct2) ->
+        pp f "@[<2>constraint@ %a@ =@ %a@]%a"
+          (core_type ctxt) ct1 (core_type ctxt) ct2
+          (item_attributes ctxt) x.pctf_attributes
+    | Pctf_attribute a -> floating_attribute ctxt f a
+    | Pctf_extension e ->
+        item_extension ctxt f e;
+        item_attributes ctxt f x.pctf_attributes
+  in
+  pp f "@[<hv0>@[<hv2>object@[<1>%a@]@ %a@]@ end@]"
+    (fun f -> function
+         {ptyp_desc=Ptyp_any; ptyp_attributes=[]; _} -> ()
+       | ct -> pp f " (%a)" (core_type ctxt) ct) ct
+    (list class_type_field ~sep:"@;") l
+
+(* call [class_signature] called by [class_signature] *)
+and class_type ctxt f x =
+  match x.pcty_desc with
+  | Pcty_signature cs ->
+      class_signature ctxt f cs;
+      attributes ctxt f x.pcty_attributes
+  | Pcty_constr (li, l) ->
+      pp f "%a%a%a"
+        (fun f l -> match l with
+           | [] -> ()
+           | _  -> pp f "[%a]@ " (list (core_type ctxt) ~sep:"," ) l) l
+        longident_loc li
+        (attributes ctxt) x.pcty_attributes
+  | Pcty_arrow (l, co, cl) ->
+      pp f "@[<2>%a@;->@;%a@]" (* FIXME remove parens later *)
+        (type_with_label ctxt) (l,co)
+        (class_type ctxt) cl
+  | Pcty_extension e ->
+      extension ctxt f e;
+      attributes ctxt f x.pcty_attributes
+  | Pcty_open (ovf, lid, e) ->
+      pp f "@[<2>let open%s %a in@;%a@]" (override ovf) longident_loc lid
+        (class_type ctxt) e
+
+(* [class type a = object end] *)
+and class_type_declaration_list ctxt f l =
+  let class_type_declaration kwd f x =
+    let { pci_params=ls; pci_name={ txt; _ }; _ } = x in
+    pp f "@[<2>%s %a%a%s@ =@ %a@]%a" kwd
+      virtual_flag x.pci_virt
+      (class_params_def ctxt) ls txt
+      (class_type ctxt) x.pci_expr
+      (item_attributes ctxt) x.pci_attributes
+  in
+  match l with
+  | [] -> ()
+  | [x] -> class_type_declaration "class type" f x
+  | x :: xs ->
+      pp f "@[<v>%a@,%a@]"
+        (class_type_declaration "class type") x
+        (list ~sep:"@," (class_type_declaration "and")) xs
+
+and class_field ctxt f x =
+  match x.pcf_desc with
+  | Pcf_inherit () -> ()  
+  | Pcf_val (s, mf, Cfk_concrete (ovf, e)) ->
+      pp f "@[<2>val%s %a%s =@;%a@]%a" (override ovf)
+        mutable_flag mf s.txt
+        (expression ctxt) e
+        (item_attributes ctxt) x.pcf_attributes
+  | Pcf_method (s, pf, Cfk_virtual ct) ->
+      pp f "@[<2>method virtual %a %s :@;%a@]%a"
+        private_flag pf s.txt
+        (core_type ctxt) ct
+        (item_attributes ctxt) x.pcf_attributes
+  | Pcf_val (s, mf, Cfk_virtual ct) ->
+      pp f "@[<2>val virtual %a%s :@ %a@]%a"
+        mutable_flag mf s.txt
+        (core_type ctxt) ct
+        (item_attributes ctxt) x.pcf_attributes
+  | Pcf_method (s, pf, Cfk_concrete (ovf, e)) ->
+      let bind e =
+        binding ctxt f
+          {pvb_pat=
+             {ppat_desc=Ppat_var s;ppat_loc=Location.none;ppat_attributes=[]};
+           pvb_expr=e;
+           pvb_attributes=[];
+           pvb_loc=Location.none;
+          }
+      in
+      pp f "@[<2>method%s %a%a@]%a"
+        (override ovf)
+        private_flag pf
+        (fun f -> function
+           | {pexp_desc=Pexp_poly (e, Some ct); pexp_attributes=[]; _} ->
+               pp f "%s :@;%a=@;%a"
+                 s.txt (core_type ctxt) ct (expression ctxt) e
+           | {pexp_desc=Pexp_poly (e, None); pexp_attributes=[]; _} ->
+               bind e
+           | _ -> bind e) e
+        (item_attributes ctxt) x.pcf_attributes
+  | Pcf_constraint (ct1, ct2) ->
+      pp f "@[<2>constraint %a =@;%a@]%a"
+        (core_type ctxt) ct1
+        (core_type ctxt) ct2
+        (item_attributes ctxt) x.pcf_attributes
+  | Pcf_initializer (e) ->
+      pp f "@[<2>initializer@ %a@]%a"
+        (expression ctxt) e
+        (item_attributes ctxt) x.pcf_attributes
+  | Pcf_attribute a -> floating_attribute ctxt f a
+  | Pcf_extension e ->
+      item_extension ctxt f e;
+      item_attributes ctxt f x.pcf_attributes
+
+and class_structure ctxt f { pcstr_self = p; pcstr_fields =  l } =
+  pp f "@[<hv0>@[<hv2>object%a@;%a@]@;end@]"
+    (fun f p -> match p.ppat_desc with
+       | Ppat_any -> ()
+       | Ppat_constraint _ -> pp f " %a" (pattern ctxt) p
+       | _ -> pp f " (%a)" (pattern ctxt) p) p
+    (list (class_field ctxt)) l
+
+and module_type ctxt f x =
+  if x.pmty_attributes <> [] then begin
+    pp f "((%a)%a)" (module_type ctxt) {x with pmty_attributes=[]}
+      (attributes ctxt) x.pmty_attributes
+  end else
+    match x.pmty_desc with
+    | Pmty_ident li ->
+        pp f "%a" longident_loc li;
+    | Pmty_alias li ->
+        pp f "(module %a)" longident_loc li;
+    | Pmty_signature (s) ->
+        pp f "@[<hv0>@[<hv2>sig@ %a@]@ end@]" (* "@[<hov>sig@ %a@ end@]" *)
+          (list (signature_item ctxt)) s (* FIXME wrong indentation*)
+    | Pmty_functor (_, None, mt2) ->
+        pp f "@[<hov2>functor () ->@ %a@]" (module_type ctxt) mt2
+    | Pmty_functor (s, Some mt1, mt2) ->
+        if s.txt = "_" then
+          pp f "@[<hov2>%a@ ->@ %a@]"
+            (module_type ctxt) mt1 (module_type ctxt) mt2
+        else
+          pp f "@[<hov2>functor@ (%s@ :@ %a)@ ->@ %a@]" s.txt
+            (module_type ctxt) mt1 (module_type ctxt) mt2
+    | Pmty_with (mt, l) ->
+        let with_constraint f = function
+          | Pwith_type (li, ({ptype_params= ls ;_} as td)) ->
+              let ls = List.map fst ls in
+              pp f "type@ %a %a =@ %a"
+                (list (core_type ctxt) ~sep:"," ~first:"(" ~last:")")
+                ls longident_loc li (type_declaration ctxt) td
+          | Pwith_module (li, li2) ->
+              pp f "module %a =@ %a" longident_loc li longident_loc li2;
+          | Pwith_typesubst (li, ({ptype_params=ls;_} as td)) ->
+              let ls = List.map fst ls in
+              pp f "type@ %a %a :=@ %a"
+                (list (core_type ctxt) ~sep:"," ~first:"(" ~last:")")
+                ls longident_loc li
+                (type_declaration ctxt) td
+          | Pwith_modsubst (li, li2) ->
+             pp f "module %a :=@ %a" longident_loc li longident_loc li2 in
+        (match l with
+         | [] -> pp f "@[<hov2>%a@]" (module_type ctxt) mt
+         | _ -> pp f "@[<hov2>(%a@ with@ %a)@]"
+                  (module_type ctxt) mt (list with_constraint ~sep:"@ and@ ") l)
+    | Pmty_typeof me ->
+        pp f "@[<hov2>module@ type@ of@ %a@]" (module_expr ctxt) me
+    | Pmty_extension e -> extension ctxt f e
+
+and signature ctxt f x =  list ~sep:"@\n" (signature_item ctxt) f x
+
+and signature_item ctxt f x : unit =
+  match x.psig_desc with
+  | Psig_type (rf, l) ->
+      type_def_list ctxt f (rf, l)
+  | Psig_value vd ->
+      let intro = if vd.pval_prim = [] then "val" else "external" in
+      pp f "@[<2>%s@ %a@ :@ %a@]%a" intro
+        protect_ident vd.pval_name.txt
+        (value_description ctxt) vd
+        (item_attributes ctxt) vd.pval_attributes
+  | Psig_typext te ->
+      type_extension ctxt f te
+  | Psig_exception ed ->
+      exception_declaration ctxt f ed
+  | Psig_class () ->
+    ()
+  | Psig_module ({pmd_type={pmty_desc=Pmty_alias alias;
+                            pmty_attributes=[]; _};_} as pmd) ->
+      pp f "@[<hov>module@ %s@ =@ %a@]%a" pmd.pmd_name.txt
+        longident_loc alias
+        (item_attributes ctxt) pmd.pmd_attributes
+  | Psig_module pmd ->
+      pp f "@[<hov>module@ %s@ :@ %a@]%a"
+        pmd.pmd_name.txt
+        (module_type ctxt) pmd.pmd_type
+        (item_attributes ctxt) pmd.pmd_attributes
+  | Psig_open od ->
+      pp f "@[<hov2>open%s@ %a@]%a"
+        (override od.popen_override)
+        longident_loc od.popen_lid
+        (item_attributes ctxt) od.popen_attributes
+  | Psig_include incl ->
+      pp f "@[<hov2>include@ %a@]%a"
+        (module_type ctxt) incl.pincl_mod
+        (item_attributes ctxt) incl.pincl_attributes
+  | Psig_modtype {pmtd_name=s; pmtd_type=md; pmtd_attributes=attrs} ->
+      pp f "@[<hov2>module@ type@ %s%a@]%a"
+        s.txt
+        (fun f md -> match md with
+           | None -> ()
+           | Some mt ->
+               pp_print_space f () ;
+               pp f "@ =@ %a" (module_type ctxt) mt
+        ) md
+        (item_attributes ctxt) attrs
+  | Psig_class_type (l) -> class_type_declaration_list ctxt f l
+  | Psig_recmodule decls ->
+      let rec  string_x_module_type_list f ?(first=true) l =
+        match l with
+        | [] -> () ;
+        | pmd :: tl ->
+            if not first then
+              pp f "@ @[<hov2>and@ %s:@ %a@]%a" pmd.pmd_name.txt
+                (module_type ctxt) pmd.pmd_type
+                (item_attributes ctxt) pmd.pmd_attributes
+            else
+              pp f "@[<hov2>module@ rec@ %s:@ %a@]%a" pmd.pmd_name.txt
+                (module_type ctxt) pmd.pmd_type
+                (item_attributes ctxt) pmd.pmd_attributes;
+            string_x_module_type_list f ~first:false tl
+      in
+      string_x_module_type_list f decls
+  | Psig_attribute a -> floating_attribute ctxt f a
+  | Psig_extension(e, a) ->
+      item_extension ctxt f e;
+      item_attributes ctxt f a
+
+and module_expr ctxt f x =
+  if x.pmod_attributes <> [] then
+    pp f "((%a)%a)" (module_expr ctxt) {x with pmod_attributes=[]}
+      (attributes ctxt) x.pmod_attributes
+  else match x.pmod_desc with
+    | Pmod_structure (s) ->
+        pp f "@[<hv2>struct@;@[<0>%a@]@;<1 -2>end@]"
+          (list (structure_item ctxt) ~sep:"@\n") s;
+    | Pmod_constraint (me, mt) ->
+        pp f "@[<hov2>(%a@ :@ %a)@]"
+          (module_expr ctxt) me
+          (module_type ctxt) mt
+    | Pmod_ident (li) ->
+        pp f "%a" longident_loc li;
+    | Pmod_functor (_, None, me) ->
+        pp f "functor ()@;->@;%a" (module_expr ctxt) me
+    | Pmod_functor (s, Some mt, me) ->
+        pp f "functor@ (%s@ :@ %a)@;->@;%a"
+          s.txt (module_type ctxt) mt (module_expr ctxt) me
+    | Pmod_apply (me1, me2) ->
+        pp f "(%a)(%a)" (module_expr ctxt) me1 (module_expr ctxt) me2
+        (* Cf: #7200 *)
+    | Pmod_unpack e ->
+        pp f "(val@ %a)" (expression ctxt) e
+    | Pmod_extension e -> extension ctxt f e
+
+and structure ctxt f x = list ~sep:"@\n" (structure_item ctxt) f x
+
+and payload ctxt f = function
+  | PStr [{pstr_desc = Pstr_eval (e, attrs)}] ->
+      pp f "@[<2>%a@]%a"
+        (expression ctxt) e
+        (item_attributes ctxt) attrs
+  | PStr x -> structure ctxt f x
+  | PTyp x -> pp f ":"; core_type ctxt f x
+  | PSig x -> pp f ":"; signature ctxt f x
+  | PPat (x, None) -> pp f "?"; pattern ctxt f x
+  | PPat (x, Some e) ->
+      pp f "?"; pattern ctxt f x;
+      pp f " when "; expression ctxt f e
+
+(* transform [f = fun g h -> ..] to [f g h = ... ] could be improved *)
+and binding ctxt f {pvb_pat=p; pvb_expr=x; _} =
+  (* .pvb_attributes have already been printed by the caller, #bindings *)
+  let rec pp_print_pexp_function f x =
+    if x.pexp_attributes <> [] then pp f "=@;%a" (expression ctxt) x
+    else match x.pexp_desc with
+      | Pexp_fun (label, eo, p, e) ->
+          if label=Nolabel then
+            pp f "%a@ %a" (simple_pattern ctxt) p pp_print_pexp_function e
+          else
+            pp f "%a@ %a"
+              (label_exp ctxt) (label,eo,p) pp_print_pexp_function e
+      | Pexp_newtype (str,e) ->
+          pp f "(type@ %s)@ %a" str.txt pp_print_pexp_function e
+      | _ -> pp f "=@;%a" (expression ctxt) x
+  in
+  let tyvars_str tyvars = List.map (fun v -> v.txt) tyvars in
+  let is_desugared_gadt p e =
+    let gadt_pattern =
+      match p with
+      | {ppat_desc=Ppat_constraint({ppat_desc=Ppat_var _} as pat,
+                                   {ptyp_desc=Ptyp_poly (args_tyvars, rt)});
+         ppat_attributes=[]}->
+          Some (pat, args_tyvars, rt)
+      | _ -> None in
+    let rec gadt_exp tyvars e =
+      match e with
+      | {pexp_desc=Pexp_newtype (tyvar, e); pexp_attributes=[]} ->
+          gadt_exp (tyvar :: tyvars) e
+      | {pexp_desc=Pexp_constraint (e, ct); pexp_attributes=[]} ->
+          Some (List.rev tyvars, e, ct)
+      | _ -> None in
+    let gadt_exp = gadt_exp [] e in
+    match gadt_pattern, gadt_exp with
+    | Some (p, pt_tyvars, pt_ct), Some (e_tyvars, e, e_ct)
+      when tyvars_str pt_tyvars = tyvars_str e_tyvars ->
+      let ety = Typ.varify_constructors e_tyvars e_ct in
+      if ety = pt_ct then
+      Some (p, pt_tyvars, e_ct, e) else None
+    | _ -> None in
+  if x.pexp_attributes <> []
+  then pp f "%a@;=@;%a" (pattern ctxt) p (expression ctxt) x else
+  match is_desugared_gadt p x with
+  | Some (p, [], ct, e) ->
+      pp f "%a@;: %a@;=@;%a"
+        (simple_pattern ctxt) p (core_type ctxt) ct (expression ctxt) e
+  | Some (p, tyvars, ct, e) -> begin
+    pp f "%a@;: type@;%a.@;%a@;=@;%a"
+    (simple_pattern ctxt) p (list pp_print_string ~sep:"@;")
+    (tyvars_str tyvars) (core_type ctxt) ct (expression ctxt) e
+    end
+  | None -> begin
+      match p with
+      | {ppat_desc=Ppat_constraint(p ,ty);
+         ppat_attributes=[]} -> (* special case for the first*)
+          begin match ty with
+          | {ptyp_desc=Ptyp_poly _; ptyp_attributes=[]} ->
+              pp f "%a@;:@;%a@;=@;%a" (simple_pattern ctxt) p
+                (core_type ctxt) ty (expression ctxt) x
+          | _ ->
+              pp f "(%a@;:@;%a)@;=@;%a" (simple_pattern ctxt) p
+                (core_type ctxt) ty (expression ctxt) x
+          end
+      | {ppat_desc=Ppat_var _; ppat_attributes=[]} ->
+          pp f "%a@ %a" (simple_pattern ctxt) p pp_print_pexp_function x
+      | _ ->
+          pp f "%a@;=@;%a" (pattern ctxt) p (expression ctxt) x
+    end
+
+(* [in] is not printed *)
+and bindings ctxt f (rf,l) =
+  let binding kwd rf f x =
+    pp f "@[<2>%s %a%a@]%a" kwd rec_flag rf
+      (binding ctxt) x (item_attributes ctxt) x.pvb_attributes
+  in
+  match l with
+  | [] -> ()
+  | [x] -> binding "let" rf f x
+  | x::xs ->
+      pp f "@[<v>%a@,%a@]"
+        (binding "let" rf) x
+        (list ~sep:"@," (binding "and" Nonrecursive)) xs
+
+and structure_item ctxt f x =
+  match x.pstr_desc with
+  | Pstr_eval (e, attrs) ->
+      pp f "@[<hov2>;;%a@]%a"
+        (expression ctxt) e
+        (item_attributes ctxt) attrs
+  | Pstr_type (_, []) -> assert false
+  | Pstr_type (rf, l)  -> type_def_list ctxt f (rf, l)
+  | Pstr_value (rf, l) ->
+      (* pp f "@[<hov2>let %a%a@]"  rec_flag rf bindings l *)
+      pp f "@[<2>%a@]" (bindings ctxt) (rf,l)
+  | Pstr_typext te -> type_extension ctxt f te
+  | Pstr_exception ed -> exception_declaration ctxt f ed
+  | Pstr_module x ->
+      let rec module_helper = function
+        | {pmod_desc=Pmod_functor(s,mt,me'); pmod_attributes = []} ->
+            if mt = None then pp f "()"
+            else Misc.may (pp f "(%s:%a)" s.txt (module_type ctxt)) mt;
+            module_helper me'
+        | me -> me
+      in
+      pp f "@[<hov2>module %s%a@]%a"
+        x.pmb_name.txt
+        (fun f me ->
+           let me = module_helper me in
+           match me with
+           | {pmod_desc=
+                Pmod_constraint
+                  (me',
+                   ({pmty_desc=(Pmty_ident (_)
+                               | Pmty_signature (_));_} as mt));
+              pmod_attributes = []} ->
+               pp f " :@;%a@;=@;%a@;"
+                 (module_type ctxt) mt (module_expr ctxt) me'
+           | _ -> pp f " =@ %a" (module_expr ctxt) me
+        ) x.pmb_expr
+        (item_attributes ctxt) x.pmb_attributes
+  | Pstr_open od ->
+      pp f "@[<2>open%s@;%a@]%a"
+        (override od.popen_override)
+        longident_loc od.popen_lid
+        (item_attributes ctxt) od.popen_attributes
+  | Pstr_modtype {pmtd_name=s; pmtd_type=md; pmtd_attributes=attrs} ->
+      pp f "@[<hov2>module@ type@ %s%a@]%a"
+        s.txt
+        (fun f md -> match md with
+           | None -> ()
+           | Some mt ->
+               pp_print_space f () ;
+               pp f "@ =@ %a" (module_type ctxt) mt
+        ) md
+        (item_attributes ctxt) attrs
+  | Pstr_class () -> ()
+  | Pstr_class_type l -> class_type_declaration_list ctxt f l
+  | Pstr_primitive vd ->
+      pp f "@[<hov2>external@ %a@ :@ %a@]%a"
+        protect_ident vd.pval_name.txt
+        (value_description ctxt) vd
+        (item_attributes ctxt) vd.pval_attributes
+  | Pstr_include incl ->
+      pp f "@[<hov2>include@ %a@]%a"
+        (module_expr ctxt) incl.pincl_mod
+        (item_attributes ctxt) incl.pincl_attributes
+  | Pstr_recmodule decls -> (* 3.07 *)
+      let aux f = function
+        | ({pmb_expr={pmod_desc=Pmod_constraint (expr, typ)}} as pmb) ->
+            pp f "@[<hov2>@ and@ %s:%a@ =@ %a@]%a" pmb.pmb_name.txt
+              (module_type ctxt) typ
+              (module_expr ctxt) expr
+              (item_attributes ctxt) pmb.pmb_attributes
+        | _ -> assert false
+      in
+      begin match decls with
+      | ({pmb_expr={pmod_desc=Pmod_constraint (expr, typ)}} as pmb) :: l2 ->
+          pp f "@[<hv>@[<hov2>module@ rec@ %s:%a@ =@ %a@]%a@ %a@]"
+            pmb.pmb_name.txt
+            (module_type ctxt) typ
+            (module_expr ctxt) expr
+            (item_attributes ctxt) pmb.pmb_attributes
+            (fun f l2 -> List.iter (aux f) l2) l2
+      | _ -> assert false
+      end
+  | Pstr_attribute a -> floating_attribute ctxt f a
+  | Pstr_extension(e, a) ->
+      item_extension ctxt f e;
+      item_attributes ctxt f a
+
+and type_param ctxt f (ct, a) =
+  pp f "%s%a" (type_variance a) (core_type ctxt) ct
+
+and type_params ctxt f = function
+  | [] -> ()
+  | l -> pp f "%a " (list (type_param ctxt) ~first:"(" ~last:")" ~sep:",@;") l
+
+and type_def_list ctxt f (rf, l) =
+  let type_decl kwd rf f x =
+    let eq =
+      if (x.ptype_kind = Ptype_abstract)
+         && (x.ptype_manifest = None) then ""
+      else " ="
+    in
+    pp f "@[<2>%s %a%a%s%s%a@]%a" kwd
+      nonrec_flag rf
+      (type_params ctxt) x.ptype_params
+      x.ptype_name.txt eq
+      (type_declaration ctxt) x
+      (item_attributes ctxt) x.ptype_attributes
+  in
+  match l with
+  | [] -> assert false
+  | [x] -> type_decl "type" rf f x
+  | x :: xs -> pp f "@[<v>%a@,%a@]"
+                 (type_decl "type" rf) x
+                 (list ~sep:"@," (type_decl "and" Recursive)) xs
+
+and record_declaration ctxt f lbls =
+  let type_record_field f pld =
+    pp f "@[<2>%a%s:@;%a@;%a@]"
+      mutable_flag pld.pld_mutable
+      pld.pld_name.txt
+      (core_type ctxt) pld.pld_type
+      (attributes ctxt) pld.pld_attributes
+  in
+  pp f "{@\n%a}"
+    (list type_record_field ~sep:";@\n" )  lbls
+
+and type_declaration ctxt f x =
+  (* type_declaration has an attribute field,
+     but it's been printed by the caller of this method *)
+  let priv f =
+    match x.ptype_private with
+    | Public -> ()
+    | Private -> pp f "@;private"
+  in
+  let manifest f =
+    match x.ptype_manifest with
+    | None -> ()
+    | Some y ->
+        if x.ptype_kind = Ptype_abstract then
+          pp f "%t@;%a" priv (core_type ctxt) y
+        else
+          pp f "@;%a" (core_type ctxt) y
+  in
+  let constructor_declaration f pcd =
+    pp f "|@;";
+    constructor_declaration ctxt f
+      (pcd.pcd_name.txt, pcd.pcd_args, pcd.pcd_res, pcd.pcd_attributes)
+  in
+  let repr f =
+    let intro f =
+      if x.ptype_manifest = None then ()
+      else pp f "@;="
+    in
+    match x.ptype_kind with
+    | Ptype_variant xs ->
+        pp f "%t%t@\n%a" intro priv
+          (list ~sep:"@\n" constructor_declaration) xs
+    | Ptype_abstract -> ()
+    | Ptype_record l ->
+        pp f "%t%t@;%a" intro priv (record_declaration ctxt) l
+    | Ptype_open -> pp f "%t%t@;.." intro priv
+  in
+  let constraints f =
+    List.iter
+      (fun (ct1,ct2,_) ->
+         pp f "@[<hov2>@ constraint@ %a@ =@ %a@]"
+           (core_type ctxt) ct1 (core_type ctxt) ct2)
+      x.ptype_cstrs
+  in
+  pp f "%t%t%t" manifest repr constraints
+
+and type_extension ctxt f x =
+  let extension_constructor f x =
+    pp f "@\n|@;%a" (extension_constructor ctxt) x
+  in
+  pp f "@[<2>type %a%a += %a@ %a@]%a"
+    (fun f -> function
+       | [] -> ()
+       | l ->
+           pp f "%a@;" (list (type_param ctxt) ~first:"(" ~last:")" ~sep:",") l)
+    x.ptyext_params
+    longident_loc x.ptyext_path
+    private_flag x.ptyext_private (* Cf: #7200 *)
+    (list ~sep:"" extension_constructor)
+    x.ptyext_constructors
+    (item_attributes ctxt) x.ptyext_attributes
+
+and constructor_declaration ctxt f (name, args, res, attrs) =
+  let name =
+    match name with
+    | "::" -> "(::)"
+    | s -> s in
+  match res with
+  | None ->
+      pp f "%s%a@;%a" name
+        (fun f -> function
+           | Pcstr_tuple [] -> ()
+           | Pcstr_tuple l ->
+             pp f "@;of@;%a" (list (core_type1 ctxt) ~sep:"@;*@;") l
+           | Pcstr_record l -> pp f "@;of@;%a" (record_declaration ctxt) l
+        ) args
+        (attributes ctxt) attrs
+  | Some r ->
+      pp f "%s:@;%a@;%a" name
+        (fun f -> function
+           | Pcstr_tuple [] -> core_type1 ctxt f r
+           | Pcstr_tuple l -> pp f "%a@;->@;%a"
+                                (list (core_type1 ctxt) ~sep:"@;*@;") l
+                                (core_type1 ctxt) r
+           | Pcstr_record l ->
+               pp f "%a@;->@;%a" (record_declaration ctxt) l (core_type1 ctxt) r
+        )
+        args
+        (attributes ctxt) attrs
+
+and extension_constructor ctxt f x =
+  (* Cf: #7200 *)
+  match x.pext_kind with
+  | Pext_decl(l, r) ->
+      constructor_declaration ctxt f (x.pext_name.txt, l, r, x.pext_attributes)
+  | Pext_rebind li ->
+      pp f "%s%a@;=@;%a" x.pext_name.txt
+        (attributes ctxt) x.pext_attributes
+        longident_loc li
+
+and case_list ctxt f l : unit =
+  let aux f {pc_lhs; pc_guard; pc_rhs} =
+    pp f "@;| @[<2>%a%a@;->@;%a@]"
+      (pattern ctxt) pc_lhs (option (expression ctxt) ~first:"@;when@;")
+      pc_guard (expression (under_pipe ctxt)) pc_rhs
+  in
+  list aux f l ~sep:""
+
+and label_x_expression_param ctxt f (l,e) =
+  let simple_name = match e with
+    | {pexp_desc=Pexp_ident {txt=Lident l;_};
+       pexp_attributes=[]} -> Some l
+    | _ -> None
+  in match l with
+  | Nolabel  -> expression2 ctxt f e (* level 2*)
+  | Optional str ->
+      if Some str = simple_name then
+        pp f "?%s" str
+      else
+        pp f "?%s:%a" str (simple_expr ctxt) e
+  | Labelled lbl ->
+      if Some lbl = simple_name then
+        pp f "~%s" lbl
+      else
+        pp f "~%s:%a" lbl (simple_expr ctxt) e
+
+
+
+let expression f x =
+  pp f "@[%a@]" (expression reset_ctxt) x
+
+let string_of_expression x =
+  ignore (flush_str_formatter ()) ;
+  let f = str_formatter in
+  expression f x;
+  flush_str_formatter ()
+
+let string_of_structure x =
+  ignore (flush_str_formatter ());
+  let f = str_formatter in
+  structure reset_ctxt f x;
+  flush_str_formatter ()
+
+
+let core_type = core_type reset_ctxt
+let pattern = pattern reset_ctxt
+let signature = signature reset_ctxt
+let structure = structure reset_ctxt
+
+end
+module TypedtreeIter : sig 
+#1 "typedtreeIter.mli"
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*    Thomas Gazagnaire (OCamlPro), Fabrice Le Fessant (INRIA Saclay)     *)
+(*                                                                        *)
+(*   Copyright 2007 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Asttypes
+open Typedtree
+
+
+module type IteratorArgument = sig
+    val enter_structure : structure -> unit
+    val enter_value_description : value_description -> unit
+    val enter_type_extension : type_extension -> unit
+    val enter_extension_constructor : extension_constructor -> unit
+    val enter_pattern : pattern -> unit
+    val enter_expression : expression -> unit
+    val enter_package_type : package_type -> unit
+    val enter_signature : signature -> unit
+    val enter_signature_item : signature_item -> unit
+    val enter_module_type_declaration : module_type_declaration -> unit
+    val enter_module_type : module_type -> unit
+    val enter_module_expr : module_expr -> unit
+    val enter_with_constraint : with_constraint -> unit
+    val enter_class_signature : class_signature -> unit
+    val enter_class_description : class_description -> unit
+    val enter_class_type_declaration : class_type_declaration -> unit
+    val enter_class_type : class_type -> unit
+    val enter_class_type_field : class_type_field -> unit
+    val enter_core_type : core_type -> unit
+    val enter_structure_item : structure_item -> unit
+
+
+    val leave_structure : structure -> unit
+    val leave_value_description : value_description -> unit
+    val leave_type_extension : type_extension -> unit
+    val leave_extension_constructor : extension_constructor -> unit
+    val leave_pattern : pattern -> unit
+    val leave_expression : expression -> unit
+    val leave_package_type : package_type -> unit
+    val leave_signature : signature -> unit
+    val leave_signature_item : signature_item -> unit
+    val leave_module_type_declaration : module_type_declaration -> unit
+    val leave_module_type : module_type -> unit
+    val leave_module_expr : module_expr -> unit
+    val leave_with_constraint : with_constraint -> unit
+    val leave_class_signature : class_signature -> unit
+    val leave_class_description : class_description -> unit
+    val leave_class_type_declaration : class_type_declaration -> unit
+    val leave_class_type : class_type -> unit
+    val leave_class_type_field : class_type_field -> unit
+    val leave_core_type : core_type -> unit
+    val leave_structure_item : structure_item -> unit
+
+    val enter_bindings : rec_flag -> unit
+    val enter_binding : value_binding -> unit
+    val leave_binding : value_binding -> unit
+    val leave_bindings : rec_flag -> unit
+
+    val enter_type_declarations : rec_flag -> unit
+    val enter_type_declaration : type_declaration -> unit
+    val leave_type_declaration : type_declaration -> unit
+    val leave_type_declarations : rec_flag -> unit
+
+end
+
+module [@warning "-67"] MakeIterator :
+  functor (Iter : IteratorArgument) ->
+    sig
+      val iter_structure : structure -> unit
+      val iter_signature : signature -> unit
+      val iter_structure_item : structure_item -> unit
+      val iter_signature_item : signature_item -> unit
+      val iter_expression : expression -> unit
+      val iter_module_type : module_type -> unit
+      val iter_pattern : pattern -> unit
+    end
+
+module DefaultIteratorArgument : IteratorArgument
+
+end = struct
+#1 "typedtreeIter.ml"
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*    Thomas Gazagnaire (OCamlPro), Fabrice Le Fessant (INRIA Saclay)     *)
+(*                                                                        *)
+(*   Copyright 2007 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(*
+TODO:
+ - 2012/05/10: Follow camlp4 way of building map and iter using classes
+     and inheritance ?
+*)
+
+open Asttypes
+open Typedtree
+
+module type IteratorArgument = sig
+
+    val enter_structure : structure -> unit
+    val enter_value_description : value_description -> unit
+    val enter_type_extension : type_extension -> unit
+    val enter_extension_constructor : extension_constructor -> unit
+    val enter_pattern : pattern -> unit
+    val enter_expression : expression -> unit
+    val enter_package_type : package_type -> unit
+    val enter_signature : signature -> unit
+    val enter_signature_item : signature_item -> unit
+    val enter_module_type_declaration : module_type_declaration -> unit
+    val enter_module_type : module_type -> unit
+    val enter_module_expr : module_expr -> unit
+    val enter_with_constraint : with_constraint -> unit
+    val enter_class_signature : class_signature -> unit
+
+    val enter_class_description : class_description -> unit
+    val enter_class_type_declaration : class_type_declaration -> unit
+    val enter_class_type : class_type -> unit
+    val enter_class_type_field : class_type_field -> unit
+    val enter_core_type : core_type -> unit
+    val enter_structure_item : structure_item -> unit
+
+
+    val leave_structure : structure -> unit
+    val leave_value_description : value_description -> unit
+    val leave_type_extension : type_extension -> unit
+    val leave_extension_constructor : extension_constructor -> unit
+    val leave_pattern : pattern -> unit
+    val leave_expression : expression -> unit
+    val leave_package_type : package_type -> unit
+    val leave_signature : signature -> unit
+    val leave_signature_item : signature_item -> unit
+    val leave_module_type_declaration : module_type_declaration -> unit
+    val leave_module_type : module_type -> unit
+    val leave_module_expr : module_expr -> unit
+    val leave_with_constraint : with_constraint -> unit
+    val leave_class_signature : class_signature -> unit
+
+    val leave_class_description : class_description -> unit
+    val leave_class_type_declaration : class_type_declaration -> unit
+    val leave_class_type : class_type -> unit
+    val leave_class_type_field : class_type_field -> unit
+    val leave_core_type : core_type -> unit
+    val leave_structure_item : structure_item -> unit
+
+    val enter_bindings : rec_flag -> unit
+    val enter_binding : value_binding -> unit
+    val leave_binding : value_binding -> unit
+    val leave_bindings : rec_flag -> unit
+
+    val enter_type_declarations : rec_flag -> unit
+    val enter_type_declaration : type_declaration -> unit
+    val leave_type_declaration : type_declaration -> unit
+    val leave_type_declarations : rec_flag -> unit
+
+      end
+
+module MakeIterator(Iter : IteratorArgument) : sig
+
+    val iter_structure : structure -> unit
+    val iter_signature : signature -> unit
+    val iter_structure_item : structure_item -> unit
+    val iter_signature_item : signature_item -> unit
+    val iter_expression : expression -> unit
+    val iter_module_type : module_type -> unit
+    val iter_pattern : pattern -> unit
+
+  end = struct
+
+    let may_iter f v =
+      match v with
+        None -> ()
+      | Some x -> f x
+
+
+    let rec iter_structure str =
+      Iter.enter_structure str;
+      List.iter iter_structure_item str.str_items;
+      Iter.leave_structure str
+
+
+    and iter_binding vb =
+      Iter.enter_binding vb;
+      iter_pattern vb.vb_pat;
+      iter_expression vb.vb_expr;
+      Iter.leave_binding vb
+
+    and iter_bindings rec_flag list =
+      Iter.enter_bindings rec_flag;
+      List.iter iter_binding list;
+      Iter.leave_bindings rec_flag
+
+    and iter_case {c_lhs; c_guard; c_rhs} =
+      iter_pattern c_lhs;
+      may_iter iter_expression c_guard;
+      iter_expression c_rhs
+
+    and iter_cases cases =
+      List.iter iter_case cases
+
+    and iter_structure_item item =
+      Iter.enter_structure_item item;
+      begin
+        match item.str_desc with
+          Tstr_eval (exp, _attrs) -> iter_expression exp
+        | Tstr_value (rec_flag, list) ->
+            iter_bindings rec_flag list
+        | Tstr_primitive vd -> iter_value_description vd
+        | Tstr_type (rf, list) -> iter_type_declarations rf list
+        | Tstr_typext tyext -> iter_type_extension tyext
+        | Tstr_exception ext -> iter_extension_constructor ext
+        | Tstr_module x -> iter_module_binding x
+        | Tstr_recmodule list -> List.iter iter_module_binding list
+        | Tstr_modtype mtd -> iter_module_type_declaration mtd
+        | Tstr_open _ -> ()
+        | Tstr_class () -> ()
+        | Tstr_class_type list ->
+            List.iter
+              (fun (_, _, ct) -> iter_class_type_declaration ct)
+              list
+        | Tstr_include incl -> iter_module_expr incl.incl_mod
+        | Tstr_attribute _ ->
+            ()
+      end;
+      Iter.leave_structure_item item
+
+    and iter_module_binding x =
+      iter_module_expr x.mb_expr
+
+    and iter_value_description v =
+      Iter.enter_value_description v;
+      iter_core_type v.val_desc;
+      Iter.leave_value_description v
+
+    and iter_constructor_arguments = function
+      | Cstr_tuple l -> List.iter iter_core_type l
+      | Cstr_record l -> List.iter (fun ld -> iter_core_type ld.ld_type) l
+
+    and iter_constructor_declaration cd =
+      iter_constructor_arguments cd.cd_args;
+      option iter_core_type cd.cd_res;
+
+    and iter_type_parameter (ct, _v) =
+      iter_core_type ct
+
+    and iter_type_declaration decl =
+      Iter.enter_type_declaration decl;
+      List.iter iter_type_parameter decl.typ_params;
+      List.iter (fun (ct1, ct2, _loc) ->
+          iter_core_type ct1;
+          iter_core_type ct2
+      ) decl.typ_cstrs;
+      begin match decl.typ_kind with
+          Ttype_abstract -> ()
+        | Ttype_variant list ->
+            List.iter iter_constructor_declaration list
+        | Ttype_record list ->
+            List.iter
+              (fun ld ->
+                iter_core_type ld.ld_type
+            ) list
+        | Ttype_open -> ()
+      end;
+      option iter_core_type decl.typ_manifest;
+      Iter.leave_type_declaration decl
+
+    and iter_type_declarations rec_flag decls =
+      Iter.enter_type_declarations rec_flag;
+      List.iter iter_type_declaration decls;
+      Iter.leave_type_declarations rec_flag
+
+    and iter_extension_constructor ext =
+      Iter.enter_extension_constructor ext;
+      begin match ext.ext_kind with
+          Text_decl(args, ret) ->
+          iter_constructor_arguments args;
+            option iter_core_type ret
+        | Text_rebind _ -> ()
+      end;
+      Iter.leave_extension_constructor ext;
+
+    and iter_type_extension tyext =
+      Iter.enter_type_extension tyext;
+      List.iter iter_type_parameter tyext.tyext_params;
+      List.iter iter_extension_constructor tyext.tyext_constructors;
+      Iter.leave_type_extension tyext
+
+    and iter_pattern pat =
+      Iter.enter_pattern pat;
+      List.iter (fun (cstr, _, _attrs) -> match cstr with
+              | Tpat_type _ -> ()
+              | Tpat_unpack -> ()
+              | Tpat_open _ -> ()
+              | Tpat_constraint ct -> iter_core_type ct) pat.pat_extra;
+      begin
+        match pat.pat_desc with
+          Tpat_any -> ()
+        | Tpat_var _ -> ()
+        | Tpat_alias (pat1, _, _) -> iter_pattern pat1
+        | Tpat_constant _ -> ()
+        | Tpat_tuple list ->
+            List.iter iter_pattern list
+        | Tpat_construct (_, _, args) ->
+            List.iter iter_pattern args
+        | Tpat_variant (_, pato, _) ->
+            begin match pato with
+                None -> ()
+              | Some pat -> iter_pattern pat
+            end
+        | Tpat_record (list, _closed) ->
+            List.iter (fun (_, _, pat) -> iter_pattern pat) list
+        | Tpat_array list -> List.iter iter_pattern list
+        | Tpat_or (p1, p2, _) -> iter_pattern p1; iter_pattern p2
+        | Tpat_lazy p -> iter_pattern p
+      end;
+      Iter.leave_pattern pat
+
+    and option f x = match x with None -> () | Some e -> f e
+
+    and iter_expression exp =
+      Iter.enter_expression exp;
+      List.iter (function (cstr, _, _attrs) ->
+        match cstr with
+          Texp_constraint ct ->
+            iter_core_type ct
+        | Texp_coerce (cty1, cty2) ->
+            option iter_core_type cty1; iter_core_type cty2
+        | Texp_open _ -> ()
+        | Texp_poly cto -> option iter_core_type cto
+        | Texp_newtype _ -> ())
+        exp.exp_extra;
+      begin
+        match exp.exp_desc with
+          Texp_ident _ -> ()
+        | Texp_constant _ -> ()
+        | Texp_let (rec_flag, list, exp) ->
+            iter_bindings rec_flag list;
+            iter_expression exp
+        | Texp_function { cases; _ } ->
+            iter_cases cases
+        | Texp_apply (exp, list) ->
+            iter_expression exp;
+            List.iter (fun (_label, expo) ->
+                match expo with
+                  None -> ()
+                | Some exp -> iter_expression exp
+            ) list
+        | Texp_match (exp, list1, list2, _) ->
+            iter_expression exp;
+            iter_cases list1;
+            iter_cases list2;
+        | Texp_try (exp, list) ->
+            iter_expression exp;
+            iter_cases list
+        | Texp_tuple list ->
+            List.iter iter_expression list
+        | Texp_construct (_, _, args) ->
+            List.iter iter_expression args
+        | Texp_variant (_label, expo) ->
+            begin match expo with
+                None -> ()
+              | Some exp -> iter_expression exp
+            end
+        | Texp_record { fields; extended_expression; _ } ->
+            Array.iter (function
+                | _, Kept _ -> ()
+                | _, Overridden (_, exp) -> iter_expression exp)
+              fields;
+            begin match extended_expression with
+                None -> ()
+              | Some exp -> iter_expression exp
+            end
+        | Texp_field (exp, _, _label) ->
+            iter_expression exp
+        | Texp_setfield (exp1, _, _label, exp2) ->
+            iter_expression exp1;
+            iter_expression exp2
+        | Texp_array list ->
+            List.iter iter_expression list
+        | Texp_ifthenelse (exp1, exp2, expo) ->
+            iter_expression exp1;
+            iter_expression exp2;
+            begin match expo with
+                None -> ()
+              | Some exp -> iter_expression exp
+            end
+        | Texp_sequence (exp1, exp2) ->
+            iter_expression exp1;
+            iter_expression exp2
+        | Texp_while (exp1, exp2) ->
+            iter_expression exp1;
+            iter_expression exp2
+        | Texp_for (_id, _, exp1, exp2, _dir, exp3) ->
+            iter_expression exp1;
+            iter_expression exp2;
+            iter_expression exp3
+        | Texp_send (exp, _meth, expo) ->
+            iter_expression exp;
+          begin
+            match expo with
+                None -> ()
+              | Some exp -> iter_expression exp
+          end
+        | Texp_new _ 
+        | Texp_instvar _ 
+        | Texp_setinstvar _ 
+        | Texp_override _ -> ()
+        | Texp_letmodule (_id, _, mexpr, exp) ->
+            iter_module_expr mexpr;
+            iter_expression exp
+        | Texp_letexception (cd, exp) ->
+            iter_extension_constructor cd;
+            iter_expression exp
+        | Texp_assert exp -> iter_expression exp
+        | Texp_lazy exp -> iter_expression exp
+        | Texp_object () ->
+            ()
+        | Texp_pack (mexpr) ->
+            iter_module_expr mexpr
+        | Texp_unreachable ->
+            ()
+        | Texp_extension_constructor _ ->
+            ()
+      end;
+      Iter.leave_expression exp;
+
+    and iter_package_type pack =
+      Iter.enter_package_type pack;
+      List.iter (fun (_s, ct) -> iter_core_type ct) pack.pack_fields;
+      Iter.leave_package_type pack;
+
+    and iter_signature sg =
+      Iter.enter_signature sg;
+      List.iter iter_signature_item sg.sig_items;
+      Iter.leave_signature sg;
+
+    and iter_signature_item item =
+      Iter.enter_signature_item item;
+      begin
+        match item.sig_desc with
+          Tsig_value vd ->
+            iter_value_description vd
+        | Tsig_type (rf, list) ->
+            iter_type_declarations rf list
+        | Tsig_exception ext ->
+            iter_extension_constructor ext
+        | Tsig_typext tyext ->
+            iter_type_extension tyext
+        | Tsig_module md ->
+            iter_module_type md.md_type
+        | Tsig_recmodule list ->
+            List.iter (fun md -> iter_module_type md.md_type) list
+        | Tsig_modtype mtd ->
+            iter_module_type_declaration mtd
+        | Tsig_open _ -> ()
+        | Tsig_include incl -> iter_module_type incl.incl_mod
+        | Tsig_class () -> ()
+        | Tsig_class_type list ->
+            List.iter iter_class_type_declaration list
+        | Tsig_attribute _ -> ()
+      end;
       Iter.leave_signature_item item;
 
     and iter_module_type_declaration mtd =
@@ -26839,7 +28582,7 @@ let is_cons = function
 
 let pretty_const c = match c with
 | Const_int i -> Printf.sprintf "%d" i
-| Const_char c -> Printf.sprintf "%C" c
+| Const_char i -> Printf.sprintf "%s" (Pprintast.string_of_int_as_char i)
 | Const_string (s, _) -> Printf.sprintf "%S" s
 | Const_float f -> Printf.sprintf "%s" f
 | Const_int32 i -> Printf.sprintf "%ldl" i
@@ -27497,7 +29240,7 @@ let build_other_constant proj make first next p env =
 
 let some_other_tag = "<some other tag>"
 
-let build_other ext env = match env with
+let build_other ext env : Typedtree.pattern = match env with
 | ({pat_desc = Tpat_construct (lid, {cstr_tag=Cstr_extension _},_)},_) :: _ ->
         (* let c = {c with cstr_name = "*extension*"} in *) (* PR#7330 *)
         make_pat (Tpat_var (Ident.create "*extension*",
@@ -27539,13 +29282,19 @@ let build_other ext env = match env with
             make_pat (Tpat_or (pat, p_res, None)) p.pat_type p.pat_env)
           pat other_pats
     end
-| ({pat_desc=(Tpat_constant (Const_int _ | Const_char _))} as p,_) :: _ ->
+| ({pat_desc=(Tpat_constant (Const_int _ ))} as p,_) :: _ ->
     build_other_constant
       (function Tpat_constant(Const_int i) -> i 
-      | Tpat_constant (Const_char i) -> Char.code i
       | _ -> assert false)
       (function i -> Tpat_constant(Const_int i))
       0 succ p env
+| ({pat_desc=(Tpat_constant (Const_char _ ))} as p,_) :: _ ->
+        build_other_constant
+          (function 
+          | Tpat_constant (Const_char i) -> i
+          | _ -> assert false)
+          (function i -> Tpat_constant(Const_char i))
+          0 succ p env      
 | ({pat_desc=(Tpat_constant (Const_int32 _))} as p,_) :: _ ->
     build_other_constant
       (function Tpat_constant(Const_int32 i) -> i | _ -> assert false)
@@ -29124,7 +30873,7 @@ open Lambda
 
 let rec struct_const ppf = function
   | Const_base(Const_int n) -> fprintf ppf "%i" n
-  | Const_base(Const_char c) -> fprintf ppf "%C" c
+  | Const_base(Const_char i) -> fprintf ppf "%s" (Pprintast.string_of_int_as_char i)
   | Const_base(Const_string (s, _)) -> fprintf ppf "%S" s
   | Const_immstring s -> fprintf ppf "#%S" s
   | Const_base(Const_float f) -> fprintf ppf "%s" f
@@ -39962,7 +41711,7 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env
         else
           or_ ~loc:gloc
             (constant ~loc:gloc (Pconst_char c1))
-            (loop (Char.chr(Char.code c1 + 1)) c2)
+            (loop (c1 + 1) c2)
       in
       let p = if c1 <= c2 then loop c1 c2 else loop c2 c1 in
       let p = {p with ppat_loc=loc} in
@@ -45055,7 +46804,7 @@ let combine_constant names loc arg cst partial ctx def
         call_switcher loc fail arg min_int max_int int_lambda_list names
     | Const_char _ ->
         let int_lambda_list =
-          List.map (function Const_char c, l -> (Char.code c, l)
+          List.map (function Const_char c, l -> (c, l)
             | _ -> assert false)
             const_lambda_list in
         call_switcher loc fail arg 0 max_int int_lambda_list names
@@ -50864,7 +52613,7 @@ type t =
   | Open
   | True
   | False
-  | Codepoint of {c: char; original: string}
+  | Codepoint of {c: int; original: string}
   | Int of {i: string; suffix: char option}
   | Float of {f: string; suffix: char option}
   | String of string
@@ -51867,7 +53616,7 @@ let printConstant ?(templateLiteral = false) c =
   | Pconst_float (s, _) -> Doc.text s
   | Pconst_char c ->
     let str =
-      match c with
+      match Char.unsafe_chr c with
       | '\'' -> "\\'"
       | '\\' -> "\\\\"
       | '\n' -> "\\n"
@@ -51878,7 +53627,7 @@ let printConstant ?(templateLiteral = false) c =
         let s = (Bytes.create [@doesNotRaise]) 1 in
         Bytes.unsafe_set s 0 c;
         Bytes.unsafe_to_string s
-      | c -> Res_utf8.encodeCodePoint (Obj.magic c)
+      | _ -> Res_utf8.encodeCodePoint c
     in
     Doc.text ("'" ^ str ^ "'")
 
@@ -57026,82 +58775,6 @@ let print_pattern typed =
   let doc = Res_printer.printPattern pat Res_comments_table.empty in
   Res_doc.toString ~width:80 doc
 
-end
-module Ext_util : sig 
-#1 "ext_util.mli"
-(* Copyright (C) 2015-2016 Bloomberg Finance L.P.
- * 
- * This program is free software: you can redistribute it and/or modify
- * it under the terms of the GNU Lesser General Public License as published by
- * the Free Software Foundation, either version 3 of the License, or
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU Lesser General Public License for more details.
- * 
- * You should have received a copy of the GNU Lesser General Public License
- * along with this program; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
-
-val power_2_above : int -> int -> int
-
-val stats_to_string : Hashtbl.statistics -> string
-
-end = struct
-#1 "ext_util.ml"
-(* Copyright (C) 2015-2016 Bloomberg Finance L.P.
- * 
- * This program is free software: you can redistribute it and/or modify
- * it under the terms of the GNU Lesser General Public License as published by
- * the Free Software Foundation, either version 3 of the License, or
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU Lesser General Public License for more details.
- * 
- * You should have received a copy of the GNU Lesser General Public License
- * along with this program; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
-
-(**
-   {[
-     (power_2_above 16 63 = 64)
-       (power_2_above 16 76 = 128)
-   ]}
-*)
-let rec power_2_above x n =
-  if x >= n then x
-  else if x * 2 > Sys.max_array_length then x
-  else power_2_above (x * 2) n
-
-let stats_to_string
-    ({ num_bindings; num_buckets; max_bucket_length; bucket_histogram } :
-      Hashtbl.statistics) =
-  Printf.sprintf "bindings: %d,buckets: %d, longest: %d, hist:[%s]" num_bindings
-    num_buckets max_bucket_length
-    (String.concat ","
-       (Array.to_list (Array.map string_of_int bucket_histogram)))
-
 end
 module Hash_gen
 = struct
@@ -69577,7 +71250,7 @@ let yyact = [|
     let _1 = (Parsing.peek_val __caml_parser_env 0 : char) in
     Obj.repr(
 # 2155 "ml/parser.mly"
-                 ( Pconst_char _1 )
+                 ( Pconst_char (Char.code _1) )
 # 11020 "ml/parser.ml"
                : 'constant))
 ; (fun __caml_parser_env ->
@@ -75137,7 +76810,7 @@ type float_lit = { f : string } [@@unboxed]
 
 type number =
   | Float of float_lit
-  | Int of { i : int32; c : char option }
+  | Int of { i : int32; c : int option }
   | Uint of int32
 
 (* becareful when constant folding +/-,
@@ -77077,7 +78750,7 @@ val method_ :
 
 val econd : ?comment:string -> t -> t -> t -> t
 
-val int : ?comment:string -> ?c:char -> int32 -> t
+val int : ?comment:string -> ?c:int -> int32 -> t
 
 val uint32 : ?comment:string -> int32 -> t
 
@@ -79886,7 +81559,7 @@ and expression_desc cxt ~(level : int) f x : cxt =
         match v with
         | Float { f } -> Js_number.caml_float_literal_to_js_string f
         (* attach string here for float constant folding?*)
-        | Int { i; c = Some c } -> Format.asprintf "/* %C */%ld" c i
+        | Int { i; c = Some c } -> Format.asprintf "/* %s */%ld" (Ext_util.string_of_int_as_char c) i
         | Int { i; c = None } ->
             Int32.to_string i
             (* check , js convention with ocaml lexical convention *)
@@ -82407,145 +84080,6 @@ let is_lower_case c =
   || (c >= '\224' && c <= '\246')
   || (c >= '\248' && c <= '\254')
 
-end
-module Ext_utf8 : sig 
-#1 "ext_utf8.mli"
-(* Copyright (C) 2015-2016 Bloomberg Finance L.P.
- *
- * This program is free software: you can redistribute it and/or modify
- * it under the terms of the GNU Lesser General Public License as published by
- * the Free Software Foundation, either version 3 of the License, or
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public License
- * along with this program; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
-
-type byte = Single of int | Cont of int | Leading of int * int | Invalid
-
-val classify : char -> byte
-
-val follow : string -> int -> int -> int -> int * int
-
-val next : string -> remaining:int -> int -> int
-(** 
-   return [-1] if failed 
-*)
-
-exception Invalid_utf8 of string
-
-val decode_utf8_string : string -> int list
-
-end = struct
-#1 "ext_utf8.ml"
-(* Copyright (C) 2015-2016 Bloomberg Finance L.P.
- *
- * This program is free software: you can redistribute it and/or modify
- * it under the terms of the GNU Lesser General Public License as published by
- * the Free Software Foundation, either version 3 of the License, or
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public License
- * along with this program; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
-
-type byte = Single of int | Cont of int | Leading of int * int | Invalid
-
-(** [classify chr] returns the {!byte} corresponding to [chr] *)
-let classify chr =
-  let c = int_of_char chr in
-  (* Classify byte according to leftmost 0 bit *)
-  if c land 0b1000_0000 = 0 then Single c
-  else if (* c 0b0____*)
-          c land 0b0100_0000 = 0 then Cont (c land 0b0011_1111)
-  else if (* c 0b10___*)
-          c land 0b0010_0000 = 0 then Leading (1, c land 0b0001_1111)
-  else if (* c 0b110__*)
-          c land 0b0001_0000 = 0 then Leading (2, c land 0b0000_1111)
-  else if (* c 0b1110_ *)
-          c land 0b0000_1000 = 0 then Leading (3, c land 0b0000_0111)
-  else if (* c 0b1111_0___*)
-          c land 0b0000_0100 = 0 then Leading (4, c land 0b0000_0011)
-  else if (* c 0b1111_10__*)
-          c land 0b0000_0010 = 0 then Leading (5, c land 0b0000_0001)
-    (* c 0b1111_110__ *)
-  else Invalid
-
-exception Invalid_utf8 of string
-
-(* when the first char is [Leading],
-   TODO: need more error checking
-   when out of bond
-*)
-let rec follow s n (c : int) offset =
-  if n = 0 then (c, offset)
-  else
-    match classify s.[offset + 1] with
-    | Cont cc -> follow s (n - 1) ((c lsl 6) lor (cc land 0x3f)) (offset + 1)
-    | _ -> raise (Invalid_utf8 "Continuation byte expected")
-
-let rec next s ~remaining offset =
-  if remaining = 0 then offset
-  else
-    match classify s.[offset + 1] with
-    | Cont _cc -> next s ~remaining:(remaining - 1) (offset + 1)
-    | _ -> -1
-    | exception _ -> -1
-(* it can happen when out of bound *)
-
-let decode_utf8_string s =
-  let lst = ref [] in
-  let add elem = lst := elem :: !lst in
-  let rec decode_utf8_cont s i s_len =
-    if i = s_len then ()
-    else
-      match classify s.[i] with
-      | Single c ->
-          add c;
-          decode_utf8_cont s (i + 1) s_len
-      | Cont _ -> raise (Invalid_utf8 "Unexpected continuation byte")
-      | Leading (n, c) ->
-          let c', i' = follow s n c i in
-          add c';
-          decode_utf8_cont s (i' + 1) s_len
-      | Invalid -> raise (Invalid_utf8 "Invalid byte")
-  in
-  decode_utf8_cont s 0 (String.length s);
-  List.rev !lst
-
-(** To decode {j||j} we need verify in the ast so that we have better error 
-    location, then we do the decode later
-*)
-
-(* let verify s loc =
-   assert false *)
-
 end
 module Ast_utf8_string : sig 
 #1 "ast_utf8_string.mli"
@@ -83624,7 +85158,7 @@ type t =
   | Const_js_true
   | Const_js_false
   | Const_int of { i : int32; comment : pointer_info }
-  | Const_char of char
+  | Const_char of int
   | Const_string of { s : string; unicode : bool }
   | Const_float of string
   | Const_int64 of int64
@@ -83687,7 +85221,7 @@ type t =
   | Const_js_true
   | Const_js_false
   | Const_int of { i : int32; comment : pointer_info }
-  | Const_char of char
+  | Const_char of int
   | Const_string of { s : string; unicode : bool }
   | Const_float of string
   | Const_int64 of int64
@@ -85479,7 +87013,7 @@ let prim ~primitive:(prim : Lam_primitive.t) ~args loc : t =
       | ( (Pstringrefs | Pstringrefu),
           Const_string { s = a; unicode = false },
           Const_int { i = b } ) -> (
-          try Lift.char (String.get a (Int32.to_int b)) with _ -> default ())
+          try Lift.char (Char.code (String.get a (Int32.to_int b))) with _ -> default ())
       | _ -> default ())
   | _ -> (
       match prim with
@@ -85550,7 +87084,7 @@ let rec complete_range (sw_consts : (int * _) list) ~(start : int) ~finish =
 let rec eval_const_as_bool (v : Lam_constant.t) : bool =
   match v with
   | Const_int { i = x } -> x <> 0l
-  | Const_char x -> Char.code x <> 0
+  | Const_char x -> x <> 0
   | Const_int64 x -> x <> 0L
   | Const_js_false | Const_js_null | Const_module_alias | Const_js_undefined ->
       false
@@ -92324,7 +93858,7 @@ let rec struct_const ppf (cst : Lam_constant.t) =
   | Const_module_alias -> fprintf ppf "#alias"
   | Const_js_undefined -> fprintf ppf "#undefined"
   | Const_int { i } -> fprintf ppf "%ld" i
-  | Const_char c -> fprintf ppf "%C" c
+  | Const_char i -> fprintf ppf "%s" (Ext_util.string_of_int_as_char i)
   | Const_string { s } -> fprintf ppf "%S" s
   | Const_float f -> fprintf ppf "%s" f
   | Const_int64 n -> fprintf ppf "%LiL" n
@@ -95126,7 +96660,7 @@ val ref_byte : J.expression -> J.expression -> J.expression
 
 val set_byte : J.expression -> J.expression -> J.expression -> J.expression
 
-val const_char : char -> J.expression
+val const_char : int -> J.expression
 
 val bytes_to_string : J.expression -> J.expression
 
@@ -95163,7 +96697,7 @@ module E = Js_exp_make
     currently, it follows the same patten of ocaml, [char] is [int]
 *)
 
-let const_char (i : char) = E.int ~c:i (Int32.of_int @@ Char.code i)
+let const_char (i : int) = E.int ~c:i (Int32.of_int @@ i)
 
 (* string [s[i]] expects to return a [ocaml_char] *)
 let ref_string e e1 = E.string_index e e1
@@ -258459,7 +259993,7 @@ let lets_helper (count_var : Ident.t -> Lam_pass_count.used_info) lam : Lam.t =
           |Lconst((Const_int {i})) -> 
             let i = Int32.to_int i in
             if i < String.length l_s && i >= 0  then
-              Lam.const ((Const_char l_s.[i]))
+              Lam.const ((Const_char (Char.code l_s.[i])))
             else 
               Lam.prim ~primitive ~args:[l';r'] loc 
           | _ -> 
@@ -261382,2191 +262916,728 @@ and
 
   | 40 ->
 # 453 "ml/lexer.mll"
-         ( MINUSGREATER )
-# 1888 "ml/lexer.ml"
-
-  | 41 ->
-# 454 "ml/lexer.mll"
-         ( DOT )
-# 1893 "ml/lexer.ml"
-
-  | 42 ->
-# 455 "ml/lexer.mll"
-         ( DOTDOT )
-# 1898 "ml/lexer.ml"
-
-  | 43 ->
-let
-# 456 "ml/lexer.mll"
-                                      s
-# 1904 "ml/lexer.ml"
-= Lexing.sub_lexeme lexbuf (lexbuf.Lexing.lex_start_pos + 1) lexbuf.Lexing.lex_curr_pos in
-# 456 "ml/lexer.mll"
-                                         ( DOTOP s )
-# 1908 "ml/lexer.ml"
-
-  | 44 ->
-# 457 "ml/lexer.mll"
-         ( COLON )
-# 1913 "ml/lexer.ml"
-
-  | 45 ->
-# 458 "ml/lexer.mll"
-         ( COLONCOLON )
-# 1918 "ml/lexer.ml"
-
-  | 46 ->
-# 459 "ml/lexer.mll"
-         ( COLONEQUAL )
-# 1923 "ml/lexer.ml"
-
-  | 47 ->
-# 460 "ml/lexer.mll"
-         ( COLONGREATER )
-# 1928 "ml/lexer.ml"
-
-  | 48 ->
-# 461 "ml/lexer.mll"
-         ( SEMI )
-# 1933 "ml/lexer.ml"
-
-  | 49 ->
-# 462 "ml/lexer.mll"
-         ( SEMISEMI )
-# 1938 "ml/lexer.ml"
-
-  | 50 ->
-# 463 "ml/lexer.mll"
-         ( LESS )
-# 1943 "ml/lexer.ml"
-
-  | 51 ->
-# 464 "ml/lexer.mll"
-         ( LESSMINUS )
-# 1948 "ml/lexer.ml"
-
-  | 52 ->
-# 465 "ml/lexer.mll"
-         ( EQUAL )
-# 1953 "ml/lexer.ml"
-
-  | 53 ->
-# 466 "ml/lexer.mll"
-         ( LBRACKET )
-# 1958 "ml/lexer.ml"
-
-  | 54 ->
-# 467 "ml/lexer.mll"
-         ( LBRACKETBAR )
-# 1963 "ml/lexer.ml"
-
-  | 55 ->
-# 468 "ml/lexer.mll"
-         ( LBRACKETLESS )
-# 1968 "ml/lexer.ml"
-
-  | 56 ->
-# 469 "ml/lexer.mll"
-         ( LBRACKETGREATER )
-# 1973 "ml/lexer.ml"
-
-  | 57 ->
-# 470 "ml/lexer.mll"
-         ( RBRACKET )
-# 1978 "ml/lexer.ml"
-
-  | 58 ->
-# 471 "ml/lexer.mll"
-         ( LBRACE )
-# 1983 "ml/lexer.ml"
-
-  | 59 ->
-# 472 "ml/lexer.mll"
-         ( LBRACELESS )
-# 1988 "ml/lexer.ml"
-
-  | 60 ->
-# 473 "ml/lexer.mll"
-         ( BAR )
-# 1993 "ml/lexer.ml"
-
-  | 61 ->
-# 474 "ml/lexer.mll"
-         ( BARBAR )
-# 1998 "ml/lexer.ml"
-
-  | 62 ->
-# 475 "ml/lexer.mll"
-         ( BARRBRACKET )
-# 2003 "ml/lexer.ml"
-
-  | 63 ->
-# 476 "ml/lexer.mll"
-         ( GREATER )
-# 2008 "ml/lexer.ml"
-
-  | 64 ->
-# 477 "ml/lexer.mll"
-         ( GREATERRBRACKET )
-# 2013 "ml/lexer.ml"
-
-  | 65 ->
-# 478 "ml/lexer.mll"
-         ( RBRACE )
-# 2018 "ml/lexer.ml"
-
-  | 66 ->
-# 479 "ml/lexer.mll"
-         ( GREATERRBRACE )
-# 2023 "ml/lexer.ml"
-
-  | 67 ->
-# 480 "ml/lexer.mll"
-         ( LBRACKETAT )
-# 2028 "ml/lexer.ml"
-
-  | 68 ->
-# 481 "ml/lexer.mll"
-           ( LBRACKETATAT )
-# 2033 "ml/lexer.ml"
-
-  | 69 ->
-# 482 "ml/lexer.mll"
-           ( LBRACKETATATAT )
-# 2038 "ml/lexer.ml"
-
-  | 70 ->
-# 483 "ml/lexer.mll"
-           ( LBRACKETPERCENT )
-# 2043 "ml/lexer.ml"
-
-  | 71 ->
-# 484 "ml/lexer.mll"
-           ( LBRACKETPERCENTPERCENT )
-# 2048 "ml/lexer.ml"
-
-  | 72 ->
-# 485 "ml/lexer.mll"
-         ( BANG )
-# 2053 "ml/lexer.ml"
-
-  | 73 ->
-# 486 "ml/lexer.mll"
-         ( INFIXOP0 "!=" )
-# 2058 "ml/lexer.ml"
-
-  | 74 ->
-# 487 "ml/lexer.mll"
-         ( PLUS )
-# 2063 "ml/lexer.ml"
-
-  | 75 ->
-# 488 "ml/lexer.mll"
-         ( PLUSDOT )
-# 2068 "ml/lexer.ml"
-
-  | 76 ->
-# 489 "ml/lexer.mll"
-         ( PLUSEQ )
-# 2073 "ml/lexer.ml"
-
-  | 77 ->
-# 490 "ml/lexer.mll"
-         ( MINUS )
-# 2078 "ml/lexer.ml"
-
-  | 78 ->
-# 491 "ml/lexer.mll"
-         ( MINUSDOT )
-# 2083 "ml/lexer.ml"
-
-  | 79 ->
-# 494 "ml/lexer.mll"
-            ( PREFIXOP(Lexing.lexeme lexbuf) )
-# 2088 "ml/lexer.ml"
-
-  | 80 ->
-# 496 "ml/lexer.mll"
-            ( PREFIXOP(Lexing.lexeme lexbuf) )
-# 2093 "ml/lexer.ml"
-
-  | 81 ->
-# 498 "ml/lexer.mll"
-            ( INFIXOP0(Lexing.lexeme lexbuf) )
-# 2098 "ml/lexer.ml"
-
-  | 82 ->
-# 500 "ml/lexer.mll"
-            ( INFIXOP1(Lexing.lexeme lexbuf) )
-# 2103 "ml/lexer.ml"
-
-  | 83 ->
-# 502 "ml/lexer.mll"
-            ( INFIXOP2(Lexing.lexeme lexbuf) )
-# 2108 "ml/lexer.ml"
-
-  | 84 ->
-# 504 "ml/lexer.mll"
-            ( INFIXOP4(Lexing.lexeme lexbuf) )
-# 2113 "ml/lexer.ml"
-
-  | 85 ->
-# 505 "ml/lexer.mll"
-            ( PERCENT )
-# 2118 "ml/lexer.ml"
-
-  | 86 ->
-# 507 "ml/lexer.mll"
-            ( INFIXOP3(Lexing.lexeme lexbuf) )
-# 2123 "ml/lexer.ml"
-
-  | 87 ->
-# 509 "ml/lexer.mll"
-            ( HASHOP(Lexing.lexeme lexbuf) )
-# 2128 "ml/lexer.ml"
-
-  | 88 ->
-# 510 "ml/lexer.mll"
-        ( Rescript_cpp.eof_check lexbuf; EOF)
-# 2133 "ml/lexer.ml"
-
-  | 89 ->
-# 512 "ml/lexer.mll"
-      ( raise (Error(Illegal_character (Lexing.lexeme_char lexbuf 0),
-                     Location.curr lexbuf))
-      )
-# 2140 "ml/lexer.ml"
-
-  | __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf;
-      __ocaml_lex_token_rec lexbuf __ocaml_lex_state
-
-and comment lexbuf =
-   __ocaml_lex_comment_rec lexbuf 137
-and __ocaml_lex_comment_rec lexbuf __ocaml_lex_state =
-  match Lexing.engine __ocaml_lex_tables __ocaml_lex_state lexbuf with
-      | 0 ->
-# 518 "ml/lexer.mll"
-      ( comment_start_loc := (Location.curr lexbuf) :: !comment_start_loc;
-        store_lexeme lexbuf;
-        comment lexbuf
-      )
-# 2155 "ml/lexer.ml"
-
-  | 1 ->
-# 523 "ml/lexer.mll"
-      ( match !comment_start_loc with
-        | [] -> assert false
-        | [_] -> comment_start_loc := []; Location.curr lexbuf
-        | _ :: l -> comment_start_loc := l;
-                  store_lexeme lexbuf;
-                  comment lexbuf
-       )
-# 2166 "ml/lexer.ml"
-
-  | 2 ->
-# 531 "ml/lexer.mll"
-      (
-        string_start_loc := Location.curr lexbuf;
-        store_string_char '\"';
-        is_in_string := true;
-        begin try string lexbuf
-        with Error (Unterminated_string, str_start) ->
-          match !comment_start_loc with
-          | [] -> assert false
-          | loc :: _ ->
-            let start = List.hd (List.rev !comment_start_loc) in
-            comment_start_loc := [];
-            raise (Error (Unterminated_string_in_comment (start, str_start),
-                          loc))
-        end;
-        is_in_string := false;
-        store_string_char '\"';
-        comment lexbuf )
-# 2187 "ml/lexer.ml"
-
-  | 3 ->
-# 549 "ml/lexer.mll"
-      (
-        let delim = Lexing.lexeme lexbuf in
-        let delim = String.sub delim 1 (String.length delim - 2) in
-        string_start_loc := Location.curr lexbuf;
-        store_lexeme lexbuf;
-        is_in_string := true;
-        begin try quoted_string delim lexbuf
-        with Error (Unterminated_string, str_start) ->
-          match !comment_start_loc with
-          | [] -> assert false
-          | loc :: _ ->
-            let start = List.hd (List.rev !comment_start_loc) in
-            comment_start_loc := [];
-            raise (Error (Unterminated_string_in_comment (start, str_start),
-                          loc))
-        end;
-        is_in_string := false;
-        store_string_char '|';
-        store_string delim;
-        store_string_char '}';
-        comment lexbuf )
-# 2212 "ml/lexer.ml"
-
-  | 4 ->
-# 572 "ml/lexer.mll"
-      ( store_lexeme lexbuf; comment lexbuf )
-# 2217 "ml/lexer.ml"
-
-  | 5 ->
-# 574 "ml/lexer.mll"
-      ( update_loc lexbuf None 1 false 1;
-        store_lexeme lexbuf;
-        comment lexbuf
-      )
-# 2225 "ml/lexer.ml"
-
-  | 6 ->
-# 579 "ml/lexer.mll"
-      ( store_lexeme lexbuf; comment lexbuf )
-# 2230 "ml/lexer.ml"
-
-  | 7 ->
-# 581 "ml/lexer.mll"
-      ( store_lexeme lexbuf; comment lexbuf )
-# 2235 "ml/lexer.ml"
-
-  | 8 ->
-# 583 "ml/lexer.mll"
-      ( store_lexeme lexbuf; comment lexbuf )
-# 2240 "ml/lexer.ml"
-
-  | 9 ->
-# 585 "ml/lexer.mll"
-      ( store_lexeme lexbuf; comment lexbuf )
-# 2245 "ml/lexer.ml"
-
-  | 10 ->
-# 587 "ml/lexer.mll"
-      ( match !comment_start_loc with
-        | [] -> assert false
-        | loc :: _ ->
-          let start = List.hd (List.rev !comment_start_loc) in
-          comment_start_loc := [];
-          raise (Error (Unterminated_comment start, loc))
-      )
-# 2256 "ml/lexer.ml"
-
-  | 11 ->
-# 595 "ml/lexer.mll"
-      ( update_loc lexbuf None 1 false 0;
-        store_lexeme lexbuf;
-        comment lexbuf
-      )
-# 2264 "ml/lexer.ml"
-
-  | 12 ->
-# 600 "ml/lexer.mll"
-      ( store_lexeme lexbuf; comment lexbuf )
-# 2269 "ml/lexer.ml"
-
-  | __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf;
-      __ocaml_lex_comment_rec lexbuf __ocaml_lex_state
-
-and string lexbuf =
-  lexbuf.Lexing.lex_mem <- Array.make 2 (-1); __ocaml_lex_string_rec lexbuf 169
-and __ocaml_lex_string_rec lexbuf __ocaml_lex_state =
-  match Lexing.new_engine __ocaml_lex_tables __ocaml_lex_state lexbuf with
-      | 0 ->
-# 604 "ml/lexer.mll"
-      ( () )
-# 2281 "ml/lexer.ml"
-
-  | 1 ->
-let
-# 605 "ml/lexer.mll"
-                                  space
-# 2287 "ml/lexer.ml"
-= Lexing.sub_lexeme lexbuf lexbuf.Lexing.lex_mem.(0) lexbuf.Lexing.lex_curr_pos in
-# 606 "ml/lexer.mll"
-      ( update_loc lexbuf None 1 false (String.length space);
-        if in_comment () then store_lexeme lexbuf;
-        string lexbuf
-      )
-# 2294 "ml/lexer.ml"
-
-  | 2 ->
-# 611 "ml/lexer.mll"
-      ( store_escaped_char lexbuf
-                           (char_for_backslash(Lexing.lexeme_char lexbuf 1));
-        string lexbuf )
-# 2301 "ml/lexer.ml"
-
-  | 3 ->
-# 615 "ml/lexer.mll"
-      ( store_escaped_char lexbuf (char_for_decimal_code lexbuf 1);
-         string lexbuf )
-# 2307 "ml/lexer.ml"
-
-  | 4 ->
-# 618 "ml/lexer.mll"
-      ( store_escaped_char lexbuf (char_for_octal_code lexbuf 2);
-         string lexbuf )
-# 2313 "ml/lexer.ml"
-
-  | 5 ->
-# 621 "ml/lexer.mll"
-      ( store_escaped_char lexbuf (char_for_hexadecimal_code lexbuf 2);
-         string lexbuf )
-# 2319 "ml/lexer.ml"
-
-  | 6 ->
-# 624 "ml/lexer.mll"
-        ( store_escaped_uchar lexbuf (uchar_for_uchar_escape lexbuf);
-          string lexbuf )
-# 2325 "ml/lexer.ml"
-
-  | 7 ->
-# 627 "ml/lexer.mll"
-      ( if not (in_comment ()) then begin
-(*  Should be an error, but we are very lax.
-          raise (Error (Illegal_escape (Lexing.lexeme lexbuf),
-                        Location.curr lexbuf))
-*)
-          let loc = Location.curr lexbuf in
-          Location.prerr_warning loc Warnings.Illegal_backslash;
-        end;
-        store_lexeme lexbuf;
-        string lexbuf
-      )
-# 2340 "ml/lexer.ml"
-
-  | 8 ->
-# 639 "ml/lexer.mll"
-      ( if not (in_comment ()) then
-          Location.prerr_warning (Location.curr lexbuf) Warnings.Eol_in_string;
-        update_loc lexbuf None 1 false 0;
-        store_lexeme lexbuf;
-        string lexbuf
-      )
-# 2350 "ml/lexer.ml"
-
-  | 9 ->
-# 646 "ml/lexer.mll"
-      ( is_in_string := false;
-        raise (Error (Unterminated_string, !string_start_loc)) )
-# 2356 "ml/lexer.ml"
-
-  | 10 ->
-# 649 "ml/lexer.mll"
-      ( store_string_char(Lexing.lexeme_char lexbuf 0);
-        string lexbuf )
-# 2362 "ml/lexer.ml"
-
-  | __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf;
-      __ocaml_lex_string_rec lexbuf __ocaml_lex_state
-
-and quoted_string delim lexbuf =
-   __ocaml_lex_quoted_string_rec delim lexbuf 196
-and __ocaml_lex_quoted_string_rec delim lexbuf __ocaml_lex_state =
-  match Lexing.engine __ocaml_lex_tables __ocaml_lex_state lexbuf with
-      | 0 ->
-# 654 "ml/lexer.mll"
-      ( update_loc lexbuf None 1 false 0;
-        store_lexeme lexbuf;
-        quoted_string delim lexbuf
-      )
-# 2377 "ml/lexer.ml"
-
-  | 1 ->
-# 659 "ml/lexer.mll"
-      ( is_in_string := false;
-        raise (Error (Unterminated_string, !string_start_loc)) )
-# 2383 "ml/lexer.ml"
-
-  | 2 ->
-# 662 "ml/lexer.mll"
-      (
-        let edelim = Lexing.lexeme lexbuf in
-        let edelim = String.sub edelim 1 (String.length edelim - 2) in
-        if delim = edelim then ()
-        else (store_lexeme lexbuf; quoted_string delim lexbuf)
-      )
-# 2393 "ml/lexer.ml"
-
-  | 3 ->
-# 669 "ml/lexer.mll"
-      ( store_string_char(Lexing.lexeme_char lexbuf 0);
-        quoted_string delim lexbuf )
-# 2399 "ml/lexer.ml"
-
-  | __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf;
-      __ocaml_lex_quoted_string_rec delim lexbuf __ocaml_lex_state
-
-and skip_hash_bang lexbuf =
-   __ocaml_lex_skip_hash_bang_rec lexbuf 205
-and __ocaml_lex_skip_hash_bang_rec lexbuf __ocaml_lex_state =
-  match Lexing.engine __ocaml_lex_tables __ocaml_lex_state lexbuf with
-      | 0 ->
-# 674 "ml/lexer.mll"
-       ( update_loc lexbuf None 3 false 0 )
-# 2411 "ml/lexer.ml"
-
-  | 1 ->
-# 676 "ml/lexer.mll"
-       ( update_loc lexbuf None 1 false 0 )
-# 2416 "ml/lexer.ml"
-
-  | 2 ->
-# 677 "ml/lexer.mll"
-       ( () )
-# 2421 "ml/lexer.ml"
-
-  | __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf;
-      __ocaml_lex_skip_hash_bang_rec lexbuf __ocaml_lex_state
-
-;;
-
-# 679 "ml/lexer.mll"
- 
-  let token_with_comments lexbuf =
-    match !preprocessor with
-    | None -> token lexbuf
-    | Some (_init, preprocess) -> preprocess token lexbuf
-
-  type newline_state =
-    | NoLine (* There have been no blank lines yet. *)
-    | NewLine
-        (* There have been no blank lines, and the previous
-           token was a newline. *)
-    | BlankLine (* There have been blank lines. *)
-
-  type doc_state =
-    | Initial  (* There have been no docstrings yet *)
-    | After of docstring list
-        (* There have been docstrings, none of which were
-           preceded by a blank line *)
-    | Before of docstring list * docstring list * docstring list
-        (* There have been docstrings, some of which were
-           preceded by a blank line *)
-
-  and docstring = Docstrings.docstring
-
-  let token lexbuf =
-    let post_pos = lexeme_end_p lexbuf in
-    let attach lines docs pre_pos =
-      let open Docstrings in
-        match docs, lines with
-        | Initial, _ -> ()
-        | After a, (NoLine | NewLine) ->
-            set_post_docstrings post_pos (List.rev a);
-            set_pre_docstrings pre_pos a;
-        | After a, BlankLine ->
-            set_post_docstrings post_pos (List.rev a);
-            set_pre_extra_docstrings pre_pos (List.rev a)
-        | Before(a, f, b), (NoLine | NewLine) ->
-            set_post_docstrings post_pos (List.rev a);
-            set_post_extra_docstrings post_pos
-              (List.rev_append f (List.rev b));
-            set_floating_docstrings pre_pos (List.rev f);
-            set_pre_extra_docstrings pre_pos (List.rev a);
-            set_pre_docstrings pre_pos b
-        | Before(a, f, b), BlankLine ->
-            set_post_docstrings post_pos (List.rev a);
-            set_post_extra_docstrings post_pos
-              (List.rev_append f (List.rev b));
-            set_floating_docstrings pre_pos
-              (List.rev_append f (List.rev b));
-            set_pre_extra_docstrings pre_pos (List.rev a)
-    in
-    let rec loop lines docs lexbuf =
-      match token_with_comments lexbuf with
-      | COMMENT (s, loc) ->
-          add_comment (s, loc);
-          let lines' =
-            match lines with
-            | NoLine -> NoLine
-            | NewLine -> NoLine
-            | BlankLine -> BlankLine
-          in
-          loop lines' docs lexbuf
-      | EOL ->
-          let lines' =
-            match lines with
-            | NoLine -> NewLine
-            | NewLine -> BlankLine
-            | BlankLine -> BlankLine
-          in
-          loop lines' docs lexbuf
-      | HASH when Rescript_cpp.at_bol lexbuf -> 
-          Rescript_cpp.interpret_directive lexbuf 
-            ~cont:(fun lexbuf -> loop lines docs lexbuf)
-            ~token_with_comments
-      | DOCSTRING doc ->
-          Docstrings.register doc;
-          add_docstring_comment doc;
-          let docs' =
-            if Docstrings.docstring_body doc = "/*" then
-              match docs with
-              | Initial -> Before([], [doc], [])
-              | After a -> Before (a, [doc], [])
-              | Before(a, f, b) -> Before(a, doc :: b @ f, [])
-            else
-              match docs, lines with
-              | Initial, (NoLine | NewLine) -> After [doc]
-              | Initial, BlankLine -> Before([], [], [doc])
-              | After a, (NoLine | NewLine) -> After (doc :: a)
-              | After a, BlankLine -> Before (a, [], [doc])
-              | Before(a, f, b), (NoLine | NewLine) -> Before(a, f, doc :: b)
-              | Before(a, f, b), BlankLine -> Before(a, b @ f, [doc])
-          in
-          loop NoLine docs' lexbuf
-      | tok ->
-          attach lines docs (lexeme_start_p lexbuf);
-          tok
-    in
-    Rescript_cpp.check_sharp_look_ahead (fun _ -> loop NoLine Initial lexbuf)
-
-  let init () =
-    Rescript_cpp.init ();
-    is_in_string := false;
-    comment_start_loc := [];
-    comment_list := [];
-    match !preprocessor with
-    | None -> ()
-    | Some (init, _preprocess) -> init ()
-
+         ( MINUSGREATER )
+# 1888 "ml/lexer.ml"
 
-  let set_preprocessor init preprocess =
-    escaped_newlines := true;
-    preprocessor := Some (init, preprocess)
+  | 41 ->
+# 454 "ml/lexer.mll"
+         ( DOT )
+# 1893 "ml/lexer.ml"
 
+  | 42 ->
+# 455 "ml/lexer.mll"
+         ( DOTDOT )
+# 1898 "ml/lexer.ml"
 
-# 2543 "ml/lexer.ml"
+  | 43 ->
+let
+# 456 "ml/lexer.mll"
+                                      s
+# 1904 "ml/lexer.ml"
+= Lexing.sub_lexeme lexbuf (lexbuf.Lexing.lex_start_pos + 1) lexbuf.Lexing.lex_curr_pos in
+# 456 "ml/lexer.mll"
+                                         ( DOTOP s )
+# 1908 "ml/lexer.ml"
 
-end
-module Parse : sig 
-#1 "parse.mli"
-(**************************************************************************)
-(*                                                                        *)
-(*                                 OCaml                                  *)
-(*                                                                        *)
-(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
-(*                                                                        *)
-(*   Copyright 1996 Institut National de Recherche en Informatique et     *)
-(*     en Automatique.                                                    *)
-(*                                                                        *)
-(*   All rights reserved.  This file is distributed under the terms of    *)
-(*   the GNU Lesser General Public License version 2.1, with the          *)
-(*   special exception on linking described in the file LICENSE.          *)
-(*                                                                        *)
-(**************************************************************************)
+  | 44 ->
+# 457 "ml/lexer.mll"
+         ( COLON )
+# 1913 "ml/lexer.ml"
 
-(** Entry points in the parser *)
+  | 45 ->
+# 458 "ml/lexer.mll"
+         ( COLONCOLON )
+# 1918 "ml/lexer.ml"
 
-val implementation : Lexing.lexbuf -> Parsetree.structure
-val interface : Lexing.lexbuf -> Parsetree.signature
-val core_type : Lexing.lexbuf -> Parsetree.core_type
-val expression : Lexing.lexbuf -> Parsetree.expression
-val pattern : Lexing.lexbuf -> Parsetree.pattern
+  | 46 ->
+# 459 "ml/lexer.mll"
+         ( COLONEQUAL )
+# 1923 "ml/lexer.ml"
 
-end = struct
-#1 "parse.ml"
-(**************************************************************************)
-(*                                                                        *)
-(*                                 OCaml                                  *)
-(*                                                                        *)
-(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
-(*                                                                        *)
-(*   Copyright 1996 Institut National de Recherche en Informatique et     *)
-(*     en Automatique.                                                    *)
-(*                                                                        *)
-(*   All rights reserved.  This file is distributed under the terms of    *)
-(*   the GNU Lesser General Public License version 2.1, with the          *)
-(*   special exception on linking described in the file LICENSE.          *)
-(*                                                                        *)
-(**************************************************************************)
+  | 47 ->
+# 460 "ml/lexer.mll"
+         ( COLONGREATER )
+# 1928 "ml/lexer.ml"
 
-(* Entry points in the parser *)
+  | 48 ->
+# 461 "ml/lexer.mll"
+         ( SEMI )
+# 1933 "ml/lexer.ml"
 
+  | 49 ->
+# 462 "ml/lexer.mll"
+         ( SEMISEMI )
+# 1938 "ml/lexer.ml"
 
-let wrap parsing_fun lexbuf =
-  try
-    Docstrings.init ();
-    Lexer.init ();
-    let ast = parsing_fun Lexer.token lexbuf in
-    Parsing.clear_parser();
-    Docstrings.warn_bad_docstrings ();
-    ast
-  with
-  | Parsing.Parse_error | Syntaxerr.Escape_error ->
-      let loc = Location.curr lexbuf in
-      raise(Syntaxerr.Error(Syntaxerr.Other loc))
+  | 50 ->
+# 463 "ml/lexer.mll"
+         ( LESS )
+# 1943 "ml/lexer.ml"
 
-let implementation = wrap Parser.implementation
-and interface = wrap Parser.interface
-and core_type = wrap Parser.parse_core_type
-and expression = wrap Parser.parse_expression
-and pattern = wrap Parser.parse_pattern
+  | 51 ->
+# 464 "ml/lexer.mll"
+         ( LESSMINUS )
+# 1948 "ml/lexer.ml"
 
-end
-module Pprintast : sig 
-#1 "pprintast.mli"
-(**************************************************************************)
-(*                                                                        *)
-(*                                 OCaml                                  *)
-(*                                                                        *)
-(*             Hongbo Zhang (University of Pennsylvania)                  *)
-(*                                                                        *)
-(*   Copyright 1996 Institut National de Recherche en Informatique et     *)
-(*     en Automatique.                                                    *)
-(*                                                                        *)
-(*   All rights reserved.  This file is distributed under the terms of    *)
-(*   the GNU Lesser General Public License version 2.1, with the          *)
-(*   special exception on linking described in the file LICENSE.          *)
-(*                                                                        *)
-(**************************************************************************)
+  | 52 ->
+# 465 "ml/lexer.mll"
+         ( EQUAL )
+# 1953 "ml/lexer.ml"
 
-type space_formatter = (unit, Format.formatter, unit) format
+  | 53 ->
+# 466 "ml/lexer.mll"
+         ( LBRACKET )
+# 1958 "ml/lexer.ml"
 
+  | 54 ->
+# 467 "ml/lexer.mll"
+         ( LBRACKETBAR )
+# 1963 "ml/lexer.ml"
 
-val expression : Format.formatter -> Parsetree.expression -> unit
-val string_of_expression : Parsetree.expression -> string
+  | 55 ->
+# 468 "ml/lexer.mll"
+         ( LBRACKETLESS )
+# 1968 "ml/lexer.ml"
 
-val core_type: Format.formatter -> Parsetree.core_type -> unit
-val pattern: Format.formatter -> Parsetree.pattern -> unit
-val signature: Format.formatter -> Parsetree.signature -> unit
-val structure: Format.formatter -> Parsetree.structure -> unit
-val string_of_structure: Parsetree.structure -> string
+  | 56 ->
+# 469 "ml/lexer.mll"
+         ( LBRACKETGREATER )
+# 1973 "ml/lexer.ml"
 
-end = struct
-#1 "pprintast.pp.ml"
-(**************************************************************************)
-(*                                                                        *)
-(*                                 OCaml                                  *)
-(*                                                                        *)
-(*                      Thomas Gazagnaire, OCamlPro                       *)
-(*                   Fabrice Le Fessant, INRIA Saclay                     *)
-(*               Hongbo Zhang, University of Pennsylvania                 *)
-(*                                                                        *)
-(*   Copyright 2007 Institut National de Recherche en Informatique et     *)
-(*     en Automatique.                                                    *)
-(*                                                                        *)
-(*   All rights reserved.  This file is distributed under the terms of    *)
-(*   the GNU Lesser General Public License version 2.1, with the          *)
-(*   special exception on linking described in the file LICENSE.          *)
-(*                                                                        *)
-(**************************************************************************)
+  | 57 ->
+# 470 "ml/lexer.mll"
+         ( RBRACKET )
+# 1978 "ml/lexer.ml"
 
-(* Original Code from Ber-metaocaml, modified for 3.12.0 and fixed *)
-(* Printing code expressions *)
-(* Authors:  Ed Pizzi, Fabrice Le Fessant *)
-(* Extensive Rewrite: Hongbo Zhang: University of Pennsylvania *)
-(* TODO more fine-grained precedence pretty-printing *)
+  | 58 ->
+# 471 "ml/lexer.mll"
+         ( LBRACE )
+# 1983 "ml/lexer.ml"
 
-open Asttypes
-open Format
-open Location
-open Longident
-open Parsetree
-open Ast_helper
+  | 59 ->
+# 472 "ml/lexer.mll"
+         ( LBRACELESS )
+# 1988 "ml/lexer.ml"
 
-let prefix_symbols  = [ '!'; '?'; '~' ] ;;
-let infix_symbols = [ '='; '<'; '>'; '@'; '^'; '|'; '&'; '+'; '-'; '*'; '/';
-                      '$'; '%'; '#' ]
+  | 60 ->
+# 473 "ml/lexer.mll"
+         ( BAR )
+# 1993 "ml/lexer.ml"
 
-(* type fixity = Infix| Prefix  *)
-let special_infix_strings =
-  ["asr"; "land"; "lor"; "lsl"; "lsr"; "lxor"; "mod"; "or"; ":="; "!="; "::" ]
+  | 61 ->
+# 474 "ml/lexer.mll"
+         ( BARBAR )
+# 1998 "ml/lexer.ml"
 
-(* determines if the string is an infix string.
-   checks backwards, first allowing a renaming postfix ("_102") which
-   may have resulted from Pexp -> Texp -> Pexp translation, then checking
-   if all the characters in the beginning of the string are valid infix
-   characters. *)
-let fixity_of_string  = function
-  | s when List.mem s special_infix_strings -> `Infix s
-  | s when List.mem s.[0] infix_symbols -> `Infix s
-  | s when List.mem s.[0] prefix_symbols -> `Prefix s
-  | s when s.[0] = '.' -> `Mixfix s
-  | _ -> `Normal
+  | 62 ->
+# 475 "ml/lexer.mll"
+         ( BARRBRACKET )
+# 2003 "ml/lexer.ml"
 
-let view_fixity_of_exp = function
-  | {pexp_desc = Pexp_ident {txt=Lident l;_}; pexp_attributes = []} ->
-      fixity_of_string l
-  | _ -> `Normal
+  | 63 ->
+# 476 "ml/lexer.mll"
+         ( GREATER )
+# 2008 "ml/lexer.ml"
 
-let is_infix  = function  | `Infix _ -> true | _  -> false
-let is_mixfix = function `Mixfix _ -> true | _ -> false
+  | 64 ->
+# 477 "ml/lexer.mll"
+         ( GREATERRBRACKET )
+# 2013 "ml/lexer.ml"
 
-(* which identifiers are in fact operators needing parentheses *)
-let needs_parens txt =
-  let fix = fixity_of_string txt in
-  is_infix fix
-  || is_mixfix fix
-  || List.mem txt.[0] prefix_symbols
+  | 65 ->
+# 478 "ml/lexer.mll"
+         ( RBRACE )
+# 2018 "ml/lexer.ml"
 
-(* some infixes need spaces around parens to avoid clashes with comment
-   syntax *)
-let needs_spaces txt =
-  txt.[0]='*' || txt.[String.length txt - 1] = '*'
+  | 66 ->
+# 479 "ml/lexer.mll"
+         ( GREATERRBRACE )
+# 2023 "ml/lexer.ml"
 
-(* add parentheses to binders when they are in fact infix or prefix operators *)
-let protect_ident ppf txt =
-  let format : (_, _, _) format =
-    if not (needs_parens txt) then "%s"
-    else if needs_spaces txt then "(@;%s@;)"
-    else "(%s)"
-  in fprintf ppf format txt
+  | 67 ->
+# 480 "ml/lexer.mll"
+         ( LBRACKETAT )
+# 2028 "ml/lexer.ml"
 
-let protect_longident ppf print_longident longprefix txt =
-  let format : (_, _, _) format =
-    if not (needs_parens txt) then "%a.%s"
-    else if needs_spaces txt then  "%a.(@;%s@;)"
-    else "%a.(%s)" in
-  fprintf ppf format print_longident longprefix txt
+  | 68 ->
+# 481 "ml/lexer.mll"
+           ( LBRACKETATAT )
+# 2033 "ml/lexer.ml"
 
-type space_formatter = (unit, Format.formatter, unit) format
+  | 69 ->
+# 482 "ml/lexer.mll"
+           ( LBRACKETATATAT )
+# 2038 "ml/lexer.ml"
 
-let override = function
-  | Override -> "!"
-  | Fresh -> ""
+  | 70 ->
+# 483 "ml/lexer.mll"
+           ( LBRACKETPERCENT )
+# 2043 "ml/lexer.ml"
 
-(* variance encoding: need to sync up with the [parser.mly] *)
-let type_variance = function
-  | Invariant -> ""
-  | Covariant -> "+"
-  | Contravariant -> "-"
+  | 71 ->
+# 484 "ml/lexer.mll"
+           ( LBRACKETPERCENTPERCENT )
+# 2048 "ml/lexer.ml"
 
-type construct =
-  [ `cons of expression list
-  | `list of expression list
-  | `nil
-  | `normal
-  | `simple of Longident.t
-  | `tuple ]
+  | 72 ->
+# 485 "ml/lexer.mll"
+         ( BANG )
+# 2053 "ml/lexer.ml"
 
-let view_expr x =
-  match x.pexp_desc with
-  | Pexp_construct ( {txt= Lident "()"; _},_) -> `tuple
-  | Pexp_construct ( {txt= Lident "[]";_},_) -> `nil
-  | Pexp_construct ( {txt= Lident"::";_},Some _) ->
-      let rec loop exp acc = match exp with
-          | {pexp_desc=Pexp_construct ({txt=Lident "[]";_},_);
-             pexp_attributes = []} ->
-              (List.rev acc,true)
-          | {pexp_desc=
-             Pexp_construct ({txt=Lident "::";_},
-                             Some ({pexp_desc= Pexp_tuple([e1;e2]);
-                                    pexp_attributes = []}));
-             pexp_attributes = []}
-            ->
-              loop e2 (e1::acc)
-          | e -> (List.rev (e::acc),false) in
-      let (ls,b) = loop x []  in
-      if b then
-        `list ls
-      else `cons ls
-  | Pexp_construct (x,None) -> `simple (x.txt)
-  | _ -> `normal
+  | 73 ->
+# 486 "ml/lexer.mll"
+         ( INFIXOP0 "!=" )
+# 2058 "ml/lexer.ml"
 
-let is_simple_construct :construct -> bool = function
-  | `nil | `tuple | `list _ | `simple _  -> true
-  | `cons _ | `normal -> false
+  | 74 ->
+# 487 "ml/lexer.mll"
+         ( PLUS )
+# 2063 "ml/lexer.ml"
 
-let pp = fprintf
+  | 75 ->
+# 488 "ml/lexer.mll"
+         ( PLUSDOT )
+# 2068 "ml/lexer.ml"
 
-type ctxt = {
-  pipe : bool;
-  semi : bool;
-  ifthenelse : bool;
-}
+  | 76 ->
+# 489 "ml/lexer.mll"
+         ( PLUSEQ )
+# 2073 "ml/lexer.ml"
 
-let reset_ctxt = { pipe=false; semi=false; ifthenelse=false }
-let under_pipe ctxt = { ctxt with pipe=true }
-let under_semi ctxt = { ctxt with semi=true }
-let under_ifthenelse ctxt = { ctxt with ifthenelse=true }
-(*
-let reset_semi ctxt = { ctxt with semi=false }
-let reset_ifthenelse ctxt = { ctxt with ifthenelse=false }
-let reset_pipe ctxt = { ctxt with pipe=false }
-*)
+  | 77 ->
+# 490 "ml/lexer.mll"
+         ( MINUS )
+# 2078 "ml/lexer.ml"
 
-let list : 'a . ?sep:space_formatter -> ?first:space_formatter ->
-  ?last:space_formatter -> (Format.formatter -> 'a -> unit) ->
-  Format.formatter -> 'a list -> unit
-  = fun ?sep ?first ?last fu f xs ->
-    let first = match first with Some x -> x |None -> ("": _ format6)
-    and last = match last with Some x -> x |None -> ("": _ format6)
-    and sep = match sep with Some x -> x |None -> ("@ ": _ format6) in
-    let aux f = function
-      | [] -> ()
-      | [x] -> fu f x
-      | xs ->
-          let rec loop  f = function
-            | [x] -> fu f x
-            | x::xs ->  fu f x; pp f sep; loop f xs;
-            | _ -> assert false in begin
-            pp f first; loop f xs; pp f last;
-          end in
-    aux f xs
+  | 78 ->
+# 491 "ml/lexer.mll"
+         ( MINUSDOT )
+# 2083 "ml/lexer.ml"
 
-let option : 'a. ?first:space_formatter -> ?last:space_formatter ->
-  (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a option -> unit
-  = fun  ?first  ?last fu f a ->
-    let first = match first with Some x -> x | None -> ("": _ format6)
-    and last = match last with Some x -> x | None -> ("": _ format6) in
-    match a with
-    | None -> ()
-    | Some x -> pp f first; fu f x; pp f last
+  | 79 ->
+# 494 "ml/lexer.mll"
+            ( PREFIXOP(Lexing.lexeme lexbuf) )
+# 2088 "ml/lexer.ml"
 
-let paren: 'a . ?first:space_formatter -> ?last:space_formatter ->
-  bool -> (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a -> unit
-  = fun  ?(first=("": _ format6)) ?(last=("": _ format6)) b fu f x ->
-    if b then (pp f "("; pp f first; fu f x; pp f last; pp f ")")
-    else fu f x
+  | 80 ->
+# 496 "ml/lexer.mll"
+            ( PREFIXOP(Lexing.lexeme lexbuf) )
+# 2093 "ml/lexer.ml"
 
-let rec longident f = function
-  | Lident s -> protect_ident f s
-  | Ldot(y,s) -> protect_longident f longident y s
-  | Lapply (y,s) ->
-      pp f "%a(%a)" longident y longident s
+  | 81 ->
+# 498 "ml/lexer.mll"
+            ( INFIXOP0(Lexing.lexeme lexbuf) )
+# 2098 "ml/lexer.ml"
 
-let longident_loc f x = pp f "%a" longident x.txt
+  | 82 ->
+# 500 "ml/lexer.mll"
+            ( INFIXOP1(Lexing.lexeme lexbuf) )
+# 2103 "ml/lexer.ml"
 
-let constant f = function
-  | Pconst_char i -> pp f "%C"  i
-  | Pconst_string (i, None) -> pp f "%S" i
-  | Pconst_string (i, Some delim) -> pp f "{%s|%s|%s}" delim i delim
-  | Pconst_integer (i, None) -> paren (i.[0]='-') (fun f -> pp f "%s") f i
-  | Pconst_integer (i, Some m) ->
-    paren (i.[0]='-') (fun f (i, m) -> pp f "%s%c" i m) f (i,m)
-  | Pconst_float (i, None) -> paren (i.[0]='-') (fun f -> pp f "%s") f i
-  | Pconst_float (i, Some m) -> paren (i.[0]='-') (fun f (i,m) ->
-      pp f "%s%c" i m) f (i,m)
+  | 83 ->
+# 502 "ml/lexer.mll"
+            ( INFIXOP2(Lexing.lexeme lexbuf) )
+# 2108 "ml/lexer.ml"
 
-(* trailing space*)
-let mutable_flag f = function
-  | Immutable -> ()
-  | Mutable -> pp f "mutable@;"
-let virtual_flag f  = function
-  | Concrete -> ()
-  | Virtual -> pp f "virtual@;"
+  | 84 ->
+# 504 "ml/lexer.mll"
+            ( INFIXOP4(Lexing.lexeme lexbuf) )
+# 2113 "ml/lexer.ml"
 
-(* trailing space added *)
-let rec_flag f rf =
-  match rf with
-  | Nonrecursive -> ()
-  | Recursive -> pp f "rec "
-let nonrec_flag f rf =
-  match rf with
-  | Nonrecursive -> pp f "nonrec "
-  | Recursive -> ()
-let direction_flag f = function
-  | Upto -> pp f "to@ "
-  | Downto -> pp f "downto@ "
-let private_flag f = function
-  | Public -> ()
-  | Private -> pp f "private@ "
+  | 85 ->
+# 505 "ml/lexer.mll"
+            ( PERCENT )
+# 2118 "ml/lexer.ml"
 
-let constant_string f s = pp f "%S" s
-let tyvar f str = pp f "'%s" str
-let tyvar_loc f str = pp f "'%s" str.txt
-let string_quot f x = pp f "`%s" x
+  | 86 ->
+# 507 "ml/lexer.mll"
+            ( INFIXOP3(Lexing.lexeme lexbuf) )
+# 2123 "ml/lexer.ml"
 
-(* c ['a,'b] *)
-let rec class_params_def ctxt f =  function
-  | [] -> ()
-  | l ->
-      pp f "[%a] " (* space *)
-        (list (type_param ctxt) ~sep:",") l
+  | 87 ->
+# 509 "ml/lexer.mll"
+            ( HASHOP(Lexing.lexeme lexbuf) )
+# 2128 "ml/lexer.ml"
 
-and type_with_label ctxt f (label, c) =
-  match label with
-  | Nolabel    -> core_type1 ctxt f c (* otherwise parenthesize *)
-  | Labelled s -> pp f "%s:%a" s (core_type1 ctxt) c
-  | Optional s -> pp f "?%s:%a" s (core_type1 ctxt) c
+  | 88 ->
+# 510 "ml/lexer.mll"
+        ( Rescript_cpp.eof_check lexbuf; EOF)
+# 2133 "ml/lexer.ml"
 
-and core_type ctxt f x =
-  if x.ptyp_attributes <> [] then begin
-    pp f "((%a)%a)" (core_type ctxt) {x with ptyp_attributes=[]}
-      (attributes ctxt) x.ptyp_attributes
-  end
-  else match x.ptyp_desc with
-    | Ptyp_arrow (l, ct1, ct2) ->
-        pp f "@[<2>%a@;->@;%a@]" (* FIXME remove parens later *)
-          (type_with_label ctxt) (l,ct1) (core_type ctxt) ct2
-    | Ptyp_alias (ct, s) ->
-        pp f "@[<2>%a@;as@;'%s@]" (core_type1 ctxt) ct s
-    | Ptyp_poly ([], ct) ->
-        core_type ctxt f ct
-    | Ptyp_poly (sl, ct) ->
-        pp f "@[<2>%a%a@]"
-          (fun f l ->
-             pp f "%a"
-               (fun f l -> match l with
-                  | [] -> ()
-                  | _ ->
-                      pp f "%a@;.@;"
-                        (list tyvar_loc ~sep:"@;")  l)
-               l)
-          sl (core_type ctxt) ct
-    | _ -> pp f "@[<2>%a@]" (core_type1 ctxt) x
+  | 89 ->
+# 512 "ml/lexer.mll"
+      ( raise (Error(Illegal_character (Lexing.lexeme_char lexbuf 0),
+                     Location.curr lexbuf))
+      )
+# 2140 "ml/lexer.ml"
 
-and core_type1 ctxt f x =
-  if x.ptyp_attributes <> [] then core_type ctxt f x
-  else match x.ptyp_desc with
-    | Ptyp_any -> pp f "_";
-    | Ptyp_var s -> tyvar f  s;
-    | Ptyp_tuple l ->  pp f "(%a)" (list (core_type1 ctxt) ~sep:"@;*@;") l
-    | Ptyp_constr (li, l) ->
-        pp f (* "%a%a@;" *) "%a%a"
-          (fun f l -> match l with
-             |[] -> ()
-             |[x]-> pp f "%a@;" (core_type1 ctxt)  x
-             | _ -> list ~first:"(" ~last:")@;" (core_type ctxt) ~sep:",@;" f l)
-          l longident_loc li
-    | Ptyp_variant (l, closed, low) ->
-        let type_variant_helper f x =
-          match x with
-          | Rtag (l, attrs, _, ctl) ->
-              pp f "@[<2>%a%a@;%a@]" string_quot l.txt
-                (fun f l -> match l with
-                   |[] -> ()
-                   | _ -> pp f "@;of@;%a"
-                            (list (core_type ctxt) ~sep:"&")  ctl) ctl
-                (attributes ctxt) attrs
-          | Rinherit ct -> core_type ctxt f ct in
-        pp f "@[<2>[%a%a]@]"
-          (fun f l ->
-             match l, closed with
-             | [], Closed -> ()
-             | [], Open -> pp f ">" (* Cf #7200: print [>] correctly *)
-             | _ ->
-                 pp f "%s@;%a"
-                   (match (closed,low) with
-                    | (Closed,None) -> ""
-                    | (Closed,Some _) -> "<" (* FIXME desugar the syntax sugar*)
-                    | (Open,_) -> ">")
-                   (list type_variant_helper ~sep:"@;<1 -2>| ") l) l
-          (fun f low -> match low with
-             |Some [] |None -> ()
-             |Some xs ->
-                 pp f ">@ %a"
-                   (list string_quot) xs) low
-    | Ptyp_object (l, o) ->
-        let core_field_type f = function
-          | Otag (l, attrs, ct) ->
-            pp f "@[<hov2>%s: %a@ %a@ @]" l.txt
-              (core_type ctxt) ct (attributes ctxt) attrs (* Cf #7200 *)
-          | Oinherit ct ->
-            pp f "@[<hov2>%a@ @]" (core_type ctxt) ct
-        in
-        let field_var f = function
-          | Asttypes.Closed -> ()
-          | Asttypes.Open ->
-              match l with
-              | [] -> pp f ".."
-              | _ -> pp f " ;.."
-        in
-        pp f "@[<hov2><@ %a%a@ > @]" (list core_field_type ~sep:";") l
-          field_var o (* Cf #7200 *)
-    | Ptyp_class (li, l) ->   (*FIXME*)
-        pp f "@[<hov2>%a#%a@]"
-          (list (core_type ctxt) ~sep:"," ~first:"(" ~last:")") l
-          longident_loc li
-    | Ptyp_package (lid, cstrs) ->
-        let aux f (s, ct) =
-          pp f "type %a@ =@ %a" longident_loc s (core_type ctxt) ct  in
-        (match cstrs with
-         |[] -> pp f "@[<hov2>(module@ %a)@]" longident_loc lid
-         |_ ->
-             pp f "@[<hov2>(module@ %a@ with@ %a)@]" longident_loc lid
-               (list aux  ~sep:"@ and@ ")  cstrs)
-    | Ptyp_extension e -> extension ctxt f e
-    | _ -> paren true (core_type ctxt) f x
+  | __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf;
+      __ocaml_lex_token_rec lexbuf __ocaml_lex_state
 
-(********************pattern********************)
-(* be cautious when use [pattern], [pattern1] is preferred *)
-and pattern ctxt f x =
-  let rec list_of_pattern acc = function (* only consider ((A|B)|C)*)
-    | {ppat_desc= Ppat_or (p1,p2); ppat_attributes = []} ->
-        list_of_pattern  (p2::acc) p1
-    | x -> x::acc
-  in
-  if x.ppat_attributes <> [] then begin
-    pp f "((%a)%a)" (pattern ctxt) {x with ppat_attributes=[]}
-      (attributes ctxt) x.ppat_attributes
-  end
-  else match x.ppat_desc with
-    | Ppat_alias (p, s) ->
-        pp f "@[<2>%a@;as@;%a@]" (pattern ctxt) p protect_ident s.txt (* RA*)
-    | Ppat_or _ -> (* *)
-        pp f "@[<hov0>%a@]" (list ~sep:"@,|" (pattern ctxt))
-          (list_of_pattern [] x)
-    | _ -> pattern1 ctxt f x
+and comment lexbuf =
+   __ocaml_lex_comment_rec lexbuf 137
+and __ocaml_lex_comment_rec lexbuf __ocaml_lex_state =
+  match Lexing.engine __ocaml_lex_tables __ocaml_lex_state lexbuf with
+      | 0 ->
+# 518 "ml/lexer.mll"
+      ( comment_start_loc := (Location.curr lexbuf) :: !comment_start_loc;
+        store_lexeme lexbuf;
+        comment lexbuf
+      )
+# 2155 "ml/lexer.ml"
 
-and pattern1 ctxt (f:Format.formatter) (x:pattern) : unit =
-  let rec pattern_list_helper f = function
-    | {ppat_desc =
-         Ppat_construct
-           ({ txt = Lident("::") ;_},
-            Some ({ppat_desc = Ppat_tuple([pat1; pat2]);_}));
-       ppat_attributes = []}
+  | 1 ->
+# 523 "ml/lexer.mll"
+      ( match !comment_start_loc with
+        | [] -> assert false
+        | [_] -> comment_start_loc := []; Location.curr lexbuf
+        | _ :: l -> comment_start_loc := l;
+                  store_lexeme lexbuf;
+                  comment lexbuf
+       )
+# 2166 "ml/lexer.ml"
 
-      ->
-        pp f "%a::%a" (simple_pattern ctxt) pat1 pattern_list_helper pat2 (*RA*)
-    | p -> pattern1 ctxt f p
-  in
-  if x.ppat_attributes <> [] then pattern ctxt f x
-  else match x.ppat_desc with
-    | Ppat_variant (l, Some p) ->
-        pp f "@[<2>`%s@;%a@]" l (simple_pattern ctxt) p
-    | Ppat_construct (({txt=Lident("()"|"[]");_}), _) -> simple_pattern ctxt f x
-    | Ppat_construct (({txt;_} as li), po) ->
-        (* FIXME The third field always false *)
-        if txt = Lident "::" then
-          pp f "%a" pattern_list_helper x
-        else
-          (match po with
-           | Some x -> pp f "%a@;%a"  longident_loc li (simple_pattern ctxt) x
-           | None -> pp f "%a" longident_loc li)
-    | _ -> simple_pattern ctxt f x
+  | 2 ->
+# 531 "ml/lexer.mll"
+      (
+        string_start_loc := Location.curr lexbuf;
+        store_string_char '\"';
+        is_in_string := true;
+        begin try string lexbuf
+        with Error (Unterminated_string, str_start) ->
+          match !comment_start_loc with
+          | [] -> assert false
+          | loc :: _ ->
+            let start = List.hd (List.rev !comment_start_loc) in
+            comment_start_loc := [];
+            raise (Error (Unterminated_string_in_comment (start, str_start),
+                          loc))
+        end;
+        is_in_string := false;
+        store_string_char '\"';
+        comment lexbuf )
+# 2187 "ml/lexer.ml"
 
-and simple_pattern ctxt (f:Format.formatter) (x:pattern) : unit =
-  if x.ppat_attributes <> [] then pattern ctxt f x
-  else match x.ppat_desc with
-    | Ppat_construct (({txt=Lident ("()"|"[]" as x);_}), _) -> pp f  "%s" x
-    | Ppat_any -> pp f "_";
-    | Ppat_var ({txt = txt;_}) -> protect_ident f txt
-    | Ppat_array l ->
-        pp f "@[<2>[|%a|]@]"  (list (pattern1 ctxt) ~sep:";") l
-    | Ppat_unpack (s) ->
-        pp f "(module@ %s)@ " s.txt
-    | Ppat_type li ->
-        pp f "#%a" longident_loc li
-    | Ppat_record (l, closed) ->
-        let longident_x_pattern f (li, p) =
-          match (li,p) with
-          | ({txt=Lident s;_ },
-             {ppat_desc=Ppat_var {txt;_};
-              ppat_attributes=[]; _})
-            when s = txt ->
-              pp f "@[<2>%a@]"  longident_loc li
-          | _ ->
-              pp f "@[<2>%a@;=@;%a@]" longident_loc li (pattern1 ctxt) p
-        in
-        begin match closed with
-        | Closed ->
-            pp f "@[<2>{@;%a@;}@]" (list longident_x_pattern ~sep:";@;") l
-        | _ ->
-            pp f "@[<2>{@;%a;_}@]" (list longident_x_pattern ~sep:";@;") l
-        end
-    | Ppat_tuple l ->
-        pp f "@[<1>(%a)@]" (list  ~sep:",@;" (pattern1 ctxt))  l (* level1*)
-    | Ppat_constant (c) -> pp f "%a" constant c
-    | Ppat_interval (c1, c2) -> pp f "%a..%a" constant c1 constant c2
-    | Ppat_variant (l,None) ->  pp f "`%s" l
-    | Ppat_constraint (p, ct) ->
-        pp f "@[<2>(%a@;:@;%a)@]" (pattern1 ctxt) p (core_type ctxt) ct
-    | Ppat_lazy p ->
-        pp f "@[<2>(lazy@;%a)@]" (pattern1 ctxt) p
-    | Ppat_exception p ->
-        pp f "@[<2>exception@;%a@]" (pattern1 ctxt) p
-    | Ppat_extension e -> extension ctxt f e
-    | Ppat_open (lid, p) ->
-        let with_paren =
-        match p.ppat_desc with
-        | Ppat_array _ | Ppat_record _
-        | Ppat_construct (({txt=Lident ("()"|"[]");_}), _) -> false
-        | _ -> true in
-        pp f "@[<2>%a.%a @]" longident_loc lid
-          (paren with_paren @@ pattern1 ctxt) p
-    | _ -> paren true (pattern ctxt) f x
+  | 3 ->
+# 549 "ml/lexer.mll"
+      (
+        let delim = Lexing.lexeme lexbuf in
+        let delim = String.sub delim 1 (String.length delim - 2) in
+        string_start_loc := Location.curr lexbuf;
+        store_lexeme lexbuf;
+        is_in_string := true;
+        begin try quoted_string delim lexbuf
+        with Error (Unterminated_string, str_start) ->
+          match !comment_start_loc with
+          | [] -> assert false
+          | loc :: _ ->
+            let start = List.hd (List.rev !comment_start_loc) in
+            comment_start_loc := [];
+            raise (Error (Unterminated_string_in_comment (start, str_start),
+                          loc))
+        end;
+        is_in_string := false;
+        store_string_char '|';
+        store_string delim;
+        store_string_char '}';
+        comment lexbuf )
+# 2212 "ml/lexer.ml"
 
-and label_exp ctxt f (l,opt,p) =
-  match l with
-  | Nolabel ->
-      (* single case pattern parens needed here *)
-      pp f "%a@ " (simple_pattern ctxt) p
-  | Optional rest ->
-      begin match p with
-      | {ppat_desc = Ppat_var {txt;_}; ppat_attributes = []}
-        when txt = rest ->
-          (match opt with
-           | Some o -> pp f "?(%s=@;%a)@;" rest  (expression ctxt) o
-           | None -> pp f "?%s@ " rest)
-      | _ ->
-          (match opt with
-           | Some o ->
-               pp f "?%s:(%a=@;%a)@;"
-                 rest (pattern1 ctxt) p (expression ctxt) o
-           | None -> pp f "?%s:%a@;" rest (simple_pattern ctxt) p)
-      end
-  | Labelled l -> match p with
-    | {ppat_desc  = Ppat_var {txt;_}; ppat_attributes = []}
-      when txt = l ->
-        pp f "~%s@;" l
-    | _ ->  pp f "~%s:%a@;" l (simple_pattern ctxt) p
+  | 4 ->
+# 572 "ml/lexer.mll"
+      ( store_lexeme lexbuf; comment lexbuf )
+# 2217 "ml/lexer.ml"
 
-and sugar_expr ctxt f e =
-  if e.pexp_attributes <> [] then false
-  else match e.pexp_desc with
-  | Pexp_apply ({ pexp_desc = Pexp_ident {txt = id; _};
-                  pexp_attributes=[]; _}, args)
-    when List.for_all (fun (lab, _) -> lab = Nolabel) args -> begin
-      let print_indexop a path_prefix assign left right print_index indices
-          rem_args =
-        let print_path ppf = function
-          | None -> ()
-          | Some m -> pp ppf ".%a" longident m in
-        match assign, rem_args with
-            | false, [] ->
-              pp f "@[%a%a%s%a%s@]"
-                (simple_expr ctxt) a print_path path_prefix
-                left (list ~sep:"," print_index) indices right; true
-            | true, [v] ->
-              pp f "@[%a%a%s%a%s@ <-@;<1 2>%a@]"
-                (simple_expr ctxt) a print_path path_prefix
-                left (list ~sep:"," print_index) indices right
-                (simple_expr ctxt) v; true
-            | _ -> false in
-      match id, List.map snd args with
-      | Lident "!", [e] ->
-        pp f "@[<hov>!%a@]" (simple_expr ctxt) e; true
-      | Ldot (path, ("get"|"set" as func)), a :: other_args -> begin
-          let assign = func = "set" in
-          let print = print_indexop a None assign in
-          match path, other_args with
-          | Lident "Array", i :: rest ->
-            print ".(" ")" (expression ctxt) [i] rest
-          | Lident "String", i :: rest ->
-            print ".[" "]" (expression ctxt) [i] rest
-          | Ldot (Lident "Bigarray", "Array1"), i1 :: rest ->
-            print ".{" "}" (simple_expr ctxt) [i1] rest
-          | Ldot (Lident "Bigarray", "Array2"), i1 :: i2 :: rest ->
-            print ".{" "}" (simple_expr ctxt) [i1; i2] rest
-          | Ldot (Lident "Bigarray", "Array3"), i1 :: i2 :: i3 :: rest ->
-            print ".{" "}" (simple_expr ctxt) [i1; i2; i3] rest
-          | Ldot (Lident "Bigarray", "Genarray"),
-            {pexp_desc = Pexp_array indexes; pexp_attributes = []} :: rest ->
-              print ".{" "}" (simple_expr ctxt) indexes rest
-          | _ -> false
-        end
-      | (Lident s | Ldot(_,s)) , a :: i :: rest
-        when s.[0] = '.' ->
-          let n = String.length s in
-          (* extract operator:
-             assignment operators end with [right_bracket ^ "<-"],
-             access operators end with [right_bracket] directly
-          *)
-          let assign = s.[n - 1] = '-'  in
-          let kind =
-            (* extract the right end bracket *)
-            if assign then s.[n - 3] else s.[n - 1] in
-          let left, right = match kind with
-            | ')' -> '(', ")"
-            | ']' -> '[', "]"
-            | '}' -> '{', "}"
-            | _ -> assert false in
-          let path_prefix = match id with
-            | Ldot(m,_) -> Some m
-            | _ -> None in
-          let left = String.sub s 0 (1+String.index s left) in
-          print_indexop a path_prefix assign left right
-            (expression ctxt) [i] rest
-      | _ -> false
-    end
-  | _ -> false
+  | 5 ->
+# 574 "ml/lexer.mll"
+      ( update_loc lexbuf None 1 false 1;
+        store_lexeme lexbuf;
+        comment lexbuf
+      )
+# 2225 "ml/lexer.ml"
 
-and expression ctxt f x =
-  if x.pexp_attributes <> [] then
-    pp f "((%a)@,%a)" (expression ctxt) {x with pexp_attributes=[]}
-      (attributes ctxt) x.pexp_attributes
-  else match x.pexp_desc with
-    | Pexp_function _ | Pexp_fun _ | Pexp_match _ | Pexp_try _ | Pexp_sequence _
-      when ctxt.pipe || ctxt.semi ->
-        paren true (expression reset_ctxt) f x
-    | Pexp_ifthenelse _ | Pexp_sequence _ when ctxt.ifthenelse ->
-        paren true (expression reset_ctxt) f x
-    | Pexp_let _ | Pexp_letmodule _ | Pexp_open _ | Pexp_letexception _
-        when ctxt.semi ->
-        paren true (expression reset_ctxt) f x
-    | Pexp_fun (l, e0, p, e) ->
-        pp f "@[<2>fun@;%a->@;%a@]"
-          (label_exp ctxt) (l, e0, p)
-          (expression ctxt) e
-    | Pexp_function l ->
-        pp f "@[<hv>function%a@]" (case_list ctxt) l
-    | Pexp_match (e, l) ->
-        pp f "@[<hv0>@[<hv0>@[<2>match %a@]@ with@]%a@]"
-          (expression reset_ctxt) e (case_list ctxt) l
+  | 6 ->
+# 579 "ml/lexer.mll"
+      ( store_lexeme lexbuf; comment lexbuf )
+# 2230 "ml/lexer.ml"
 
-    | Pexp_try (e, l) ->
-        pp f "@[<0>@[<hv2>try@ %a@]@ @[<0>with%a@]@]"
-             (* "try@;@[<2>%a@]@\nwith@\n%a"*)
-          (expression reset_ctxt) e  (case_list ctxt) l
-    | Pexp_let (rf, l, e) ->
-        (* pp f "@[<2>let %a%a in@;<1 -2>%a@]"
-           (*no indentation here, a new line*) *)
-        (*   rec_flag rf *)
-        pp f "@[<2>%a in@;<1 -2>%a@]"
-          (bindings reset_ctxt) (rf,l)
-          (expression ctxt) e
-    | Pexp_apply (e, l) ->
-        begin if not (sugar_expr ctxt f x) then
-            match view_fixity_of_exp e with
-            | `Infix s ->
-                begin match l with
-                | [ (Nolabel, _) as arg1; (Nolabel, _) as arg2 ] ->
-                    (* FIXME associativity label_x_expression_param *)
-                    pp f "@[<2>%a@;%s@;%a@]"
-                      (label_x_expression_param reset_ctxt) arg1 s
-                      (label_x_expression_param ctxt) arg2
-                | _ ->
-                    pp f "@[<2>%a %a@]"
-                      (simple_expr ctxt) e
-                      (list (label_x_expression_param ctxt)) l
-                end
-            | `Prefix s ->
-                let s =
-                  if List.mem s ["~+";"~-";"~+.";"~-."] &&
-                   (match l with
-                    (* See #7200: avoid turning (~- 1) into (- 1) which is
-                       parsed as an int literal *)
-                    |[(_,{pexp_desc=Pexp_constant _})] -> false
-                    | _ -> true)
-                  then String.sub s 1 (String.length s -1)
-                  else s in
-                begin match l with
-                | [(Nolabel, x)] ->
-                  pp f "@[<2>%s@;%a@]" s (simple_expr ctxt) x
-                | _   ->
-                  pp f "@[<2>%a %a@]" (simple_expr ctxt) e
-                    (list (label_x_expression_param ctxt)) l
-                end
-            | _ ->
-                pp f "@[<hov2>%a@]" begin fun f (e,l) ->
-                  pp f "%a@ %a" (expression2 ctxt) e
-                    (list (label_x_expression_param reset_ctxt))  l
-                    (* reset here only because [function,match,try,sequence]
-                       are lower priority *)
-                end (e,l)
-        end
+  | 7 ->
+# 581 "ml/lexer.mll"
+      ( store_lexeme lexbuf; comment lexbuf )
+# 2235 "ml/lexer.ml"
 
-    | Pexp_construct (li, Some eo)
-      when not (is_simple_construct (view_expr x))-> (* Not efficient FIXME*)
-        (match view_expr x with
-         | `cons ls -> list (simple_expr ctxt) f ls ~sep:"@;::@;"
-         | `normal ->
-             pp f "@[<2>%a@;%a@]" longident_loc li
-               (simple_expr ctxt) eo
-         | _ -> assert false)
-    | Pexp_setfield (e1, li, e2) ->
-        pp f "@[<2>%a.%a@ <-@ %a@]"
-          (simple_expr ctxt) e1 longident_loc li (simple_expr ctxt) e2
-    | Pexp_ifthenelse (e1, e2, eo) ->
-        (* @;@[<2>else@ %a@]@] *)
-        let fmt:(_,_,_)format ="@[<hv0>@[<2>if@ %a@]@;@[<2>then@ %a@]%a@]" in
-        let expression_under_ifthenelse = expression (under_ifthenelse ctxt) in
-        pp f fmt expression_under_ifthenelse e1 expression_under_ifthenelse e2
-          (fun f eo -> match eo with
-             | Some x ->
-                 pp f "@;@[<2>else@;%a@]" (expression (under_semi ctxt)) x
-             | None -> () (* pp f "()" *)) eo
-    | Pexp_sequence _ ->
-        let rec sequence_helper acc = function
-          | {pexp_desc=Pexp_sequence(e1,e2); pexp_attributes = []} ->
-              sequence_helper (e1::acc) e2
-          | v -> List.rev (v::acc) in
-        let lst = sequence_helper [] x in
-        pp f "@[<hv>%a@]"
-          (list (expression (under_semi ctxt)) ~sep:";@;") lst
-    | Pexp_new (li) ->
-        pp f "@[<hov2>new@ %a@]" longident_loc li;
-    | Pexp_setinstvar (s, e) ->
-        pp f "@[<hov2>%s@ <-@ %a@]" s.txt (expression ctxt) e
-    | Pexp_override l -> (* FIXME *)
-        let string_x_expression f (s, e) =
-          pp f "@[<hov2>%s@ =@ %a@]" s.txt (expression ctxt) e in
-        pp f "@[<hov2>{<%a>}@]"
-          (list string_x_expression  ~sep:";"  )  l;
-    | Pexp_letmodule (s, me, e) ->
-        pp f "@[<hov2>let@ module@ %s@ =@ %a@ in@ %a@]" s.txt
-          (module_expr reset_ctxt) me (expression ctxt) e
-    | Pexp_letexception (cd, e) ->
-        pp f "@[<hov2>let@ exception@ %a@ in@ %a@]"
-          (extension_constructor ctxt) cd
-          (expression ctxt) e
-    | Pexp_assert e ->
-        pp f "@[<hov2>assert@ %a@]" (simple_expr ctxt) e
-    | Pexp_lazy (e) ->
-        pp f "@[<hov2>lazy@ %a@]" (simple_expr ctxt) e
-    (* Pexp_poly: impossible but we should print it anyway, rather than
-       assert false *)
-    | Pexp_poly (e, None) ->
-        pp f "@[<hov2>!poly!@ %a@]" (simple_expr ctxt) e
-    | Pexp_poly (e, Some ct) ->
-        pp f "@[<hov2>(!poly!@ %a@ : %a)@]"
-          (simple_expr ctxt) e (core_type ctxt) ct
-    | Pexp_open (ovf, lid, e) ->
-        pp f "@[<2>let open%s %a in@;%a@]" (override ovf) longident_loc lid
-          (expression ctxt) e
-    | Pexp_variant (l,Some eo) ->
-        pp f "@[<2>`%s@;%a@]" l (simple_expr ctxt) eo
-    | Pexp_extension e -> extension ctxt f e
-    | Pexp_unreachable -> pp f "."
-    | _ -> expression1 ctxt f x
+  | 8 ->
+# 583 "ml/lexer.mll"
+      ( store_lexeme lexbuf; comment lexbuf )
+# 2240 "ml/lexer.ml"
 
-and expression1 ctxt f x =
-  if x.pexp_attributes <> [] then expression ctxt f x
-  else match x.pexp_desc with
-    | Pexp_object cs -> pp f "%a" (class_structure ctxt) cs
-    | _ -> expression2 ctxt f x
-(* used in [Pexp_apply] *)
+  | 9 ->
+# 585 "ml/lexer.mll"
+      ( store_lexeme lexbuf; comment lexbuf )
+# 2245 "ml/lexer.ml"
 
-and expression2 ctxt f x =
-  if x.pexp_attributes <> [] then expression ctxt f x
-  else match x.pexp_desc with
-    | Pexp_field (e, li) ->
-        pp f "@[<hov2>%a.%a@]" (simple_expr ctxt) e longident_loc li
-    | Pexp_send (e, s) -> pp f "@[<hov2>%a#%s@]" (simple_expr ctxt) e s.txt
+  | 10 ->
+# 587 "ml/lexer.mll"
+      ( match !comment_start_loc with
+        | [] -> assert false
+        | loc :: _ ->
+          let start = List.hd (List.rev !comment_start_loc) in
+          comment_start_loc := [];
+          raise (Error (Unterminated_comment start, loc))
+      )
+# 2256 "ml/lexer.ml"
 
-    | _ -> simple_expr ctxt f x
+  | 11 ->
+# 595 "ml/lexer.mll"
+      ( update_loc lexbuf None 1 false 0;
+        store_lexeme lexbuf;
+        comment lexbuf
+      )
+# 2264 "ml/lexer.ml"
 
-and simple_expr ctxt f x =
-  if x.pexp_attributes <> [] then expression ctxt f x
-  else match x.pexp_desc with
-    | Pexp_construct _  when is_simple_construct (view_expr x) ->
-        (match view_expr x with
-         | `nil -> pp f "[]"
-         | `tuple -> pp f "()"
-         | `list xs ->
-             pp f "@[<hv0>[%a]@]"
-               (list (expression (under_semi ctxt)) ~sep:";@;") xs
-         | `simple x -> longident f x
-         | _ -> assert false)
-    | Pexp_ident li ->
-        longident_loc f li
-    (* (match view_fixity_of_exp x with *)
-    (* |`Normal -> longident_loc f li *)
-    (* | `Prefix _ | `Infix _ -> pp f "( %a )" longident_loc li) *)
-    | Pexp_constant c -> constant f c;
-    | Pexp_pack me ->
-        pp f "(module@;%a)" (module_expr ctxt) me
-    | Pexp_newtype (lid, e) ->
-        pp f "fun@;(type@;%s)@;->@;%a" lid.txt (expression ctxt) e
-    | Pexp_tuple l ->
-        pp f "@[<hov2>(%a)@]" (list (simple_expr ctxt) ~sep:",@;") l
-    | Pexp_constraint (e, ct) ->
-        pp f "(%a : %a)" (expression ctxt) e (core_type ctxt) ct
-    | Pexp_coerce (e, cto1, ct) ->
-        pp f "(%a%a :> %a)" (expression ctxt) e
-          (option (core_type ctxt) ~first:" : " ~last:" ") cto1 (* no sep hint*)
-          (core_type ctxt) ct
-    | Pexp_variant (l, None) -> pp f "`%s" l
-    | Pexp_record (l, eo) ->
-        let longident_x_expression f ( li, e) =
-          match e with
-          |  {pexp_desc=Pexp_ident {txt;_};
-              pexp_attributes=[]; _} when li.txt = txt ->
-              pp f "@[<hov2>%a@]" longident_loc li
-          | _ ->
-              pp f "@[<hov2>%a@;=@;%a@]" longident_loc li (simple_expr ctxt) e
-        in
-        pp f "@[<hv0>@[<hv2>{@;%a%a@]@;}@]"(* "@[<hov2>{%a%a}@]" *)
-          (option ~last:" with@;" (simple_expr ctxt)) eo
-          (list longident_x_expression ~sep:";@;") l
-    | Pexp_array (l) ->
-        pp f "@[<0>@[<2>[|%a|]@]@]"
-          (list (simple_expr (under_semi ctxt)) ~sep:";") l
-    | Pexp_while (e1, e2) ->
-        let fmt : (_,_,_) format = "@[<2>while@;%a@;do@;%a@;done@]" in
-        pp f fmt (expression ctxt) e1 (expression ctxt) e2
-    | Pexp_for (s, e1, e2, df, e3) ->
-        let fmt:(_,_,_)format =
-          "@[<hv0>@[<hv2>@[<2>for %a =@;%a@;%a%a@;do@]@;%a@]@;done@]" in
-        let expression = expression ctxt in
-        pp f fmt (pattern ctxt) s expression e1 direction_flag
-          df expression e2 expression e3
-    | _ ->  paren true (expression ctxt) f x
+  | 12 ->
+# 600 "ml/lexer.mll"
+      ( store_lexeme lexbuf; comment lexbuf )
+# 2269 "ml/lexer.ml"
 
-and attributes ctxt f l =
-  List.iter (attribute ctxt f) l
+  | __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf;
+      __ocaml_lex_comment_rec lexbuf __ocaml_lex_state
 
-and item_attributes ctxt f l =
-  List.iter (item_attribute ctxt f) l
+and string lexbuf =
+  lexbuf.Lexing.lex_mem <- Array.make 2 (-1); __ocaml_lex_string_rec lexbuf 169
+and __ocaml_lex_string_rec lexbuf __ocaml_lex_state =
+  match Lexing.new_engine __ocaml_lex_tables __ocaml_lex_state lexbuf with
+      | 0 ->
+# 604 "ml/lexer.mll"
+      ( () )
+# 2281 "ml/lexer.ml"
 
-and attribute ctxt f (s, e) =
-  pp f "@[<2>[@@%s@ %a]@]" s.txt (payload ctxt) e
+  | 1 ->
+let
+# 605 "ml/lexer.mll"
+                                  space
+# 2287 "ml/lexer.ml"
+= Lexing.sub_lexeme lexbuf lexbuf.Lexing.lex_mem.(0) lexbuf.Lexing.lex_curr_pos in
+# 606 "ml/lexer.mll"
+      ( update_loc lexbuf None 1 false (String.length space);
+        if in_comment () then store_lexeme lexbuf;
+        string lexbuf
+      )
+# 2294 "ml/lexer.ml"
 
-and item_attribute ctxt f (s, e) =
-  pp f "@[<2>[@@@@%s@ %a]@]" s.txt (payload ctxt) e
+  | 2 ->
+# 611 "ml/lexer.mll"
+      ( store_escaped_char lexbuf
+                           (char_for_backslash(Lexing.lexeme_char lexbuf 1));
+        string lexbuf )
+# 2301 "ml/lexer.ml"
 
-and floating_attribute ctxt f (s, e) =
-  pp f "@[<2>[@@@@@@%s@ %a]@]" s.txt (payload ctxt) e
+  | 3 ->
+# 615 "ml/lexer.mll"
+      ( store_escaped_char lexbuf (char_for_decimal_code lexbuf 1);
+         string lexbuf )
+# 2307 "ml/lexer.ml"
 
-and value_description ctxt f x =
-  (* note: value_description has an attribute field,
-           but they're already printed by the callers this method *)
-  pp f "@[<hov2>%a%a@]" (core_type ctxt) x.pval_type
-    (fun f x ->
-        
-       if x.pval_prim <> []
-       then pp f "@ =@ %a" (list constant_string) x.pval_prim
+  | 4 ->
+# 618 "ml/lexer.mll"
+      ( store_escaped_char lexbuf (char_for_octal_code lexbuf 2);
+         string lexbuf )
+# 2313 "ml/lexer.ml"
 
-    ) x
+  | 5 ->
+# 621 "ml/lexer.mll"
+      ( store_escaped_char lexbuf (char_for_hexadecimal_code lexbuf 2);
+         string lexbuf )
+# 2319 "ml/lexer.ml"
 
-and extension ctxt f (s, e) =
-  pp f "@[<2>[%%%s@ %a]@]" s.txt (payload ctxt) e
+  | 6 ->
+# 624 "ml/lexer.mll"
+        ( store_escaped_uchar lexbuf (uchar_for_uchar_escape lexbuf);
+          string lexbuf )
+# 2325 "ml/lexer.ml"
 
-and item_extension ctxt f (s, e) =
-  pp f "@[<2>[%%%%%s@ %a]@]" s.txt (payload ctxt) e
+  | 7 ->
+# 627 "ml/lexer.mll"
+      ( if not (in_comment ()) then begin
+(*  Should be an error, but we are very lax.
+          raise (Error (Illegal_escape (Lexing.lexeme lexbuf),
+                        Location.curr lexbuf))
+*)
+          let loc = Location.curr lexbuf in
+          Location.prerr_warning loc Warnings.Illegal_backslash;
+        end;
+        store_lexeme lexbuf;
+        string lexbuf
+      )
+# 2340 "ml/lexer.ml"
 
-and exception_declaration ctxt f ext =
-  pp f "@[<hov2>exception@ %a@]" (extension_constructor ctxt) ext
+  | 8 ->
+# 639 "ml/lexer.mll"
+      ( if not (in_comment ()) then
+          Location.prerr_warning (Location.curr lexbuf) Warnings.Eol_in_string;
+        update_loc lexbuf None 1 false 0;
+        store_lexeme lexbuf;
+        string lexbuf
+      )
+# 2350 "ml/lexer.ml"
 
-and class_signature ctxt f { pcsig_self = ct; pcsig_fields = l ;_} =
-  let class_type_field f x =
-    match x.pctf_desc with
-    | Pctf_inherit (ct) ->
-        pp f "@[<2>inherit@ %a@]%a" (class_type ctxt) ct
-          (item_attributes ctxt) x.pctf_attributes
-    | Pctf_val (s, mf, vf, ct) ->
-        pp f "@[<2>val @ %a%a%s@ :@ %a@]%a"
-          mutable_flag mf virtual_flag vf s.txt (core_type ctxt) ct
-          (item_attributes ctxt) x.pctf_attributes
-    | Pctf_method (s, pf, vf, ct) ->
-        pp f "@[<2>method %a %a%s :@;%a@]%a"
-          private_flag pf virtual_flag vf s.txt (core_type ctxt) ct
-          (item_attributes ctxt) x.pctf_attributes
-    | Pctf_constraint (ct1, ct2) ->
-        pp f "@[<2>constraint@ %a@ =@ %a@]%a"
-          (core_type ctxt) ct1 (core_type ctxt) ct2
-          (item_attributes ctxt) x.pctf_attributes
-    | Pctf_attribute a -> floating_attribute ctxt f a
-    | Pctf_extension e ->
-        item_extension ctxt f e;
-        item_attributes ctxt f x.pctf_attributes
-  in
-  pp f "@[<hv0>@[<hv2>object@[<1>%a@]@ %a@]@ end@]"
-    (fun f -> function
-         {ptyp_desc=Ptyp_any; ptyp_attributes=[]; _} -> ()
-       | ct -> pp f " (%a)" (core_type ctxt) ct) ct
-    (list class_type_field ~sep:"@;") l
+  | 9 ->
+# 646 "ml/lexer.mll"
+      ( is_in_string := false;
+        raise (Error (Unterminated_string, !string_start_loc)) )
+# 2356 "ml/lexer.ml"
 
-(* call [class_signature] called by [class_signature] *)
-and class_type ctxt f x =
-  match x.pcty_desc with
-  | Pcty_signature cs ->
-      class_signature ctxt f cs;
-      attributes ctxt f x.pcty_attributes
-  | Pcty_constr (li, l) ->
-      pp f "%a%a%a"
-        (fun f l -> match l with
-           | [] -> ()
-           | _  -> pp f "[%a]@ " (list (core_type ctxt) ~sep:"," ) l) l
-        longident_loc li
-        (attributes ctxt) x.pcty_attributes
-  | Pcty_arrow (l, co, cl) ->
-      pp f "@[<2>%a@;->@;%a@]" (* FIXME remove parens later *)
-        (type_with_label ctxt) (l,co)
-        (class_type ctxt) cl
-  | Pcty_extension e ->
-      extension ctxt f e;
-      attributes ctxt f x.pcty_attributes
-  | Pcty_open (ovf, lid, e) ->
-      pp f "@[<2>let open%s %a in@;%a@]" (override ovf) longident_loc lid
-        (class_type ctxt) e
+  | 10 ->
+# 649 "ml/lexer.mll"
+      ( store_string_char(Lexing.lexeme_char lexbuf 0);
+        string lexbuf )
+# 2362 "ml/lexer.ml"
 
-(* [class type a = object end] *)
-and class_type_declaration_list ctxt f l =
-  let class_type_declaration kwd f x =
-    let { pci_params=ls; pci_name={ txt; _ }; _ } = x in
-    pp f "@[<2>%s %a%a%s@ =@ %a@]%a" kwd
-      virtual_flag x.pci_virt
-      (class_params_def ctxt) ls txt
-      (class_type ctxt) x.pci_expr
-      (item_attributes ctxt) x.pci_attributes
-  in
-  match l with
-  | [] -> ()
-  | [x] -> class_type_declaration "class type" f x
-  | x :: xs ->
-      pp f "@[<v>%a@,%a@]"
-        (class_type_declaration "class type") x
-        (list ~sep:"@," (class_type_declaration "and")) xs
+  | __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf;
+      __ocaml_lex_string_rec lexbuf __ocaml_lex_state
 
-and class_field ctxt f x =
-  match x.pcf_desc with
-  | Pcf_inherit () -> ()  
-  | Pcf_val (s, mf, Cfk_concrete (ovf, e)) ->
-      pp f "@[<2>val%s %a%s =@;%a@]%a" (override ovf)
-        mutable_flag mf s.txt
-        (expression ctxt) e
-        (item_attributes ctxt) x.pcf_attributes
-  | Pcf_method (s, pf, Cfk_virtual ct) ->
-      pp f "@[<2>method virtual %a %s :@;%a@]%a"
-        private_flag pf s.txt
-        (core_type ctxt) ct
-        (item_attributes ctxt) x.pcf_attributes
-  | Pcf_val (s, mf, Cfk_virtual ct) ->
-      pp f "@[<2>val virtual %a%s :@ %a@]%a"
-        mutable_flag mf s.txt
-        (core_type ctxt) ct
-        (item_attributes ctxt) x.pcf_attributes
-  | Pcf_method (s, pf, Cfk_concrete (ovf, e)) ->
-      let bind e =
-        binding ctxt f
-          {pvb_pat=
-             {ppat_desc=Ppat_var s;ppat_loc=Location.none;ppat_attributes=[]};
-           pvb_expr=e;
-           pvb_attributes=[];
-           pvb_loc=Location.none;
-          }
-      in
-      pp f "@[<2>method%s %a%a@]%a"
-        (override ovf)
-        private_flag pf
-        (fun f -> function
-           | {pexp_desc=Pexp_poly (e, Some ct); pexp_attributes=[]; _} ->
-               pp f "%s :@;%a=@;%a"
-                 s.txt (core_type ctxt) ct (expression ctxt) e
-           | {pexp_desc=Pexp_poly (e, None); pexp_attributes=[]; _} ->
-               bind e
-           | _ -> bind e) e
-        (item_attributes ctxt) x.pcf_attributes
-  | Pcf_constraint (ct1, ct2) ->
-      pp f "@[<2>constraint %a =@;%a@]%a"
-        (core_type ctxt) ct1
-        (core_type ctxt) ct2
-        (item_attributes ctxt) x.pcf_attributes
-  | Pcf_initializer (e) ->
-      pp f "@[<2>initializer@ %a@]%a"
-        (expression ctxt) e
-        (item_attributes ctxt) x.pcf_attributes
-  | Pcf_attribute a -> floating_attribute ctxt f a
-  | Pcf_extension e ->
-      item_extension ctxt f e;
-      item_attributes ctxt f x.pcf_attributes
+and quoted_string delim lexbuf =
+   __ocaml_lex_quoted_string_rec delim lexbuf 196
+and __ocaml_lex_quoted_string_rec delim lexbuf __ocaml_lex_state =
+  match Lexing.engine __ocaml_lex_tables __ocaml_lex_state lexbuf with
+      | 0 ->
+# 654 "ml/lexer.mll"
+      ( update_loc lexbuf None 1 false 0;
+        store_lexeme lexbuf;
+        quoted_string delim lexbuf
+      )
+# 2377 "ml/lexer.ml"
 
-and class_structure ctxt f { pcstr_self = p; pcstr_fields =  l } =
-  pp f "@[<hv0>@[<hv2>object%a@;%a@]@;end@]"
-    (fun f p -> match p.ppat_desc with
-       | Ppat_any -> ()
-       | Ppat_constraint _ -> pp f " %a" (pattern ctxt) p
-       | _ -> pp f " (%a)" (pattern ctxt) p) p
-    (list (class_field ctxt)) l
+  | 1 ->
+# 659 "ml/lexer.mll"
+      ( is_in_string := false;
+        raise (Error (Unterminated_string, !string_start_loc)) )
+# 2383 "ml/lexer.ml"
 
-and module_type ctxt f x =
-  if x.pmty_attributes <> [] then begin
-    pp f "((%a)%a)" (module_type ctxt) {x with pmty_attributes=[]}
-      (attributes ctxt) x.pmty_attributes
-  end else
-    match x.pmty_desc with
-    | Pmty_ident li ->
-        pp f "%a" longident_loc li;
-    | Pmty_alias li ->
-        pp f "(module %a)" longident_loc li;
-    | Pmty_signature (s) ->
-        pp f "@[<hv0>@[<hv2>sig@ %a@]@ end@]" (* "@[<hov>sig@ %a@ end@]" *)
-          (list (signature_item ctxt)) s (* FIXME wrong indentation*)
-    | Pmty_functor (_, None, mt2) ->
-        pp f "@[<hov2>functor () ->@ %a@]" (module_type ctxt) mt2
-    | Pmty_functor (s, Some mt1, mt2) ->
-        if s.txt = "_" then
-          pp f "@[<hov2>%a@ ->@ %a@]"
-            (module_type ctxt) mt1 (module_type ctxt) mt2
-        else
-          pp f "@[<hov2>functor@ (%s@ :@ %a)@ ->@ %a@]" s.txt
-            (module_type ctxt) mt1 (module_type ctxt) mt2
-    | Pmty_with (mt, l) ->
-        let with_constraint f = function
-          | Pwith_type (li, ({ptype_params= ls ;_} as td)) ->
-              let ls = List.map fst ls in
-              pp f "type@ %a %a =@ %a"
-                (list (core_type ctxt) ~sep:"," ~first:"(" ~last:")")
-                ls longident_loc li (type_declaration ctxt) td
-          | Pwith_module (li, li2) ->
-              pp f "module %a =@ %a" longident_loc li longident_loc li2;
-          | Pwith_typesubst (li, ({ptype_params=ls;_} as td)) ->
-              let ls = List.map fst ls in
-              pp f "type@ %a %a :=@ %a"
-                (list (core_type ctxt) ~sep:"," ~first:"(" ~last:")")
-                ls longident_loc li
-                (type_declaration ctxt) td
-          | Pwith_modsubst (li, li2) ->
-             pp f "module %a :=@ %a" longident_loc li longident_loc li2 in
-        (match l with
-         | [] -> pp f "@[<hov2>%a@]" (module_type ctxt) mt
-         | _ -> pp f "@[<hov2>(%a@ with@ %a)@]"
-                  (module_type ctxt) mt (list with_constraint ~sep:"@ and@ ") l)
-    | Pmty_typeof me ->
-        pp f "@[<hov2>module@ type@ of@ %a@]" (module_expr ctxt) me
-    | Pmty_extension e -> extension ctxt f e
+  | 2 ->
+# 662 "ml/lexer.mll"
+      (
+        let edelim = Lexing.lexeme lexbuf in
+        let edelim = String.sub edelim 1 (String.length edelim - 2) in
+        if delim = edelim then ()
+        else (store_lexeme lexbuf; quoted_string delim lexbuf)
+      )
+# 2393 "ml/lexer.ml"
 
-and signature ctxt f x =  list ~sep:"@\n" (signature_item ctxt) f x
+  | 3 ->
+# 669 "ml/lexer.mll"
+      ( store_string_char(Lexing.lexeme_char lexbuf 0);
+        quoted_string delim lexbuf )
+# 2399 "ml/lexer.ml"
 
-and signature_item ctxt f x : unit =
-  match x.psig_desc with
-  | Psig_type (rf, l) ->
-      type_def_list ctxt f (rf, l)
-  | Psig_value vd ->
-      let intro = if vd.pval_prim = [] then "val" else "external" in
-      pp f "@[<2>%s@ %a@ :@ %a@]%a" intro
-        protect_ident vd.pval_name.txt
-        (value_description ctxt) vd
-        (item_attributes ctxt) vd.pval_attributes
-  | Psig_typext te ->
-      type_extension ctxt f te
-  | Psig_exception ed ->
-      exception_declaration ctxt f ed
-  | Psig_class () ->
-    ()
-  | Psig_module ({pmd_type={pmty_desc=Pmty_alias alias;
-                            pmty_attributes=[]; _};_} as pmd) ->
-      pp f "@[<hov>module@ %s@ =@ %a@]%a" pmd.pmd_name.txt
-        longident_loc alias
-        (item_attributes ctxt) pmd.pmd_attributes
-  | Psig_module pmd ->
-      pp f "@[<hov>module@ %s@ :@ %a@]%a"
-        pmd.pmd_name.txt
-        (module_type ctxt) pmd.pmd_type
-        (item_attributes ctxt) pmd.pmd_attributes
-  | Psig_open od ->
-      pp f "@[<hov2>open%s@ %a@]%a"
-        (override od.popen_override)
-        longident_loc od.popen_lid
-        (item_attributes ctxt) od.popen_attributes
-  | Psig_include incl ->
-      pp f "@[<hov2>include@ %a@]%a"
-        (module_type ctxt) incl.pincl_mod
-        (item_attributes ctxt) incl.pincl_attributes
-  | Psig_modtype {pmtd_name=s; pmtd_type=md; pmtd_attributes=attrs} ->
-      pp f "@[<hov2>module@ type@ %s%a@]%a"
-        s.txt
-        (fun f md -> match md with
-           | None -> ()
-           | Some mt ->
-               pp_print_space f () ;
-               pp f "@ =@ %a" (module_type ctxt) mt
-        ) md
-        (item_attributes ctxt) attrs
-  | Psig_class_type (l) -> class_type_declaration_list ctxt f l
-  | Psig_recmodule decls ->
-      let rec  string_x_module_type_list f ?(first=true) l =
-        match l with
-        | [] -> () ;
-        | pmd :: tl ->
-            if not first then
-              pp f "@ @[<hov2>and@ %s:@ %a@]%a" pmd.pmd_name.txt
-                (module_type ctxt) pmd.pmd_type
-                (item_attributes ctxt) pmd.pmd_attributes
-            else
-              pp f "@[<hov2>module@ rec@ %s:@ %a@]%a" pmd.pmd_name.txt
-                (module_type ctxt) pmd.pmd_type
-                (item_attributes ctxt) pmd.pmd_attributes;
-            string_x_module_type_list f ~first:false tl
-      in
-      string_x_module_type_list f decls
-  | Psig_attribute a -> floating_attribute ctxt f a
-  | Psig_extension(e, a) ->
-      item_extension ctxt f e;
-      item_attributes ctxt f a
+  | __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf;
+      __ocaml_lex_quoted_string_rec delim lexbuf __ocaml_lex_state
 
-and module_expr ctxt f x =
-  if x.pmod_attributes <> [] then
-    pp f "((%a)%a)" (module_expr ctxt) {x with pmod_attributes=[]}
-      (attributes ctxt) x.pmod_attributes
-  else match x.pmod_desc with
-    | Pmod_structure (s) ->
-        pp f "@[<hv2>struct@;@[<0>%a@]@;<1 -2>end@]"
-          (list (structure_item ctxt) ~sep:"@\n") s;
-    | Pmod_constraint (me, mt) ->
-        pp f "@[<hov2>(%a@ :@ %a)@]"
-          (module_expr ctxt) me
-          (module_type ctxt) mt
-    | Pmod_ident (li) ->
-        pp f "%a" longident_loc li;
-    | Pmod_functor (_, None, me) ->
-        pp f "functor ()@;->@;%a" (module_expr ctxt) me
-    | Pmod_functor (s, Some mt, me) ->
-        pp f "functor@ (%s@ :@ %a)@;->@;%a"
-          s.txt (module_type ctxt) mt (module_expr ctxt) me
-    | Pmod_apply (me1, me2) ->
-        pp f "(%a)(%a)" (module_expr ctxt) me1 (module_expr ctxt) me2
-        (* Cf: #7200 *)
-    | Pmod_unpack e ->
-        pp f "(val@ %a)" (expression ctxt) e
-    | Pmod_extension e -> extension ctxt f e
+and skip_hash_bang lexbuf =
+   __ocaml_lex_skip_hash_bang_rec lexbuf 205
+and __ocaml_lex_skip_hash_bang_rec lexbuf __ocaml_lex_state =
+  match Lexing.engine __ocaml_lex_tables __ocaml_lex_state lexbuf with
+      | 0 ->
+# 674 "ml/lexer.mll"
+       ( update_loc lexbuf None 3 false 0 )
+# 2411 "ml/lexer.ml"
 
-and structure ctxt f x = list ~sep:"@\n" (structure_item ctxt) f x
+  | 1 ->
+# 676 "ml/lexer.mll"
+       ( update_loc lexbuf None 1 false 0 )
+# 2416 "ml/lexer.ml"
 
-and payload ctxt f = function
-  | PStr [{pstr_desc = Pstr_eval (e, attrs)}] ->
-      pp f "@[<2>%a@]%a"
-        (expression ctxt) e
-        (item_attributes ctxt) attrs
-  | PStr x -> structure ctxt f x
-  | PTyp x -> pp f ":"; core_type ctxt f x
-  | PSig x -> pp f ":"; signature ctxt f x
-  | PPat (x, None) -> pp f "?"; pattern ctxt f x
-  | PPat (x, Some e) ->
-      pp f "?"; pattern ctxt f x;
-      pp f " when "; expression ctxt f e
+  | 2 ->
+# 677 "ml/lexer.mll"
+       ( () )
+# 2421 "ml/lexer.ml"
 
-(* transform [f = fun g h -> ..] to [f g h = ... ] could be improved *)
-and binding ctxt f {pvb_pat=p; pvb_expr=x; _} =
-  (* .pvb_attributes have already been printed by the caller, #bindings *)
-  let rec pp_print_pexp_function f x =
-    if x.pexp_attributes <> [] then pp f "=@;%a" (expression ctxt) x
-    else match x.pexp_desc with
-      | Pexp_fun (label, eo, p, e) ->
-          if label=Nolabel then
-            pp f "%a@ %a" (simple_pattern ctxt) p pp_print_pexp_function e
-          else
-            pp f "%a@ %a"
-              (label_exp ctxt) (label,eo,p) pp_print_pexp_function e
-      | Pexp_newtype (str,e) ->
-          pp f "(type@ %s)@ %a" str.txt pp_print_pexp_function e
-      | _ -> pp f "=@;%a" (expression ctxt) x
-  in
-  let tyvars_str tyvars = List.map (fun v -> v.txt) tyvars in
-  let is_desugared_gadt p e =
-    let gadt_pattern =
-      match p with
-      | {ppat_desc=Ppat_constraint({ppat_desc=Ppat_var _} as pat,
-                                   {ptyp_desc=Ptyp_poly (args_tyvars, rt)});
-         ppat_attributes=[]}->
-          Some (pat, args_tyvars, rt)
-      | _ -> None in
-    let rec gadt_exp tyvars e =
-      match e with
-      | {pexp_desc=Pexp_newtype (tyvar, e); pexp_attributes=[]} ->
-          gadt_exp (tyvar :: tyvars) e
-      | {pexp_desc=Pexp_constraint (e, ct); pexp_attributes=[]} ->
-          Some (List.rev tyvars, e, ct)
-      | _ -> None in
-    let gadt_exp = gadt_exp [] e in
-    match gadt_pattern, gadt_exp with
-    | Some (p, pt_tyvars, pt_ct), Some (e_tyvars, e, e_ct)
-      when tyvars_str pt_tyvars = tyvars_str e_tyvars ->
-      let ety = Typ.varify_constructors e_tyvars e_ct in
-      if ety = pt_ct then
-      Some (p, pt_tyvars, e_ct, e) else None
-    | _ -> None in
-  if x.pexp_attributes <> []
-  then pp f "%a@;=@;%a" (pattern ctxt) p (expression ctxt) x else
-  match is_desugared_gadt p x with
-  | Some (p, [], ct, e) ->
-      pp f "%a@;: %a@;=@;%a"
-        (simple_pattern ctxt) p (core_type ctxt) ct (expression ctxt) e
-  | Some (p, tyvars, ct, e) -> begin
-    pp f "%a@;: type@;%a.@;%a@;=@;%a"
-    (simple_pattern ctxt) p (list pp_print_string ~sep:"@;")
-    (tyvars_str tyvars) (core_type ctxt) ct (expression ctxt) e
-    end
-  | None -> begin
-      match p with
-      | {ppat_desc=Ppat_constraint(p ,ty);
-         ppat_attributes=[]} -> (* special case for the first*)
-          begin match ty with
-          | {ptyp_desc=Ptyp_poly _; ptyp_attributes=[]} ->
-              pp f "%a@;:@;%a@;=@;%a" (simple_pattern ctxt) p
-                (core_type ctxt) ty (expression ctxt) x
-          | _ ->
-              pp f "(%a@;:@;%a)@;=@;%a" (simple_pattern ctxt) p
-                (core_type ctxt) ty (expression ctxt) x
-          end
-      | {ppat_desc=Ppat_var _; ppat_attributes=[]} ->
-          pp f "%a@ %a" (simple_pattern ctxt) p pp_print_pexp_function x
-      | _ ->
-          pp f "%a@;=@;%a" (pattern ctxt) p (expression ctxt) x
-    end
+  | __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf;
+      __ocaml_lex_skip_hash_bang_rec lexbuf __ocaml_lex_state
 
-(* [in] is not printed *)
-and bindings ctxt f (rf,l) =
-  let binding kwd rf f x =
-    pp f "@[<2>%s %a%a@]%a" kwd rec_flag rf
-      (binding ctxt) x (item_attributes ctxt) x.pvb_attributes
-  in
-  match l with
-  | [] -> ()
-  | [x] -> binding "let" rf f x
-  | x::xs ->
-      pp f "@[<v>%a@,%a@]"
-        (binding "let" rf) x
-        (list ~sep:"@," (binding "and" Nonrecursive)) xs
+;;
 
-and structure_item ctxt f x =
-  match x.pstr_desc with
-  | Pstr_eval (e, attrs) ->
-      pp f "@[<hov2>;;%a@]%a"
-        (expression ctxt) e
-        (item_attributes ctxt) attrs
-  | Pstr_type (_, []) -> assert false
-  | Pstr_type (rf, l)  -> type_def_list ctxt f (rf, l)
-  | Pstr_value (rf, l) ->
-      (* pp f "@[<hov2>let %a%a@]"  rec_flag rf bindings l *)
-      pp f "@[<2>%a@]" (bindings ctxt) (rf,l)
-  | Pstr_typext te -> type_extension ctxt f te
-  | Pstr_exception ed -> exception_declaration ctxt f ed
-  | Pstr_module x ->
-      let rec module_helper = function
-        | {pmod_desc=Pmod_functor(s,mt,me'); pmod_attributes = []} ->
-            if mt = None then pp f "()"
-            else Misc.may (pp f "(%s:%a)" s.txt (module_type ctxt)) mt;
-            module_helper me'
-        | me -> me
-      in
-      pp f "@[<hov2>module %s%a@]%a"
-        x.pmb_name.txt
-        (fun f me ->
-           let me = module_helper me in
-           match me with
-           | {pmod_desc=
-                Pmod_constraint
-                  (me',
-                   ({pmty_desc=(Pmty_ident (_)
-                               | Pmty_signature (_));_} as mt));
-              pmod_attributes = []} ->
-               pp f " :@;%a@;=@;%a@;"
-                 (module_type ctxt) mt (module_expr ctxt) me'
-           | _ -> pp f " =@ %a" (module_expr ctxt) me
-        ) x.pmb_expr
-        (item_attributes ctxt) x.pmb_attributes
-  | Pstr_open od ->
-      pp f "@[<2>open%s@;%a@]%a"
-        (override od.popen_override)
-        longident_loc od.popen_lid
-        (item_attributes ctxt) od.popen_attributes
-  | Pstr_modtype {pmtd_name=s; pmtd_type=md; pmtd_attributes=attrs} ->
-      pp f "@[<hov2>module@ type@ %s%a@]%a"
-        s.txt
-        (fun f md -> match md with
-           | None -> ()
-           | Some mt ->
-               pp_print_space f () ;
-               pp f "@ =@ %a" (module_type ctxt) mt
-        ) md
-        (item_attributes ctxt) attrs
-  | Pstr_class () -> ()
-  | Pstr_class_type l -> class_type_declaration_list ctxt f l
-  | Pstr_primitive vd ->
-      pp f "@[<hov2>external@ %a@ :@ %a@]%a"
-        protect_ident vd.pval_name.txt
-        (value_description ctxt) vd
-        (item_attributes ctxt) vd.pval_attributes
-  | Pstr_include incl ->
-      pp f "@[<hov2>include@ %a@]%a"
-        (module_expr ctxt) incl.pincl_mod
-        (item_attributes ctxt) incl.pincl_attributes
-  | Pstr_recmodule decls -> (* 3.07 *)
-      let aux f = function
-        | ({pmb_expr={pmod_desc=Pmod_constraint (expr, typ)}} as pmb) ->
-            pp f "@[<hov2>@ and@ %s:%a@ =@ %a@]%a" pmb.pmb_name.txt
-              (module_type ctxt) typ
-              (module_expr ctxt) expr
-              (item_attributes ctxt) pmb.pmb_attributes
-        | _ -> assert false
-      in
-      begin match decls with
-      | ({pmb_expr={pmod_desc=Pmod_constraint (expr, typ)}} as pmb) :: l2 ->
-          pp f "@[<hv>@[<hov2>module@ rec@ %s:%a@ =@ %a@]%a@ %a@]"
-            pmb.pmb_name.txt
-            (module_type ctxt) typ
-            (module_expr ctxt) expr
-            (item_attributes ctxt) pmb.pmb_attributes
-            (fun f l2 -> List.iter (aux f) l2) l2
-      | _ -> assert false
-      end
-  | Pstr_attribute a -> floating_attribute ctxt f a
-  | Pstr_extension(e, a) ->
-      item_extension ctxt f e;
-      item_attributes ctxt f a
+# 679 "ml/lexer.mll"
+ 
+  let token_with_comments lexbuf =
+    match !preprocessor with
+    | None -> token lexbuf
+    | Some (_init, preprocess) -> preprocess token lexbuf
 
-and type_param ctxt f (ct, a) =
-  pp f "%s%a" (type_variance a) (core_type ctxt) ct
+  type newline_state =
+    | NoLine (* There have been no blank lines yet. *)
+    | NewLine
+        (* There have been no blank lines, and the previous
+           token was a newline. *)
+    | BlankLine (* There have been blank lines. *)
 
-and type_params ctxt f = function
-  | [] -> ()
-  | l -> pp f "%a " (list (type_param ctxt) ~first:"(" ~last:")" ~sep:",@;") l
+  type doc_state =
+    | Initial  (* There have been no docstrings yet *)
+    | After of docstring list
+        (* There have been docstrings, none of which were
+           preceded by a blank line *)
+    | Before of docstring list * docstring list * docstring list
+        (* There have been docstrings, some of which were
+           preceded by a blank line *)
 
-and type_def_list ctxt f (rf, l) =
-  let type_decl kwd rf f x =
-    let eq =
-      if (x.ptype_kind = Ptype_abstract)
-         && (x.ptype_manifest = None) then ""
-      else " ="
-    in
-    pp f "@[<2>%s %a%a%s%s%a@]%a" kwd
-      nonrec_flag rf
-      (type_params ctxt) x.ptype_params
-      x.ptype_name.txt eq
-      (type_declaration ctxt) x
-      (item_attributes ctxt) x.ptype_attributes
-  in
-  match l with
-  | [] -> assert false
-  | [x] -> type_decl "type" rf f x
-  | x :: xs -> pp f "@[<v>%a@,%a@]"
-                 (type_decl "type" rf) x
-                 (list ~sep:"@," (type_decl "and" Recursive)) xs
+  and docstring = Docstrings.docstring
 
-and record_declaration ctxt f lbls =
-  let type_record_field f pld =
-    pp f "@[<2>%a%s:@;%a@;%a@]"
-      mutable_flag pld.pld_mutable
-      pld.pld_name.txt
-      (core_type ctxt) pld.pld_type
-      (attributes ctxt) pld.pld_attributes
-  in
-  pp f "{@\n%a}"
-    (list type_record_field ~sep:";@\n" )  lbls
+  let token lexbuf =
+    let post_pos = lexeme_end_p lexbuf in
+    let attach lines docs pre_pos =
+      let open Docstrings in
+        match docs, lines with
+        | Initial, _ -> ()
+        | After a, (NoLine | NewLine) ->
+            set_post_docstrings post_pos (List.rev a);
+            set_pre_docstrings pre_pos a;
+        | After a, BlankLine ->
+            set_post_docstrings post_pos (List.rev a);
+            set_pre_extra_docstrings pre_pos (List.rev a)
+        | Before(a, f, b), (NoLine | NewLine) ->
+            set_post_docstrings post_pos (List.rev a);
+            set_post_extra_docstrings post_pos
+              (List.rev_append f (List.rev b));
+            set_floating_docstrings pre_pos (List.rev f);
+            set_pre_extra_docstrings pre_pos (List.rev a);
+            set_pre_docstrings pre_pos b
+        | Before(a, f, b), BlankLine ->
+            set_post_docstrings post_pos (List.rev a);
+            set_post_extra_docstrings post_pos
+              (List.rev_append f (List.rev b));
+            set_floating_docstrings pre_pos
+              (List.rev_append f (List.rev b));
+            set_pre_extra_docstrings pre_pos (List.rev a)
+    in
+    let rec loop lines docs lexbuf =
+      match token_with_comments lexbuf with
+      | COMMENT (s, loc) ->
+          add_comment (s, loc);
+          let lines' =
+            match lines with
+            | NoLine -> NoLine
+            | NewLine -> NoLine
+            | BlankLine -> BlankLine
+          in
+          loop lines' docs lexbuf
+      | EOL ->
+          let lines' =
+            match lines with
+            | NoLine -> NewLine
+            | NewLine -> BlankLine
+            | BlankLine -> BlankLine
+          in
+          loop lines' docs lexbuf
+      | HASH when Rescript_cpp.at_bol lexbuf -> 
+          Rescript_cpp.interpret_directive lexbuf 
+            ~cont:(fun lexbuf -> loop lines docs lexbuf)
+            ~token_with_comments
+      | DOCSTRING doc ->
+          Docstrings.register doc;
+          add_docstring_comment doc;
+          let docs' =
+            if Docstrings.docstring_body doc = "/*" then
+              match docs with
+              | Initial -> Before([], [doc], [])
+              | After a -> Before (a, [doc], [])
+              | Before(a, f, b) -> Before(a, doc :: b @ f, [])
+            else
+              match docs, lines with
+              | Initial, (NoLine | NewLine) -> After [doc]
+              | Initial, BlankLine -> Before([], [], [doc])
+              | After a, (NoLine | NewLine) -> After (doc :: a)
+              | After a, BlankLine -> Before (a, [], [doc])
+              | Before(a, f, b), (NoLine | NewLine) -> Before(a, f, doc :: b)
+              | Before(a, f, b), BlankLine -> Before(a, b @ f, [doc])
+          in
+          loop NoLine docs' lexbuf
+      | tok ->
+          attach lines docs (lexeme_start_p lexbuf);
+          tok
+    in
+    Rescript_cpp.check_sharp_look_ahead (fun _ -> loop NoLine Initial lexbuf)
 
-and type_declaration ctxt f x =
-  (* type_declaration has an attribute field,
-     but it's been printed by the caller of this method *)
-  let priv f =
-    match x.ptype_private with
-    | Public -> ()
-    | Private -> pp f "@;private"
-  in
-  let manifest f =
-    match x.ptype_manifest with
+  let init () =
+    Rescript_cpp.init ();
+    is_in_string := false;
+    comment_start_loc := [];
+    comment_list := [];
+    match !preprocessor with
     | None -> ()
-    | Some y ->
-        if x.ptype_kind = Ptype_abstract then
-          pp f "%t@;%a" priv (core_type ctxt) y
-        else
-          pp f "@;%a" (core_type ctxt) y
-  in
-  let constructor_declaration f pcd =
-    pp f "|@;";
-    constructor_declaration ctxt f
-      (pcd.pcd_name.txt, pcd.pcd_args, pcd.pcd_res, pcd.pcd_attributes)
-  in
-  let repr f =
-    let intro f =
-      if x.ptype_manifest = None then ()
-      else pp f "@;="
-    in
-    match x.ptype_kind with
-    | Ptype_variant xs ->
-        pp f "%t%t@\n%a" intro priv
-          (list ~sep:"@\n" constructor_declaration) xs
-    | Ptype_abstract -> ()
-    | Ptype_record l ->
-        pp f "%t%t@;%a" intro priv (record_declaration ctxt) l
-    | Ptype_open -> pp f "%t%t@;.." intro priv
-  in
-  let constraints f =
-    List.iter
-      (fun (ct1,ct2,_) ->
-         pp f "@[<hov2>@ constraint@ %a@ =@ %a@]"
-           (core_type ctxt) ct1 (core_type ctxt) ct2)
-      x.ptype_cstrs
-  in
-  pp f "%t%t%t" manifest repr constraints
+    | Some (init, _preprocess) -> init ()
 
-and type_extension ctxt f x =
-  let extension_constructor f x =
-    pp f "@\n|@;%a" (extension_constructor ctxt) x
-  in
-  pp f "@[<2>type %a%a += %a@ %a@]%a"
-    (fun f -> function
-       | [] -> ()
-       | l ->
-           pp f "%a@;" (list (type_param ctxt) ~first:"(" ~last:")" ~sep:",") l)
-    x.ptyext_params
-    longident_loc x.ptyext_path
-    private_flag x.ptyext_private (* Cf: #7200 *)
-    (list ~sep:"" extension_constructor)
-    x.ptyext_constructors
-    (item_attributes ctxt) x.ptyext_attributes
 
-and constructor_declaration ctxt f (name, args, res, attrs) =
-  let name =
-    match name with
-    | "::" -> "(::)"
-    | s -> s in
-  match res with
-  | None ->
-      pp f "%s%a@;%a" name
-        (fun f -> function
-           | Pcstr_tuple [] -> ()
-           | Pcstr_tuple l ->
-             pp f "@;of@;%a" (list (core_type1 ctxt) ~sep:"@;*@;") l
-           | Pcstr_record l -> pp f "@;of@;%a" (record_declaration ctxt) l
-        ) args
-        (attributes ctxt) attrs
-  | Some r ->
-      pp f "%s:@;%a@;%a" name
-        (fun f -> function
-           | Pcstr_tuple [] -> core_type1 ctxt f r
-           | Pcstr_tuple l -> pp f "%a@;->@;%a"
-                                (list (core_type1 ctxt) ~sep:"@;*@;") l
-                                (core_type1 ctxt) r
-           | Pcstr_record l ->
-               pp f "%a@;->@;%a" (record_declaration ctxt) l (core_type1 ctxt) r
-        )
-        args
-        (attributes ctxt) attrs
+  let set_preprocessor init preprocess =
+    escaped_newlines := true;
+    preprocessor := Some (init, preprocess)
 
-and extension_constructor ctxt f x =
-  (* Cf: #7200 *)
-  match x.pext_kind with
-  | Pext_decl(l, r) ->
-      constructor_declaration ctxt f (x.pext_name.txt, l, r, x.pext_attributes)
-  | Pext_rebind li ->
-      pp f "%s%a@;=@;%a" x.pext_name.txt
-        (attributes ctxt) x.pext_attributes
-        longident_loc li
 
-and case_list ctxt f l : unit =
-  let aux f {pc_lhs; pc_guard; pc_rhs} =
-    pp f "@;| @[<2>%a%a@;->@;%a@]"
-      (pattern ctxt) pc_lhs (option (expression ctxt) ~first:"@;when@;")
-      pc_guard (expression (under_pipe ctxt)) pc_rhs
-  in
-  list aux f l ~sep:""
+# 2543 "ml/lexer.ml"
 
-and label_x_expression_param ctxt f (l,e) =
-  let simple_name = match e with
-    | {pexp_desc=Pexp_ident {txt=Lident l;_};
-       pexp_attributes=[]} -> Some l
-    | _ -> None
-  in match l with
-  | Nolabel  -> expression2 ctxt f e (* level 2*)
-  | Optional str ->
-      if Some str = simple_name then
-        pp f "?%s" str
-      else
-        pp f "?%s:%a" str (simple_expr ctxt) e
-  | Labelled lbl ->
-      if Some lbl = simple_name then
-        pp f "~%s" lbl
-      else
-        pp f "~%s:%a" lbl (simple_expr ctxt) e
+end
+module Parse : sig 
+#1 "parse.mli"
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 1996 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
 
+(** Entry points in the parser *)
 
+val implementation : Lexing.lexbuf -> Parsetree.structure
+val interface : Lexing.lexbuf -> Parsetree.signature
+val core_type : Lexing.lexbuf -> Parsetree.core_type
+val expression : Lexing.lexbuf -> Parsetree.expression
+val pattern : Lexing.lexbuf -> Parsetree.pattern
 
-let expression f x =
-  pp f "@[%a@]" (expression reset_ctxt) x
+end = struct
+#1 "parse.ml"
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 1996 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
 
-let string_of_expression x =
-  ignore (flush_str_formatter ()) ;
-  let f = str_formatter in
-  expression f x;
-  flush_str_formatter ()
+(* Entry points in the parser *)
 
-let string_of_structure x =
-  ignore (flush_str_formatter ());
-  let f = str_formatter in
-  structure reset_ctxt f x;
-  flush_str_formatter ()
 
+let wrap parsing_fun lexbuf =
+  try
+    Docstrings.init ();
+    Lexer.init ();
+    let ast = parsing_fun Lexer.token lexbuf in
+    Parsing.clear_parser();
+    Docstrings.warn_bad_docstrings ();
+    ast
+  with
+  | Parsing.Parse_error | Syntaxerr.Escape_error ->
+      let loc = Location.curr lexbuf in
+      raise(Syntaxerr.Error(Syntaxerr.Other loc))
 
-let core_type = core_type reset_ctxt
-let pattern = pattern reset_ctxt
-let signature = signature reset_ctxt
-let structure = structure reset_ctxt
+let implementation = wrap Parser.implementation
+and interface = wrap Parser.interface
+and core_type = wrap Parser.parse_core_type
+and expression = wrap Parser.parse_expression
+and pattern = wrap Parser.parse_pattern
 
 end
 module Ast_payload : sig 
@@ -282382,24 +282453,23 @@ let scanEscape scanner =
       next scanner
     done;
     let c = !x in
-    if Res_utf8.isValidCodePoint c then Char.unsafe_chr c
-    else Char.unsafe_chr Res_utf8.repl
+    if Res_utf8.isValidCodePoint c then c else Res_utf8.repl
   in
   let codepoint =
     match scanner.ch with
     | '0' .. '9' -> convertNumber scanner ~n:3 ~base:10
     | 'b' ->
       next scanner;
-      '\008'
+      8
     | 'n' ->
       next scanner;
-      '\010'
+      10
     | 'r' ->
       next scanner;
-      '\013'
+      13
     | 't' ->
       next scanner;
-      '\009'
+      009
     | 'x' ->
       next scanner;
       convertNumber scanner ~n:2 ~base:16
@@ -282426,14 +282496,13 @@ let scanEscape scanner =
         | '}' -> next scanner
         | _ -> ());
         let c = !x in
-        if Res_utf8.isValidCodePoint c then Char.unsafe_chr c
-        else Char.unsafe_chr Res_utf8.repl
+        if Res_utf8.isValidCodePoint c then c else Res_utf8.repl
       | _ ->
         (* unicode escape sequence: '\u007A', exactly 4 hex digits *)
         convertNumber scanner ~n:4 ~base:16)
     | ch ->
       next scanner;
-      ch
+      Char.code ch
   in
   let contents =
     (String.sub [@doesNotRaise]) scanner.src offset (scanner.offset - offset)
@@ -282767,7 +282836,10 @@ let rec scan scanner =
         let offset = scanner.offset + 1 in
         next3 scanner;
         Token.Codepoint
-          {c = ch; original = (String.sub [@doesNotRaise]) scanner.src offset 1}
+          {
+            c = Char.code ch;
+            original = (String.sub [@doesNotRaise]) scanner.src offset 1;
+          }
       | ch, _ ->
         next scanner;
         let offset = scanner.offset in
@@ -282783,7 +282855,7 @@ let rec scan scanner =
             (String.sub [@doesNotRaise]) scanner.src offset length
           in
           next scanner;
-          Token.Codepoint {c = Obj.magic codepoint; original = contents})
+          Token.Codepoint {c = codepoint; original = contents})
         else (
           scanner.ch <- ch;
           scanner.offset <- offset;
diff --git a/lib/4.06.1/whole_compiler.ml b/lib/4.06.1/whole_compiler.ml
index 5290656cd4..f3fd968e73 100644
--- a/lib/4.06.1/whole_compiler.ml
+++ b/lib/4.06.1/whole_compiler.ml
@@ -2847,7 +2847,7 @@ module Asttypes
 
 type constant =
     Const_int of int
-  | Const_char of char
+  | Const_char of int
   | Const_string of string * string option
   | Const_float of string
   | Const_int32 of int32
@@ -2901,6 +2901,7 @@ let same_arg_label (x : arg_label) y =
       | Optional s0 -> s = s0
       | _ -> false  
       end  
+
 end
 module File_key
 = struct
@@ -150038,7 +150039,7 @@ type constant =
      Suffixes [g-z][G-Z] are accepted by the parser.
      Suffixes except 'l', 'L' and 'n' are rejected by the typechecker
   *)
-  | Pconst_char of char
+  | Pconst_char of int
   (* 'c' *)
   | Pconst_string of string * string option
   (* "constant"
@@ -155708,7 +155709,7 @@ module Const = struct
   let int64 ?(suffix='L') i = integer ~suffix (Int64.to_string i)
   let nativeint ?(suffix='n') i = integer ~suffix (Nativeint.to_string i)
   let float ?suffix f = Pconst_float (f, suffix)
-  let char c = Pconst_char c
+  let char c = Pconst_char (Char.code c)
   let string ?quotation_delimiter s = Pconst_string (s, quotation_delimiter)
 end
 
@@ -176768,6 +176769,8 @@ exception Invalid_utf8 of string
 
 val decode_utf8_string : string -> int list
 
+val encode_codepoint : int -> string
+
 end = struct
 #1 "ext_utf8.ml"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
@@ -176865,250 +176868,287 @@ let decode_utf8_string s =
 (* let verify s loc =
    assert false *)
 
-end
-module Ast_utf8_string : sig 
-#1 "ast_utf8_string.mli"
-(* Copyright (C) 2015-2016 Bloomberg Finance L.P.
- * 
- * This program is free software: you can redistribute it and/or modify
- * it under the terms of the GNU Lesser General Public License as published by
- * the Free Software Foundation, either version 3 of the License, or
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU Lesser General Public License for more details.
- * 
- * You should have received a copy of the GNU Lesser General Public License
- * along with this program; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
-
-type error
-
-type exn += Error of int (* offset *) * error
-
-val pp_error : Format.formatter -> error -> unit
-
-(* module Interp : sig *)
-(*   val check_and_transform : int -> string -> int -> cxt -> unit *)
-(*   val transform_test : string -> segments *)
-(* end *)
-val transform_test : string -> string
-
-val transform : Location.t -> string -> string
-
-end = struct
-#1 "ast_utf8_string.ml"
-(* Copyright (C) 2015-2016 Bloomberg Finance L.P.
- * 
- * This program is free software: you can redistribute it and/or modify
- * it under the terms of the GNU Lesser General Public License as published by
- * the Free Software Foundation, either version 3 of the License, or
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU Lesser General Public License for more details.
- * 
- * You should have received a copy of the GNU Lesser General Public License
- * along with this program; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
-
-type error =
-  | Invalid_code_point
-  | Unterminated_backslash
-  | Invalid_hex_escape
-  | Invalid_unicode_escape
-  | Invalid_unicode_codepoint_escape
-
-let pp_error fmt err =
-  Format.pp_print_string fmt
-  @@
-  match err with
-  | Invalid_code_point -> "Invalid code point"
-  | Unterminated_backslash -> "\\ ended unexpectedly"
-  | Invalid_hex_escape -> "Invalid \\x escape"
-  | Invalid_unicode_escape -> "Invalid \\u escape"
-  | Invalid_unicode_codepoint_escape ->
-      "Invalid \\u{…} codepoint escape sequence"
-
-type exn += Error of int (* offset *) * error
-
-let error ~loc error = raise (Error (loc, error))
-
-(** Note the [loc] really should be the utf8-offset, it has nothing to do with our 
-    escaping mechanism
-*)
-(* we can not just print new line in ES5
-   seems we don't need
-   escape "\b" "\f"
-   we need escape "\n" "\r" since
-   ocaml multiple-line allows [\n]
-   visual input while es5 string
-   does not*)
-
-let rec check_and_transform (loc : int) (buf : Buffer.t) (s : string)
-    (byte_offset : int) (s_len : int) =
-  if byte_offset = s_len then ()
-  else
-    let current_char = s.[byte_offset] in
-    match Ext_utf8.classify current_char with
-    | Single 92 (* '\\' *) ->
-        escape_code (loc + 1) buf s (byte_offset + 1) s_len
-    | Single 34 ->
-        Buffer.add_string buf "\\\"";
-        check_and_transform (loc + 1) buf s (byte_offset + 1) s_len
-    | Single 10 ->
-        Buffer.add_string buf "\\n";
-        check_and_transform (loc + 1) buf s (byte_offset + 1) s_len
-    | Single 13 ->
-        Buffer.add_string buf "\\r";
-        check_and_transform (loc + 1) buf s (byte_offset + 1) s_len
-    | Single _ ->
-        Buffer.add_char buf current_char;
-        check_and_transform (loc + 1) buf s (byte_offset + 1) s_len
-    | Invalid | Cont _ -> error ~loc Invalid_code_point
-    | Leading (n, _) ->
-        let i' = Ext_utf8.next s ~remaining:n byte_offset in
-        if i' < 0 then error ~loc Invalid_code_point
-        else (
-          for k = byte_offset to i' do
-            Buffer.add_char buf s.[k]
-          done;
-          check_and_transform (loc + 1) buf s (i' + 1) s_len)
-
-(* we share the same escape sequence with js *)
-and escape_code loc buf s offset s_len =
-  if offset >= s_len then error ~loc Unterminated_backslash
-  else Buffer.add_char buf '\\';
-  let cur_char = s.[offset] in
-  match cur_char with
-  | '\\' | 'b' | 't' | 'n' | 'v' | 'f' | 'r' | '0' | '$' ->
-      Buffer.add_char buf cur_char;
-      check_and_transform (loc + 1) buf s (offset + 1) s_len
-  | 'u' ->
-      if offset + 1 >= s_len then error ~loc Invalid_unicode_escape
-      else (
-        Buffer.add_char buf cur_char;
-        let next_char = s.[offset + 1] in
-        match next_char with
-        | '{' ->
-            Buffer.add_char buf next_char;
-            unicode_codepoint_escape (loc + 2) buf s (offset + 2) s_len
-        | _ -> unicode (loc + 1) buf s (offset + 1) s_len)
-  | 'x' ->
-      Buffer.add_char buf cur_char;
-      two_hex (loc + 1) buf s (offset + 1) s_len
-  | _ ->
-      (* Regular characters, like `a` in `\a`,
-       * are valid escape sequences *)
-      Buffer.add_char buf cur_char;
-      check_and_transform (loc + 1) buf s (offset + 1) s_len
-
-and two_hex loc buf s offset s_len =
-  if offset + 1 >= s_len then error ~loc Invalid_hex_escape;
-  (*Location.raise_errorf ~loc "\\x need at least two chars";*)
-  let a, b = (s.[offset], s.[offset + 1]) in
-  if Ext_char.valid_hex a && Ext_char.valid_hex b then (
-    Buffer.add_char buf a;
-    Buffer.add_char buf b;
-    check_and_transform (loc + 2) buf s (offset + 2) s_len)
-  else error ~loc Invalid_hex_escape
-(*Location.raise_errorf ~loc "%c%c is not a valid hex code" a b*)
-
-and unicode loc buf s offset s_len =
-  if offset + 3 >= s_len then error ~loc Invalid_unicode_escape
-    (*Location.raise_errorf ~loc "\\u need at least four chars"*);
-  let a0, a1, a2, a3 =
-    (s.[offset], s.[offset + 1], s.[offset + 2], s.[offset + 3])
-  in
-  if
-    Ext_char.valid_hex a0 && Ext_char.valid_hex a1 && Ext_char.valid_hex a2
-    && Ext_char.valid_hex a3
-  then (
-    Buffer.add_char buf a0;
-    Buffer.add_char buf a1;
-    Buffer.add_char buf a2;
-    Buffer.add_char buf a3;
-    check_and_transform (loc + 4) buf s (offset + 4) s_len)
-  else error ~loc Invalid_unicode_escape
-
-(*Location.raise_errorf ~loc "%c%c%c%c is not a valid unicode point"
-  a0 a1 a2 a3 *)
-(* http://www.2ality.com/2015/01/es6-strings.html
-   console.log('\uD83D\uDE80'); (* ES6*)
-   console.log('\u{1F680}');
-*)
-
-(* ES6 unicode codepoint escape sequences: \u{…}
-   https://262.ecma-international.org/6.0/#sec-literals-string-literals *)
-and unicode_codepoint_escape loc buf s offset s_len =
-  if offset >= s_len then error ~loc Invalid_unicode_codepoint_escape
+let encode_codepoint c =
+  (* reused from syntax/src/res_utf8.ml *)
+  let h2 = 0b1100_0000 in
+  let h3 = 0b1110_0000 in
+  let h4 = 0b1111_0000 in
+  let cont_mask = 0b0011_1111 in
+  if c <= 127 then (
+    let bytes = (Bytes.create [@doesNotRaise]) 1 in
+    Bytes.unsafe_set bytes 0 (Char.unsafe_chr c);
+    Bytes.unsafe_to_string bytes)
+  else if c <= 2047 then (
+    let bytes = (Bytes.create [@doesNotRaise]) 2 in
+    Bytes.unsafe_set bytes 0 (Char.unsafe_chr (h2 lor (c lsr 6)));
+    Bytes.unsafe_set bytes 1
+      (Char.unsafe_chr (0b1000_0000 lor (c land cont_mask)));
+    Bytes.unsafe_to_string bytes)
+  else if c <= 65535 then (
+    let bytes = (Bytes.create [@doesNotRaise]) 3 in
+    Bytes.unsafe_set bytes 0 (Char.unsafe_chr (h3 lor (c lsr 12)));
+    Bytes.unsafe_set bytes 1
+      (Char.unsafe_chr (0b1000_0000 lor ((c lsr 6) land cont_mask)));
+    Bytes.unsafe_set bytes 2
+      (Char.unsafe_chr (0b1000_0000 lor (c land cont_mask)));
+    Bytes.unsafe_to_string bytes)
   else
-    let cur_char = s.[offset] in
-    match cur_char with
-    | '}' ->
-        Buffer.add_char buf cur_char;
-        let x = ref 0 in
-        for ix = loc to offset - 1 do
-          let c = s.[ix] in
-          let value =
-            match c with
-            | '0' .. '9' -> Char.code c - 48
-            | 'a' .. 'f' -> Char.code c - Char.code 'a' + 10
-            | 'A' .. 'F' -> Char.code c + 32 - Char.code 'a' + 10
-            | _ -> 16
-            (* larger than any legal value, unicode_codepoint_escape only makes progress if we have valid hex symbols *)
-          in
-          (* too long escape sequence will result in an overflow, perform an upperbound check *)
-          if !x > 0x10FFFF then error ~loc Invalid_unicode_codepoint_escape
-          else x := (!x * 16) + value
-        done;
-        if Uchar.is_valid !x then
-          check_and_transform (offset + 1) buf s (offset + 1) s_len
-        else error ~loc Invalid_unicode_codepoint_escape
-    | _ ->
-        if Ext_char.valid_hex cur_char then (
-          Buffer.add_char buf cur_char;
-          unicode_codepoint_escape loc buf s (offset + 1) s_len)
-        else error ~loc Invalid_unicode_codepoint_escape
-
-let transform_test s =
-  let s_len = String.length s in
-  let buf = Buffer.create (s_len * 2) in
-  check_and_transform 0 buf s 0 s_len;
-  Buffer.contents buf
+    (* if c <= max then *)
+    let bytes = (Bytes.create [@doesNotRaise]) 4 in
+    Bytes.unsafe_set bytes 0 (Char.unsafe_chr (h4 lor (c lsr 18)));
+    Bytes.unsafe_set bytes 1
+      (Char.unsafe_chr (0b1000_0000 lor ((c lsr 12) land cont_mask)));
+    Bytes.unsafe_set bytes 2
+      (Char.unsafe_chr (0b1000_0000 lor ((c lsr 6) land cont_mask)));
+    Bytes.unsafe_set bytes 3
+      (Char.unsafe_chr (0b1000_0000 lor (c land cont_mask)));
+    Bytes.unsafe_to_string bytes
 
-let transform loc s =
-  let s_len = String.length s in
-  let buf = Buffer.create (s_len * 2) in
-  try
-    check_and_transform 0 buf s 0 s_len;
-    Buffer.contents buf
-  with Error (offset, error) ->
-    Location.raise_errorf ~loc "Offset: %d, %a" offset pp_error error
 
 end
-module Bs_loc : sig 
-#1 "bs_loc.mli"
+module Ast_utf8_string : sig 
+#1 "ast_utf8_string.mli"
+(* Copyright (C) 2015-2016 Bloomberg Finance L.P.
+ * 
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ * 
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
+
+type error
+
+type exn += Error of int (* offset *) * error
+
+val pp_error : Format.formatter -> error -> unit
+
+(* module Interp : sig *)
+(*   val check_and_transform : int -> string -> int -> cxt -> unit *)
+(*   val transform_test : string -> segments *)
+(* end *)
+val transform_test : string -> string
+
+val transform : Location.t -> string -> string
+
+end = struct
+#1 "ast_utf8_string.ml"
+(* Copyright (C) 2015-2016 Bloomberg Finance L.P.
+ * 
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ * 
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
+
+type error =
+  | Invalid_code_point
+  | Unterminated_backslash
+  | Invalid_hex_escape
+  | Invalid_unicode_escape
+  | Invalid_unicode_codepoint_escape
+
+let pp_error fmt err =
+  Format.pp_print_string fmt
+  @@
+  match err with
+  | Invalid_code_point -> "Invalid code point"
+  | Unterminated_backslash -> "\\ ended unexpectedly"
+  | Invalid_hex_escape -> "Invalid \\x escape"
+  | Invalid_unicode_escape -> "Invalid \\u escape"
+  | Invalid_unicode_codepoint_escape ->
+      "Invalid \\u{…} codepoint escape sequence"
+
+type exn += Error of int (* offset *) * error
+
+let error ~loc error = raise (Error (loc, error))
+
+(** Note the [loc] really should be the utf8-offset, it has nothing to do with our 
+    escaping mechanism
+*)
+(* we can not just print new line in ES5
+   seems we don't need
+   escape "\b" "\f"
+   we need escape "\n" "\r" since
+   ocaml multiple-line allows [\n]
+   visual input while es5 string
+   does not*)
+
+let rec check_and_transform (loc : int) (buf : Buffer.t) (s : string)
+    (byte_offset : int) (s_len : int) =
+  if byte_offset = s_len then ()
+  else
+    let current_char = s.[byte_offset] in
+    match Ext_utf8.classify current_char with
+    | Single 92 (* '\\' *) ->
+        escape_code (loc + 1) buf s (byte_offset + 1) s_len
+    | Single 34 ->
+        Buffer.add_string buf "\\\"";
+        check_and_transform (loc + 1) buf s (byte_offset + 1) s_len
+    | Single 10 ->
+        Buffer.add_string buf "\\n";
+        check_and_transform (loc + 1) buf s (byte_offset + 1) s_len
+    | Single 13 ->
+        Buffer.add_string buf "\\r";
+        check_and_transform (loc + 1) buf s (byte_offset + 1) s_len
+    | Single _ ->
+        Buffer.add_char buf current_char;
+        check_and_transform (loc + 1) buf s (byte_offset + 1) s_len
+    | Invalid | Cont _ -> error ~loc Invalid_code_point
+    | Leading (n, _) ->
+        let i' = Ext_utf8.next s ~remaining:n byte_offset in
+        if i' < 0 then error ~loc Invalid_code_point
+        else (
+          for k = byte_offset to i' do
+            Buffer.add_char buf s.[k]
+          done;
+          check_and_transform (loc + 1) buf s (i' + 1) s_len)
+
+(* we share the same escape sequence with js *)
+and escape_code loc buf s offset s_len =
+  if offset >= s_len then error ~loc Unterminated_backslash
+  else Buffer.add_char buf '\\';
+  let cur_char = s.[offset] in
+  match cur_char with
+  | '\\' | 'b' | 't' | 'n' | 'v' | 'f' | 'r' | '0' | '$' ->
+      Buffer.add_char buf cur_char;
+      check_and_transform (loc + 1) buf s (offset + 1) s_len
+  | 'u' ->
+      if offset + 1 >= s_len then error ~loc Invalid_unicode_escape
+      else (
+        Buffer.add_char buf cur_char;
+        let next_char = s.[offset + 1] in
+        match next_char with
+        | '{' ->
+            Buffer.add_char buf next_char;
+            unicode_codepoint_escape (loc + 2) buf s (offset + 2) s_len
+        | _ -> unicode (loc + 1) buf s (offset + 1) s_len)
+  | 'x' ->
+      Buffer.add_char buf cur_char;
+      two_hex (loc + 1) buf s (offset + 1) s_len
+  | _ ->
+      (* Regular characters, like `a` in `\a`,
+       * are valid escape sequences *)
+      Buffer.add_char buf cur_char;
+      check_and_transform (loc + 1) buf s (offset + 1) s_len
+
+and two_hex loc buf s offset s_len =
+  if offset + 1 >= s_len then error ~loc Invalid_hex_escape;
+  (*Location.raise_errorf ~loc "\\x need at least two chars";*)
+  let a, b = (s.[offset], s.[offset + 1]) in
+  if Ext_char.valid_hex a && Ext_char.valid_hex b then (
+    Buffer.add_char buf a;
+    Buffer.add_char buf b;
+    check_and_transform (loc + 2) buf s (offset + 2) s_len)
+  else error ~loc Invalid_hex_escape
+(*Location.raise_errorf ~loc "%c%c is not a valid hex code" a b*)
+
+and unicode loc buf s offset s_len =
+  if offset + 3 >= s_len then error ~loc Invalid_unicode_escape
+    (*Location.raise_errorf ~loc "\\u need at least four chars"*);
+  let a0, a1, a2, a3 =
+    (s.[offset], s.[offset + 1], s.[offset + 2], s.[offset + 3])
+  in
+  if
+    Ext_char.valid_hex a0 && Ext_char.valid_hex a1 && Ext_char.valid_hex a2
+    && Ext_char.valid_hex a3
+  then (
+    Buffer.add_char buf a0;
+    Buffer.add_char buf a1;
+    Buffer.add_char buf a2;
+    Buffer.add_char buf a3;
+    check_and_transform (loc + 4) buf s (offset + 4) s_len)
+  else error ~loc Invalid_unicode_escape
+
+(*Location.raise_errorf ~loc "%c%c%c%c is not a valid unicode point"
+  a0 a1 a2 a3 *)
+(* http://www.2ality.com/2015/01/es6-strings.html
+   console.log('\uD83D\uDE80'); (* ES6*)
+   console.log('\u{1F680}');
+*)
+
+(* ES6 unicode codepoint escape sequences: \u{…}
+   https://262.ecma-international.org/6.0/#sec-literals-string-literals *)
+and unicode_codepoint_escape loc buf s offset s_len =
+  if offset >= s_len then error ~loc Invalid_unicode_codepoint_escape
+  else
+    let cur_char = s.[offset] in
+    match cur_char with
+    | '}' ->
+        Buffer.add_char buf cur_char;
+        let x = ref 0 in
+        for ix = loc to offset - 1 do
+          let c = s.[ix] in
+          let value =
+            match c with
+            | '0' .. '9' -> Char.code c - 48
+            | 'a' .. 'f' -> Char.code c - Char.code 'a' + 10
+            | 'A' .. 'F' -> Char.code c + 32 - Char.code 'a' + 10
+            | _ -> 16
+            (* larger than any legal value, unicode_codepoint_escape only makes progress if we have valid hex symbols *)
+          in
+          (* too long escape sequence will result in an overflow, perform an upperbound check *)
+          if !x > 0x10FFFF then error ~loc Invalid_unicode_codepoint_escape
+          else x := (!x * 16) + value
+        done;
+        if Uchar.is_valid !x then
+          check_and_transform (offset + 1) buf s (offset + 1) s_len
+        else error ~loc Invalid_unicode_codepoint_escape
+    | _ ->
+        if Ext_char.valid_hex cur_char then (
+          Buffer.add_char buf cur_char;
+          unicode_codepoint_escape loc buf s (offset + 1) s_len)
+        else error ~loc Invalid_unicode_codepoint_escape
+
+let transform_test s =
+  let s_len = String.length s in
+  let buf = Buffer.create (s_len * 2) in
+  check_and_transform 0 buf s 0 s_len;
+  Buffer.contents buf
+
+let transform loc s =
+  let s_len = String.length s in
+  let buf = Buffer.create (s_len * 2) in
+  try
+    check_and_transform 0 buf s 0 s_len;
+    Buffer.contents buf
+  with Error (offset, error) ->
+    Location.raise_errorf ~loc "Offset: %d, %a" offset pp_error error
+
+end
+module Bs_loc : sig 
+#1 "bs_loc.mli"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
  * 
  * This program is free software: you can redistribute it and/or modify
@@ -178625,7 +178665,7 @@ type float_lit = { f : string } [@@unboxed]
 
 type number =
   | Float of float_lit
-  | Int of { i : int32; c : char option }
+  | Int of { i : int32; c : int option }
   | Uint of int32
 
 (* becareful when constant folding +/-,
@@ -179616,277 +179656,299 @@ val power_2_above : int -> int -> int
 
 val stats_to_string : Hashtbl.statistics -> string
 
-end = struct
-#1 "ext_util.ml"
-(* Copyright (C) 2015-2016 Bloomberg Finance L.P.
- * 
- * This program is free software: you can redistribute it and/or modify
- * it under the terms of the GNU Lesser General Public License as published by
- * the Free Software Foundation, either version 3 of the License, or
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU Lesser General Public License for more details.
- * 
- * You should have received a copy of the GNU Lesser General Public License
- * along with this program; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
-
-(**
-   {[
-     (power_2_above 16 63 = 64)
-       (power_2_above 16 76 = 128)
-   ]}
-*)
-let rec power_2_above x n =
-  if x >= n then x
-  else if x * 2 > Sys.max_array_length then x
-  else power_2_above (x * 2) n
-
-let stats_to_string
-    ({ num_bindings; num_buckets; max_bucket_length; bucket_histogram } :
-      Hashtbl.statistics) =
-  Printf.sprintf "bindings: %d,buckets: %d, longest: %d, hist:[%s]" num_bindings
-    num_buckets max_bucket_length
-    (String.concat ","
-       (Array.to_list (Array.map string_of_int bucket_histogram)))
-
-end
-module Hash_set_gen
-= struct
-#1 "hash_set_gen.ml"
-(* Copyright (C) 2015-2016 Bloomberg Finance L.P.
- * 
- * This program is free software: you can redistribute it and/or modify
- * it under the terms of the GNU Lesser General Public License as published by
- * the Free Software Foundation, either version 3 of the License, or
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU Lesser General Public License for more details.
- * 
- * You should have received a copy of the GNU Lesser General Public License
- * along with this program; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
-
-(* We do dynamic hashing, and resize the table and rehash the elements
-   when buckets become too long. *)
-
-type 'a bucket =
-  | Empty
-  | Cons of { mutable key : 'a; mutable next : 'a bucket }
-
-type 'a t = {
-  mutable size : int;
-  (* number of entries *)
-  mutable data : 'a bucket array;
-  (* the buckets *)
-  initial_size : int; (* initial array size *)
-}
-
-let create initial_size =
-  let s = Ext_util.power_2_above 16 initial_size in
-  { initial_size = s; size = 0; data = Array.make s Empty }
-
-let clear h =
-  h.size <- 0;
-  let len = Array.length h.data in
-  for i = 0 to len - 1 do
-    Array.unsafe_set h.data i Empty
-  done
-
-let reset h =
-  h.size <- 0;
-  h.data <- Array.make h.initial_size Empty
-
-let length h = h.size
+val string_of_int_as_char : int -> string
 
-let resize indexfun h =
-  let odata = h.data in
-  let osize = Array.length odata in
-  let nsize = osize * 2 in
-  if nsize < Sys.max_array_length then (
-    let ndata = Array.make nsize Empty in
-    let ndata_tail = Array.make nsize Empty in
-    h.data <- ndata;
-    (* so that indexfun sees the new bucket count *)
-    let rec insert_bucket = function
-      | Empty -> ()
-      | Cons { key; next } as cell ->
-          let nidx = indexfun h key in
-          (match Array.unsafe_get ndata_tail nidx with
-          | Empty -> Array.unsafe_set ndata nidx cell
-          | Cons tail -> tail.next <- cell);
-          Array.unsafe_set ndata_tail nidx cell;
-          insert_bucket next
-    in
-    for i = 0 to osize - 1 do
-      insert_bucket (Array.unsafe_get odata i)
-    done;
-    for i = 0 to nsize - 1 do
-      match Array.unsafe_get ndata_tail i with
-      | Empty -> ()
-      | Cons tail -> tail.next <- Empty
-    done)
-
-let iter h f =
-  let rec do_bucket = function
-    | Empty -> ()
-    | Cons l ->
-        f l.key;
-        do_bucket l.next
-  in
-  let d = h.data in
-  for i = 0 to Array.length d - 1 do
-    do_bucket (Array.unsafe_get d i)
-  done
-
-let fold h init f =
-  let rec do_bucket b accu =
-    match b with Empty -> accu | Cons l -> do_bucket l.next (f l.key accu)
-  in
-  let d = h.data in
-  let accu = ref init in
-  for i = 0 to Array.length d - 1 do
-    accu := do_bucket (Array.unsafe_get d i) !accu
-  done;
-  !accu
-
-let to_list set = fold set [] List.cons
-
-let rec small_bucket_mem eq key lst =
-  match lst with
-  | Empty -> false
-  | Cons lst -> (
-      eq key lst.key
-      ||
-      match lst.next with
-      | Empty -> false
-      | Cons lst -> (
-          eq key lst.key
-          ||
-          match lst.next with
-          | Empty -> false
-          | Cons lst -> eq key lst.key || small_bucket_mem eq key lst.next))
-
-let rec remove_bucket (h : _ t) (i : int) key ~(prec : _ bucket)
-    (buck : _ bucket) eq_key =
-  match buck with
-  | Empty -> ()
-  | Cons { key = k; next } ->
-      if eq_key k key then (
-        h.size <- h.size - 1;
-        match prec with
-        | Empty -> Array.unsafe_set h.data i next
-        | Cons c -> c.next <- next)
-      else remove_bucket h i key ~prec:buck next eq_key
-
-module type S = sig
-  type key
-
-  type t
-
-  val create : int -> t
-
-  val clear : t -> unit
-
-  val reset : t -> unit
-
-  (* val copy: t -> t *)
-  val remove : t -> key -> unit
-
-  val add : t -> key -> unit
-
-  val of_array : key array -> t
-
-  val check_add : t -> key -> bool
-
-  val mem : t -> key -> bool
-
-  val iter : t -> (key -> unit) -> unit
-
-  val fold : t -> 'b -> (key -> 'b -> 'b) -> 'b
-
-  val length : t -> int
-
-  (* val stats:  t -> Hashtbl.statistics *)
-  val to_list : t -> key list
-end
-
-end
-module Hash_set_poly : sig 
-#1 "hash_set_poly.mli"
-(* Copyright (C) 2015-2016 Bloomberg Finance L.P.
- * 
- * This program is free software: you can redistribute it and/or modify
- * it under the terms of the GNU Lesser General Public License as published by
- * the Free Software Foundation, either version 3 of the License, or
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU Lesser General Public License for more details.
- * 
- * You should have received a copy of the GNU Lesser General Public License
- * along with this program; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
-
-type 'a t
-
-val create : int -> 'a t
-
-val clear : 'a t -> unit
-
-val reset : 'a t -> unit
-
-(* val copy : 'a t -> 'a t *)
-
-val add : 'a t -> 'a -> unit
-
-val remove : 'a t -> 'a -> unit
-
-val mem : 'a t -> 'a -> bool
-
-val iter : 'a t -> ('a -> unit) -> unit
-
-val to_list : 'a t -> 'a list
-
-val length : 'a t -> int
-
-(* val stats:  'a t -> Hashtbl.statistics *)
 
 end = struct
-#1 "hash_set_poly.ml"
-# 1 "ext/hash_set.cppo.ml"
+#1 "ext_util.ml"
+(* Copyright (C) 2015-2016 Bloomberg Finance L.P.
+ * 
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ * 
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
+
+(**
+   {[
+     (power_2_above 16 63 = 64)
+       (power_2_above 16 76 = 128)
+   ]}
+*)
+let rec power_2_above x n =
+  if x >= n then x
+  else if x * 2 > Sys.max_array_length then x
+  else power_2_above (x * 2) n
+
+let stats_to_string
+    ({ num_bindings; num_buckets; max_bucket_length; bucket_histogram } :
+      Hashtbl.statistics) =
+  Printf.sprintf "bindings: %d,buckets: %d, longest: %d, hist:[%s]" num_bindings
+    num_buckets max_bucket_length
+    (String.concat ","
+       (Array.to_list (Array.map string_of_int bucket_histogram)))
+
+let string_of_int_as_char (i : int) : string =
+  if i <= 255 && i >= 0 then Format.asprintf "%C" (Char.unsafe_chr i)
+  else
+    let str =
+      match Char.unsafe_chr i with
+      | '\'' -> "\\'"
+      | '\\' -> "\\\\"
+      | '\n' -> "\\n"
+      | '\t' -> "\\t"
+      | '\r' -> "\\r"
+      | '\b' -> "\\b"
+      | ' ' .. '~' as c ->
+          let s = (Bytes.create [@doesNotRaise]) 1 in
+          Bytes.unsafe_set s 0 c;
+          Bytes.unsafe_to_string s
+      | _ -> Ext_utf8.encode_codepoint i
+    in
+    Printf.sprintf "\'%s\'" str
+
+end
+module Hash_set_gen
+= struct
+#1 "hash_set_gen.ml"
+(* Copyright (C) 2015-2016 Bloomberg Finance L.P.
+ * 
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ * 
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
+
+(* We do dynamic hashing, and resize the table and rehash the elements
+   when buckets become too long. *)
+
+type 'a bucket =
+  | Empty
+  | Cons of { mutable key : 'a; mutable next : 'a bucket }
+
+type 'a t = {
+  mutable size : int;
+  (* number of entries *)
+  mutable data : 'a bucket array;
+  (* the buckets *)
+  initial_size : int; (* initial array size *)
+}
+
+let create initial_size =
+  let s = Ext_util.power_2_above 16 initial_size in
+  { initial_size = s; size = 0; data = Array.make s Empty }
+
+let clear h =
+  h.size <- 0;
+  let len = Array.length h.data in
+  for i = 0 to len - 1 do
+    Array.unsafe_set h.data i Empty
+  done
+
+let reset h =
+  h.size <- 0;
+  h.data <- Array.make h.initial_size Empty
+
+let length h = h.size
+
+let resize indexfun h =
+  let odata = h.data in
+  let osize = Array.length odata in
+  let nsize = osize * 2 in
+  if nsize < Sys.max_array_length then (
+    let ndata = Array.make nsize Empty in
+    let ndata_tail = Array.make nsize Empty in
+    h.data <- ndata;
+    (* so that indexfun sees the new bucket count *)
+    let rec insert_bucket = function
+      | Empty -> ()
+      | Cons { key; next } as cell ->
+          let nidx = indexfun h key in
+          (match Array.unsafe_get ndata_tail nidx with
+          | Empty -> Array.unsafe_set ndata nidx cell
+          | Cons tail -> tail.next <- cell);
+          Array.unsafe_set ndata_tail nidx cell;
+          insert_bucket next
+    in
+    for i = 0 to osize - 1 do
+      insert_bucket (Array.unsafe_get odata i)
+    done;
+    for i = 0 to nsize - 1 do
+      match Array.unsafe_get ndata_tail i with
+      | Empty -> ()
+      | Cons tail -> tail.next <- Empty
+    done)
+
+let iter h f =
+  let rec do_bucket = function
+    | Empty -> ()
+    | Cons l ->
+        f l.key;
+        do_bucket l.next
+  in
+  let d = h.data in
+  for i = 0 to Array.length d - 1 do
+    do_bucket (Array.unsafe_get d i)
+  done
+
+let fold h init f =
+  let rec do_bucket b accu =
+    match b with Empty -> accu | Cons l -> do_bucket l.next (f l.key accu)
+  in
+  let d = h.data in
+  let accu = ref init in
+  for i = 0 to Array.length d - 1 do
+    accu := do_bucket (Array.unsafe_get d i) !accu
+  done;
+  !accu
+
+let to_list set = fold set [] List.cons
+
+let rec small_bucket_mem eq key lst =
+  match lst with
+  | Empty -> false
+  | Cons lst -> (
+      eq key lst.key
+      ||
+      match lst.next with
+      | Empty -> false
+      | Cons lst -> (
+          eq key lst.key
+          ||
+          match lst.next with
+          | Empty -> false
+          | Cons lst -> eq key lst.key || small_bucket_mem eq key lst.next))
+
+let rec remove_bucket (h : _ t) (i : int) key ~(prec : _ bucket)
+    (buck : _ bucket) eq_key =
+  match buck with
+  | Empty -> ()
+  | Cons { key = k; next } ->
+      if eq_key k key then (
+        h.size <- h.size - 1;
+        match prec with
+        | Empty -> Array.unsafe_set h.data i next
+        | Cons c -> c.next <- next)
+      else remove_bucket h i key ~prec:buck next eq_key
+
+module type S = sig
+  type key
+
+  type t
+
+  val create : int -> t
+
+  val clear : t -> unit
+
+  val reset : t -> unit
+
+  (* val copy: t -> t *)
+  val remove : t -> key -> unit
+
+  val add : t -> key -> unit
+
+  val of_array : key array -> t
+
+  val check_add : t -> key -> bool
+
+  val mem : t -> key -> bool
+
+  val iter : t -> (key -> unit) -> unit
+
+  val fold : t -> 'b -> (key -> 'b -> 'b) -> 'b
+
+  val length : t -> int
+
+  (* val stats:  t -> Hashtbl.statistics *)
+  val to_list : t -> key list
+end
+
+end
+module Hash_set_poly : sig 
+#1 "hash_set_poly.mli"
+(* Copyright (C) 2015-2016 Bloomberg Finance L.P.
+ * 
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ * 
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
+
+type 'a t
+
+val create : int -> 'a t
+
+val clear : 'a t -> unit
+
+val reset : 'a t -> unit
+
+(* val copy : 'a t -> 'a t *)
+
+val add : 'a t -> 'a -> unit
+
+val remove : 'a t -> 'a -> unit
+
+val mem : 'a t -> 'a -> bool
+
+val iter : 'a t -> ('a -> unit) -> unit
+
+val to_list : 'a t -> 'a list
+
+val length : 'a t -> int
+
+(* val stats:  'a t -> Hashtbl.statistics *)
+
+end = struct
+#1 "hash_set_poly.ml"
+# 1 "ext/hash_set.cppo.ml"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
  * 
  * This program is free software: you can redistribute it and/or modify
@@ -186662,15 +186724,15 @@ let maybe_pointer_type env typ =
   | _ -> true
 
 end
-module TypedtreeIter : sig 
-#1 "typedtreeIter.mli"
+module Pprintast : sig 
+#1 "pprintast.mli"
 (**************************************************************************)
 (*                                                                        *)
 (*                                 OCaml                                  *)
 (*                                                                        *)
-(*    Thomas Gazagnaire (OCamlPro), Fabrice Le Fessant (INRIA Saclay)     *)
+(*             Hongbo Zhang (University of Pennsylvania)                  *)
 (*                                                                        *)
-(*   Copyright 2007 Institut National de Recherche en Informatique et     *)
+(*   Copyright 1996 Institut National de Recherche en Informatique et     *)
 (*     en Automatique.                                                    *)
 (*                                                                        *)
 (*   All rights reserved.  This file is distributed under the terms of    *)
@@ -186679,87 +186741,28 @@ module TypedtreeIter : sig
 (*                                                                        *)
 (**************************************************************************)
 
-open Asttypes
-open Typedtree
-
-
-module type IteratorArgument = sig
-    val enter_structure : structure -> unit
-    val enter_value_description : value_description -> unit
-    val enter_type_extension : type_extension -> unit
-    val enter_extension_constructor : extension_constructor -> unit
-    val enter_pattern : pattern -> unit
-    val enter_expression : expression -> unit
-    val enter_package_type : package_type -> unit
-    val enter_signature : signature -> unit
-    val enter_signature_item : signature_item -> unit
-    val enter_module_type_declaration : module_type_declaration -> unit
-    val enter_module_type : module_type -> unit
-    val enter_module_expr : module_expr -> unit
-    val enter_with_constraint : with_constraint -> unit
-    val enter_class_signature : class_signature -> unit
-    val enter_class_description : class_description -> unit
-    val enter_class_type_declaration : class_type_declaration -> unit
-    val enter_class_type : class_type -> unit
-    val enter_class_type_field : class_type_field -> unit
-    val enter_core_type : core_type -> unit
-    val enter_structure_item : structure_item -> unit
-
-
-    val leave_structure : structure -> unit
-    val leave_value_description : value_description -> unit
-    val leave_type_extension : type_extension -> unit
-    val leave_extension_constructor : extension_constructor -> unit
-    val leave_pattern : pattern -> unit
-    val leave_expression : expression -> unit
-    val leave_package_type : package_type -> unit
-    val leave_signature : signature -> unit
-    val leave_signature_item : signature_item -> unit
-    val leave_module_type_declaration : module_type_declaration -> unit
-    val leave_module_type : module_type -> unit
-    val leave_module_expr : module_expr -> unit
-    val leave_with_constraint : with_constraint -> unit
-    val leave_class_signature : class_signature -> unit
-    val leave_class_description : class_description -> unit
-    val leave_class_type_declaration : class_type_declaration -> unit
-    val leave_class_type : class_type -> unit
-    val leave_class_type_field : class_type_field -> unit
-    val leave_core_type : core_type -> unit
-    val leave_structure_item : structure_item -> unit
-
-    val enter_bindings : rec_flag -> unit
-    val enter_binding : value_binding -> unit
-    val leave_binding : value_binding -> unit
-    val leave_bindings : rec_flag -> unit
-
-    val enter_type_declarations : rec_flag -> unit
-    val enter_type_declaration : type_declaration -> unit
-    val leave_type_declaration : type_declaration -> unit
-    val leave_type_declarations : rec_flag -> unit
+type space_formatter = (unit, Format.formatter, unit) format
 
-end
 
-module [@warning "-67"] MakeIterator :
-  functor (Iter : IteratorArgument) ->
-    sig
-      val iter_structure : structure -> unit
-      val iter_signature : signature -> unit
-      val iter_structure_item : structure_item -> unit
-      val iter_signature_item : signature_item -> unit
-      val iter_expression : expression -> unit
-      val iter_module_type : module_type -> unit
-      val iter_pattern : pattern -> unit
-    end
+val expression : Format.formatter -> Parsetree.expression -> unit
+val string_of_expression : Parsetree.expression -> string
 
-module DefaultIteratorArgument : IteratorArgument
+val core_type: Format.formatter -> Parsetree.core_type -> unit
+val pattern: Format.formatter -> Parsetree.pattern -> unit
+val signature: Format.formatter -> Parsetree.signature -> unit
+val structure: Format.formatter -> Parsetree.structure -> unit
+val string_of_structure: Parsetree.structure -> string
+val string_of_int_as_char: int -> string
 
 end = struct
-#1 "typedtreeIter.ml"
+#1 "pprintast.pp.ml"
 (**************************************************************************)
 (*                                                                        *)
 (*                                 OCaml                                  *)
 (*                                                                        *)
-(*    Thomas Gazagnaire (OCamlPro), Fabrice Le Fessant (INRIA Saclay)     *)
+(*                      Thomas Gazagnaire, OCamlPro                       *)
+(*                   Fabrice Le Fessant, INRIA Saclay                     *)
+(*               Hongbo Zhang, University of Pennsylvania                 *)
 (*                                                                        *)
 (*   Copyright 2007 Institut National de Recherche en Informatique et     *)
 (*     en Automatique.                                                    *)
@@ -186770,666 +186773,1425 @@ end = struct
 (*                                                                        *)
 (**************************************************************************)
 
-(*
-TODO:
- - 2012/05/10: Follow camlp4 way of building map and iter using classes
-     and inheritance ?
-*)
+(* Original Code from Ber-metaocaml, modified for 3.12.0 and fixed *)
+(* Printing code expressions *)
+(* Authors:  Ed Pizzi, Fabrice Le Fessant *)
+(* Extensive Rewrite: Hongbo Zhang: University of Pennsylvania *)
+(* TODO more fine-grained precedence pretty-printing *)
 
 open Asttypes
-open Typedtree
-
-module type IteratorArgument = sig
-
-    val enter_structure : structure -> unit
-    val enter_value_description : value_description -> unit
-    val enter_type_extension : type_extension -> unit
-    val enter_extension_constructor : extension_constructor -> unit
-    val enter_pattern : pattern -> unit
-    val enter_expression : expression -> unit
-    val enter_package_type : package_type -> unit
-    val enter_signature : signature -> unit
-    val enter_signature_item : signature_item -> unit
-    val enter_module_type_declaration : module_type_declaration -> unit
-    val enter_module_type : module_type -> unit
-    val enter_module_expr : module_expr -> unit
-    val enter_with_constraint : with_constraint -> unit
-    val enter_class_signature : class_signature -> unit
+open Format
+open Location
+open Longident
+open Parsetree
+open Ast_helper
 
-    val enter_class_description : class_description -> unit
-    val enter_class_type_declaration : class_type_declaration -> unit
-    val enter_class_type : class_type -> unit
-    val enter_class_type_field : class_type_field -> unit
-    val enter_core_type : core_type -> unit
-    val enter_structure_item : structure_item -> unit
+let prefix_symbols  = [ '!'; '?'; '~' ] ;;
+let infix_symbols = [ '='; '<'; '>'; '@'; '^'; '|'; '&'; '+'; '-'; '*'; '/';
+                      '$'; '%'; '#' ]
 
+(* type fixity = Infix| Prefix  *)
+let special_infix_strings =
+  ["asr"; "land"; "lor"; "lsl"; "lsr"; "lxor"; "mod"; "or"; ":="; "!="; "::" ]
 
-    val leave_structure : structure -> unit
-    val leave_value_description : value_description -> unit
-    val leave_type_extension : type_extension -> unit
-    val leave_extension_constructor : extension_constructor -> unit
-    val leave_pattern : pattern -> unit
-    val leave_expression : expression -> unit
-    val leave_package_type : package_type -> unit
-    val leave_signature : signature -> unit
-    val leave_signature_item : signature_item -> unit
-    val leave_module_type_declaration : module_type_declaration -> unit
-    val leave_module_type : module_type -> unit
-    val leave_module_expr : module_expr -> unit
-    val leave_with_constraint : with_constraint -> unit
-    val leave_class_signature : class_signature -> unit
+(* determines if the string is an infix string.
+   checks backwards, first allowing a renaming postfix ("_102") which
+   may have resulted from Pexp -> Texp -> Pexp translation, then checking
+   if all the characters in the beginning of the string are valid infix
+   characters. *)
+let fixity_of_string  = function
+  | s when List.mem s special_infix_strings -> `Infix s
+  | s when List.mem s.[0] infix_symbols -> `Infix s
+  | s when List.mem s.[0] prefix_symbols -> `Prefix s
+  | s when s.[0] = '.' -> `Mixfix s
+  | _ -> `Normal
 
-    val leave_class_description : class_description -> unit
-    val leave_class_type_declaration : class_type_declaration -> unit
-    val leave_class_type : class_type -> unit
-    val leave_class_type_field : class_type_field -> unit
-    val leave_core_type : core_type -> unit
-    val leave_structure_item : structure_item -> unit
+let view_fixity_of_exp = function
+  | {pexp_desc = Pexp_ident {txt=Lident l;_}; pexp_attributes = []} ->
+      fixity_of_string l
+  | _ -> `Normal
 
-    val enter_bindings : rec_flag -> unit
-    val enter_binding : value_binding -> unit
-    val leave_binding : value_binding -> unit
-    val leave_bindings : rec_flag -> unit
+let is_infix  = function  | `Infix _ -> true | _  -> false
+let is_mixfix = function `Mixfix _ -> true | _ -> false
 
-    val enter_type_declarations : rec_flag -> unit
-    val enter_type_declaration : type_declaration -> unit
-    val leave_type_declaration : type_declaration -> unit
-    val leave_type_declarations : rec_flag -> unit
+(* which identifiers are in fact operators needing parentheses *)
+let needs_parens txt =
+  let fix = fixity_of_string txt in
+  is_infix fix
+  || is_mixfix fix
+  || List.mem txt.[0] prefix_symbols
 
-      end
+(* some infixes need spaces around parens to avoid clashes with comment
+   syntax *)
+let needs_spaces txt =
+  txt.[0]='*' || txt.[String.length txt - 1] = '*'
 
-module MakeIterator(Iter : IteratorArgument) : sig
+(* add parentheses to binders when they are in fact infix or prefix operators *)
+let protect_ident ppf txt =
+  let format : (_, _, _) format =
+    if not (needs_parens txt) then "%s"
+    else if needs_spaces txt then "(@;%s@;)"
+    else "(%s)"
+  in fprintf ppf format txt
 
-    val iter_structure : structure -> unit
-    val iter_signature : signature -> unit
-    val iter_structure_item : structure_item -> unit
-    val iter_signature_item : signature_item -> unit
-    val iter_expression : expression -> unit
-    val iter_module_type : module_type -> unit
-    val iter_pattern : pattern -> unit
+let protect_longident ppf print_longident longprefix txt =
+  let format : (_, _, _) format =
+    if not (needs_parens txt) then "%a.%s"
+    else if needs_spaces txt then  "%a.(@;%s@;)"
+    else "%a.(%s)" in
+  fprintf ppf format print_longident longprefix txt
 
-  end = struct
+type space_formatter = (unit, Format.formatter, unit) format
 
-    let may_iter f v =
-      match v with
-        None -> ()
-      | Some x -> f x
+let override = function
+  | Override -> "!"
+  | Fresh -> ""
 
+(* variance encoding: need to sync up with the [parser.mly] *)
+let type_variance = function
+  | Invariant -> ""
+  | Covariant -> "+"
+  | Contravariant -> "-"
 
-    let rec iter_structure str =
-      Iter.enter_structure str;
-      List.iter iter_structure_item str.str_items;
-      Iter.leave_structure str
+type construct =
+  [ `cons of expression list
+  | `list of expression list
+  | `nil
+  | `normal
+  | `simple of Longident.t
+  | `tuple ]
 
+let view_expr x =
+  match x.pexp_desc with
+  | Pexp_construct ( {txt= Lident "()"; _},_) -> `tuple
+  | Pexp_construct ( {txt= Lident "[]";_},_) -> `nil
+  | Pexp_construct ( {txt= Lident"::";_},Some _) ->
+      let rec loop exp acc = match exp with
+          | {pexp_desc=Pexp_construct ({txt=Lident "[]";_},_);
+             pexp_attributes = []} ->
+              (List.rev acc,true)
+          | {pexp_desc=
+             Pexp_construct ({txt=Lident "::";_},
+                             Some ({pexp_desc= Pexp_tuple([e1;e2]);
+                                    pexp_attributes = []}));
+             pexp_attributes = []}
+            ->
+              loop e2 (e1::acc)
+          | e -> (List.rev (e::acc),false) in
+      let (ls,b) = loop x []  in
+      if b then
+        `list ls
+      else `cons ls
+  | Pexp_construct (x,None) -> `simple (x.txt)
+  | _ -> `normal
 
-    and iter_binding vb =
-      Iter.enter_binding vb;
-      iter_pattern vb.vb_pat;
-      iter_expression vb.vb_expr;
-      Iter.leave_binding vb
+let is_simple_construct :construct -> bool = function
+  | `nil | `tuple | `list _ | `simple _  -> true
+  | `cons _ | `normal -> false
 
-    and iter_bindings rec_flag list =
-      Iter.enter_bindings rec_flag;
-      List.iter iter_binding list;
-      Iter.leave_bindings rec_flag
+let pp = fprintf
 
-    and iter_case {c_lhs; c_guard; c_rhs} =
-      iter_pattern c_lhs;
-      may_iter iter_expression c_guard;
-      iter_expression c_rhs
+type ctxt = {
+  pipe : bool;
+  semi : bool;
+  ifthenelse : bool;
+}
 
-    and iter_cases cases =
-      List.iter iter_case cases
+let reset_ctxt = { pipe=false; semi=false; ifthenelse=false }
+let under_pipe ctxt = { ctxt with pipe=true }
+let under_semi ctxt = { ctxt with semi=true }
+let under_ifthenelse ctxt = { ctxt with ifthenelse=true }
+(*
+let reset_semi ctxt = { ctxt with semi=false }
+let reset_ifthenelse ctxt = { ctxt with ifthenelse=false }
+let reset_pipe ctxt = { ctxt with pipe=false }
+*)
 
-    and iter_structure_item item =
-      Iter.enter_structure_item item;
-      begin
-        match item.str_desc with
-          Tstr_eval (exp, _attrs) -> iter_expression exp
-        | Tstr_value (rec_flag, list) ->
-            iter_bindings rec_flag list
-        | Tstr_primitive vd -> iter_value_description vd
-        | Tstr_type (rf, list) -> iter_type_declarations rf list
-        | Tstr_typext tyext -> iter_type_extension tyext
-        | Tstr_exception ext -> iter_extension_constructor ext
-        | Tstr_module x -> iter_module_binding x
-        | Tstr_recmodule list -> List.iter iter_module_binding list
-        | Tstr_modtype mtd -> iter_module_type_declaration mtd
-        | Tstr_open _ -> ()
-        | Tstr_class () -> ()
-        | Tstr_class_type list ->
-            List.iter
-              (fun (_, _, ct) -> iter_class_type_declaration ct)
-              list
-        | Tstr_include incl -> iter_module_expr incl.incl_mod
-        | Tstr_attribute _ ->
-            ()
-      end;
-      Iter.leave_structure_item item
+let list : 'a . ?sep:space_formatter -> ?first:space_formatter ->
+  ?last:space_formatter -> (Format.formatter -> 'a -> unit) ->
+  Format.formatter -> 'a list -> unit
+  = fun ?sep ?first ?last fu f xs ->
+    let first = match first with Some x -> x |None -> ("": _ format6)
+    and last = match last with Some x -> x |None -> ("": _ format6)
+    and sep = match sep with Some x -> x |None -> ("@ ": _ format6) in
+    let aux f = function
+      | [] -> ()
+      | [x] -> fu f x
+      | xs ->
+          let rec loop  f = function
+            | [x] -> fu f x
+            | x::xs ->  fu f x; pp f sep; loop f xs;
+            | _ -> assert false in begin
+            pp f first; loop f xs; pp f last;
+          end in
+    aux f xs
 
-    and iter_module_binding x =
-      iter_module_expr x.mb_expr
+let option : 'a. ?first:space_formatter -> ?last:space_formatter ->
+  (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a option -> unit
+  = fun  ?first  ?last fu f a ->
+    let first = match first with Some x -> x | None -> ("": _ format6)
+    and last = match last with Some x -> x | None -> ("": _ format6) in
+    match a with
+    | None -> ()
+    | Some x -> pp f first; fu f x; pp f last
 
-    and iter_value_description v =
-      Iter.enter_value_description v;
-      iter_core_type v.val_desc;
-      Iter.leave_value_description v
+let paren: 'a . ?first:space_formatter -> ?last:space_formatter ->
+  bool -> (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a -> unit
+  = fun  ?(first=("": _ format6)) ?(last=("": _ format6)) b fu f x ->
+    if b then (pp f "("; pp f first; fu f x; pp f last; pp f ")")
+    else fu f x
 
-    and iter_constructor_arguments = function
-      | Cstr_tuple l -> List.iter iter_core_type l
-      | Cstr_record l -> List.iter (fun ld -> iter_core_type ld.ld_type) l
+let rec longident f = function
+  | Lident s -> protect_ident f s
+  | Ldot(y,s) -> protect_longident f longident y s
+  | Lapply (y,s) ->
+      pp f "%a(%a)" longident y longident s
 
-    and iter_constructor_declaration cd =
-      iter_constructor_arguments cd.cd_args;
-      option iter_core_type cd.cd_res;
+let longident_loc f x = pp f "%a" longident x.txt
 
-    and iter_type_parameter (ct, _v) =
-      iter_core_type ct
+let string_of_int_as_char i = Ext_util.string_of_int_as_char i
 
-    and iter_type_declaration decl =
-      Iter.enter_type_declaration decl;
-      List.iter iter_type_parameter decl.typ_params;
-      List.iter (fun (ct1, ct2, _loc) ->
-          iter_core_type ct1;
-          iter_core_type ct2
-      ) decl.typ_cstrs;
-      begin match decl.typ_kind with
-          Ttype_abstract -> ()
-        | Ttype_variant list ->
-            List.iter iter_constructor_declaration list
-        | Ttype_record list ->
-            List.iter
-              (fun ld ->
-                iter_core_type ld.ld_type
-            ) list
-        | Ttype_open -> ()
-      end;
-      option iter_core_type decl.typ_manifest;
-      Iter.leave_type_declaration decl
+let constant f = function
+  | Pconst_char i -> pp f "%s"  (string_of_int_as_char i)
+  | Pconst_string (i, None) -> pp f "%S" i
+  | Pconst_string (i, Some delim) -> pp f "{%s|%s|%s}" delim i delim
+  | Pconst_integer (i, None) -> paren (i.[0]='-') (fun f -> pp f "%s") f i
+  | Pconst_integer (i, Some m) ->
+    paren (i.[0]='-') (fun f (i, m) -> pp f "%s%c" i m) f (i,m)
+  | Pconst_float (i, None) -> paren (i.[0]='-') (fun f -> pp f "%s") f i
+  | Pconst_float (i, Some m) -> paren (i.[0]='-') (fun f (i,m) ->
+      pp f "%s%c" i m) f (i,m)
 
-    and iter_type_declarations rec_flag decls =
-      Iter.enter_type_declarations rec_flag;
-      List.iter iter_type_declaration decls;
-      Iter.leave_type_declarations rec_flag
+(* trailing space*)
+let mutable_flag f = function
+  | Immutable -> ()
+  | Mutable -> pp f "mutable@;"
+let virtual_flag f  = function
+  | Concrete -> ()
+  | Virtual -> pp f "virtual@;"
 
-    and iter_extension_constructor ext =
-      Iter.enter_extension_constructor ext;
-      begin match ext.ext_kind with
-          Text_decl(args, ret) ->
-          iter_constructor_arguments args;
-            option iter_core_type ret
-        | Text_rebind _ -> ()
-      end;
-      Iter.leave_extension_constructor ext;
+(* trailing space added *)
+let rec_flag f rf =
+  match rf with
+  | Nonrecursive -> ()
+  | Recursive -> pp f "rec "
+let nonrec_flag f rf =
+  match rf with
+  | Nonrecursive -> pp f "nonrec "
+  | Recursive -> ()
+let direction_flag f = function
+  | Upto -> pp f "to@ "
+  | Downto -> pp f "downto@ "
+let private_flag f = function
+  | Public -> ()
+  | Private -> pp f "private@ "
 
-    and iter_type_extension tyext =
-      Iter.enter_type_extension tyext;
-      List.iter iter_type_parameter tyext.tyext_params;
-      List.iter iter_extension_constructor tyext.tyext_constructors;
-      Iter.leave_type_extension tyext
+let constant_string f s = pp f "%S" s
+let tyvar f str = pp f "'%s" str
+let tyvar_loc f str = pp f "'%s" str.txt
+let string_quot f x = pp f "`%s" x
 
-    and iter_pattern pat =
-      Iter.enter_pattern pat;
-      List.iter (fun (cstr, _, _attrs) -> match cstr with
-              | Tpat_type _ -> ()
-              | Tpat_unpack -> ()
-              | Tpat_open _ -> ()
-              | Tpat_constraint ct -> iter_core_type ct) pat.pat_extra;
-      begin
-        match pat.pat_desc with
-          Tpat_any -> ()
-        | Tpat_var _ -> ()
-        | Tpat_alias (pat1, _, _) -> iter_pattern pat1
-        | Tpat_constant _ -> ()
-        | Tpat_tuple list ->
-            List.iter iter_pattern list
-        | Tpat_construct (_, _, args) ->
-            List.iter iter_pattern args
-        | Tpat_variant (_, pato, _) ->
-            begin match pato with
-                None -> ()
-              | Some pat -> iter_pattern pat
-            end
-        | Tpat_record (list, _closed) ->
-            List.iter (fun (_, _, pat) -> iter_pattern pat) list
-        | Tpat_array list -> List.iter iter_pattern list
-        | Tpat_or (p1, p2, _) -> iter_pattern p1; iter_pattern p2
-        | Tpat_lazy p -> iter_pattern p
-      end;
-      Iter.leave_pattern pat
+(* c ['a,'b] *)
+let rec class_params_def ctxt f =  function
+  | [] -> ()
+  | l ->
+      pp f "[%a] " (* space *)
+        (list (type_param ctxt) ~sep:",") l
 
-    and option f x = match x with None -> () | Some e -> f e
+and type_with_label ctxt f (label, c) =
+  match label with
+  | Nolabel    -> core_type1 ctxt f c (* otherwise parenthesize *)
+  | Labelled s -> pp f "%s:%a" s (core_type1 ctxt) c
+  | Optional s -> pp f "?%s:%a" s (core_type1 ctxt) c
 
-    and iter_expression exp =
-      Iter.enter_expression exp;
-      List.iter (function (cstr, _, _attrs) ->
-        match cstr with
-          Texp_constraint ct ->
-            iter_core_type ct
-        | Texp_coerce (cty1, cty2) ->
-            option iter_core_type cty1; iter_core_type cty2
-        | Texp_open _ -> ()
-        | Texp_poly cto -> option iter_core_type cto
-        | Texp_newtype _ -> ())
-        exp.exp_extra;
-      begin
-        match exp.exp_desc with
-          Texp_ident _ -> ()
-        | Texp_constant _ -> ()
-        | Texp_let (rec_flag, list, exp) ->
-            iter_bindings rec_flag list;
-            iter_expression exp
-        | Texp_function { cases; _ } ->
-            iter_cases cases
-        | Texp_apply (exp, list) ->
-            iter_expression exp;
-            List.iter (fun (_label, expo) ->
-                match expo with
-                  None -> ()
-                | Some exp -> iter_expression exp
-            ) list
-        | Texp_match (exp, list1, list2, _) ->
-            iter_expression exp;
-            iter_cases list1;
-            iter_cases list2;
-        | Texp_try (exp, list) ->
-            iter_expression exp;
-            iter_cases list
-        | Texp_tuple list ->
-            List.iter iter_expression list
-        | Texp_construct (_, _, args) ->
-            List.iter iter_expression args
-        | Texp_variant (_label, expo) ->
-            begin match expo with
-                None -> ()
-              | Some exp -> iter_expression exp
-            end
-        | Texp_record { fields; extended_expression; _ } ->
-            Array.iter (function
-                | _, Kept _ -> ()
-                | _, Overridden (_, exp) -> iter_expression exp)
-              fields;
-            begin match extended_expression with
-                None -> ()
-              | Some exp -> iter_expression exp
-            end
-        | Texp_field (exp, _, _label) ->
-            iter_expression exp
-        | Texp_setfield (exp1, _, _label, exp2) ->
-            iter_expression exp1;
-            iter_expression exp2
-        | Texp_array list ->
-            List.iter iter_expression list
-        | Texp_ifthenelse (exp1, exp2, expo) ->
-            iter_expression exp1;
-            iter_expression exp2;
-            begin match expo with
-                None -> ()
-              | Some exp -> iter_expression exp
-            end
-        | Texp_sequence (exp1, exp2) ->
-            iter_expression exp1;
-            iter_expression exp2
-        | Texp_while (exp1, exp2) ->
-            iter_expression exp1;
-            iter_expression exp2
-        | Texp_for (_id, _, exp1, exp2, _dir, exp3) ->
-            iter_expression exp1;
-            iter_expression exp2;
-            iter_expression exp3
-        | Texp_send (exp, _meth, expo) ->
-            iter_expression exp;
-          begin
-            match expo with
-                None -> ()
-              | Some exp -> iter_expression exp
-          end
-        | Texp_new _ 
-        | Texp_instvar _ 
-        | Texp_setinstvar _ 
-        | Texp_override _ -> ()
-        | Texp_letmodule (_id, _, mexpr, exp) ->
-            iter_module_expr mexpr;
-            iter_expression exp
-        | Texp_letexception (cd, exp) ->
-            iter_extension_constructor cd;
-            iter_expression exp
-        | Texp_assert exp -> iter_expression exp
-        | Texp_lazy exp -> iter_expression exp
-        | Texp_object () ->
-            ()
-        | Texp_pack (mexpr) ->
-            iter_module_expr mexpr
-        | Texp_unreachable ->
-            ()
-        | Texp_extension_constructor _ ->
-            ()
-      end;
-      Iter.leave_expression exp;
+and core_type ctxt f x =
+  if x.ptyp_attributes <> [] then begin
+    pp f "((%a)%a)" (core_type ctxt) {x with ptyp_attributes=[]}
+      (attributes ctxt) x.ptyp_attributes
+  end
+  else match x.ptyp_desc with
+    | Ptyp_arrow (l, ct1, ct2) ->
+        pp f "@[<2>%a@;->@;%a@]" (* FIXME remove parens later *)
+          (type_with_label ctxt) (l,ct1) (core_type ctxt) ct2
+    | Ptyp_alias (ct, s) ->
+        pp f "@[<2>%a@;as@;'%s@]" (core_type1 ctxt) ct s
+    | Ptyp_poly ([], ct) ->
+        core_type ctxt f ct
+    | Ptyp_poly (sl, ct) ->
+        pp f "@[<2>%a%a@]"
+          (fun f l ->
+             pp f "%a"
+               (fun f l -> match l with
+                  | [] -> ()
+                  | _ ->
+                      pp f "%a@;.@;"
+                        (list tyvar_loc ~sep:"@;")  l)
+               l)
+          sl (core_type ctxt) ct
+    | _ -> pp f "@[<2>%a@]" (core_type1 ctxt) x
 
-    and iter_package_type pack =
-      Iter.enter_package_type pack;
-      List.iter (fun (_s, ct) -> iter_core_type ct) pack.pack_fields;
-      Iter.leave_package_type pack;
+and core_type1 ctxt f x =
+  if x.ptyp_attributes <> [] then core_type ctxt f x
+  else match x.ptyp_desc with
+    | Ptyp_any -> pp f "_";
+    | Ptyp_var s -> tyvar f  s;
+    | Ptyp_tuple l ->  pp f "(%a)" (list (core_type1 ctxt) ~sep:"@;*@;") l
+    | Ptyp_constr (li, l) ->
+        pp f (* "%a%a@;" *) "%a%a"
+          (fun f l -> match l with
+             |[] -> ()
+             |[x]-> pp f "%a@;" (core_type1 ctxt)  x
+             | _ -> list ~first:"(" ~last:")@;" (core_type ctxt) ~sep:",@;" f l)
+          l longident_loc li
+    | Ptyp_variant (l, closed, low) ->
+        let type_variant_helper f x =
+          match x with
+          | Rtag (l, attrs, _, ctl) ->
+              pp f "@[<2>%a%a@;%a@]" string_quot l.txt
+                (fun f l -> match l with
+                   |[] -> ()
+                   | _ -> pp f "@;of@;%a"
+                            (list (core_type ctxt) ~sep:"&")  ctl) ctl
+                (attributes ctxt) attrs
+          | Rinherit ct -> core_type ctxt f ct in
+        pp f "@[<2>[%a%a]@]"
+          (fun f l ->
+             match l, closed with
+             | [], Closed -> ()
+             | [], Open -> pp f ">" (* Cf #7200: print [>] correctly *)
+             | _ ->
+                 pp f "%s@;%a"
+                   (match (closed,low) with
+                    | (Closed,None) -> ""
+                    | (Closed,Some _) -> "<" (* FIXME desugar the syntax sugar*)
+                    | (Open,_) -> ">")
+                   (list type_variant_helper ~sep:"@;<1 -2>| ") l) l
+          (fun f low -> match low with
+             |Some [] |None -> ()
+             |Some xs ->
+                 pp f ">@ %a"
+                   (list string_quot) xs) low
+    | Ptyp_object (l, o) ->
+        let core_field_type f = function
+          | Otag (l, attrs, ct) ->
+            pp f "@[<hov2>%s: %a@ %a@ @]" l.txt
+              (core_type ctxt) ct (attributes ctxt) attrs (* Cf #7200 *)
+          | Oinherit ct ->
+            pp f "@[<hov2>%a@ @]" (core_type ctxt) ct
+        in
+        let field_var f = function
+          | Asttypes.Closed -> ()
+          | Asttypes.Open ->
+              match l with
+              | [] -> pp f ".."
+              | _ -> pp f " ;.."
+        in
+        pp f "@[<hov2><@ %a%a@ > @]" (list core_field_type ~sep:";") l
+          field_var o (* Cf #7200 *)
+    | Ptyp_class (li, l) ->   (*FIXME*)
+        pp f "@[<hov2>%a#%a@]"
+          (list (core_type ctxt) ~sep:"," ~first:"(" ~last:")") l
+          longident_loc li
+    | Ptyp_package (lid, cstrs) ->
+        let aux f (s, ct) =
+          pp f "type %a@ =@ %a" longident_loc s (core_type ctxt) ct  in
+        (match cstrs with
+         |[] -> pp f "@[<hov2>(module@ %a)@]" longident_loc lid
+         |_ ->
+             pp f "@[<hov2>(module@ %a@ with@ %a)@]" longident_loc lid
+               (list aux  ~sep:"@ and@ ")  cstrs)
+    | Ptyp_extension e -> extension ctxt f e
+    | _ -> paren true (core_type ctxt) f x
 
-    and iter_signature sg =
-      Iter.enter_signature sg;
-      List.iter iter_signature_item sg.sig_items;
-      Iter.leave_signature sg;
+(********************pattern********************)
+(* be cautious when use [pattern], [pattern1] is preferred *)
+and pattern ctxt f x =
+  let rec list_of_pattern acc = function (* only consider ((A|B)|C)*)
+    | {ppat_desc= Ppat_or (p1,p2); ppat_attributes = []} ->
+        list_of_pattern  (p2::acc) p1
+    | x -> x::acc
+  in
+  if x.ppat_attributes <> [] then begin
+    pp f "((%a)%a)" (pattern ctxt) {x with ppat_attributes=[]}
+      (attributes ctxt) x.ppat_attributes
+  end
+  else match x.ppat_desc with
+    | Ppat_alias (p, s) ->
+        pp f "@[<2>%a@;as@;%a@]" (pattern ctxt) p protect_ident s.txt (* RA*)
+    | Ppat_or _ -> (* *)
+        pp f "@[<hov0>%a@]" (list ~sep:"@,|" (pattern ctxt))
+          (list_of_pattern [] x)
+    | _ -> pattern1 ctxt f x
 
-    and iter_signature_item item =
-      Iter.enter_signature_item item;
-      begin
-        match item.sig_desc with
-          Tsig_value vd ->
-            iter_value_description vd
-        | Tsig_type (rf, list) ->
-            iter_type_declarations rf list
-        | Tsig_exception ext ->
-            iter_extension_constructor ext
-        | Tsig_typext tyext ->
-            iter_type_extension tyext
-        | Tsig_module md ->
-            iter_module_type md.md_type
-        | Tsig_recmodule list ->
-            List.iter (fun md -> iter_module_type md.md_type) list
-        | Tsig_modtype mtd ->
-            iter_module_type_declaration mtd
-        | Tsig_open _ -> ()
-        | Tsig_include incl -> iter_module_type incl.incl_mod
-        | Tsig_class () -> ()
-        | Tsig_class_type list ->
-            List.iter iter_class_type_declaration list
-        | Tsig_attribute _ -> ()
-      end;
-      Iter.leave_signature_item item;
+and pattern1 ctxt (f:Format.formatter) (x:pattern) : unit =
+  let rec pattern_list_helper f = function
+    | {ppat_desc =
+         Ppat_construct
+           ({ txt = Lident("::") ;_},
+            Some ({ppat_desc = Ppat_tuple([pat1; pat2]);_}));
+       ppat_attributes = []}
 
-    and iter_module_type_declaration mtd =
-      Iter.enter_module_type_declaration mtd;
-      begin
-        match mtd.mtd_type with
-        | None -> ()
-        | Some mtype -> iter_module_type mtype
-      end;
-      Iter.leave_module_type_declaration mtd
+      ->
+        pp f "%a::%a" (simple_pattern ctxt) pat1 pattern_list_helper pat2 (*RA*)
+    | p -> pattern1 ctxt f p
+  in
+  if x.ppat_attributes <> [] then pattern ctxt f x
+  else match x.ppat_desc with
+    | Ppat_variant (l, Some p) ->
+        pp f "@[<2>`%s@;%a@]" l (simple_pattern ctxt) p
+    | Ppat_construct (({txt=Lident("()"|"[]");_}), _) -> simple_pattern ctxt f x
+    | Ppat_construct (({txt;_} as li), po) ->
+        (* FIXME The third field always false *)
+        if txt = Lident "::" then
+          pp f "%a" pattern_list_helper x
+        else
+          (match po with
+           | Some x -> pp f "%a@;%a"  longident_loc li (simple_pattern ctxt) x
+           | None -> pp f "%a" longident_loc li)
+    | _ -> simple_pattern ctxt f x
 
+and simple_pattern ctxt (f:Format.formatter) (x:pattern) : unit =
+  if x.ppat_attributes <> [] then pattern ctxt f x
+  else match x.ppat_desc with
+    | Ppat_construct (({txt=Lident ("()"|"[]" as x);_}), _) -> pp f  "%s" x
+    | Ppat_any -> pp f "_";
+    | Ppat_var ({txt = txt;_}) -> protect_ident f txt
+    | Ppat_array l ->
+        pp f "@[<2>[|%a|]@]"  (list (pattern1 ctxt) ~sep:";") l
+    | Ppat_unpack (s) ->
+        pp f "(module@ %s)@ " s.txt
+    | Ppat_type li ->
+        pp f "#%a" longident_loc li
+    | Ppat_record (l, closed) ->
+        let longident_x_pattern f (li, p) =
+          match (li,p) with
+          | ({txt=Lident s;_ },
+             {ppat_desc=Ppat_var {txt;_};
+              ppat_attributes=[]; _})
+            when s = txt ->
+              pp f "@[<2>%a@]"  longident_loc li
+          | _ ->
+              pp f "@[<2>%a@;=@;%a@]" longident_loc li (pattern1 ctxt) p
+        in
+        begin match closed with
+        | Closed ->
+            pp f "@[<2>{@;%a@;}@]" (list longident_x_pattern ~sep:";@;") l
+        | _ ->
+            pp f "@[<2>{@;%a;_}@]" (list longident_x_pattern ~sep:";@;") l
+        end
+    | Ppat_tuple l ->
+        pp f "@[<1>(%a)@]" (list  ~sep:",@;" (pattern1 ctxt))  l (* level1*)
+    | Ppat_constant (c) -> pp f "%a" constant c
+    | Ppat_interval (c1, c2) -> pp f "%a..%a" constant c1 constant c2
+    | Ppat_variant (l,None) ->  pp f "`%s" l
+    | Ppat_constraint (p, ct) ->
+        pp f "@[<2>(%a@;:@;%a)@]" (pattern1 ctxt) p (core_type ctxt) ct
+    | Ppat_lazy p ->
+        pp f "@[<2>(lazy@;%a)@]" (pattern1 ctxt) p
+    | Ppat_exception p ->
+        pp f "@[<2>exception@;%a@]" (pattern1 ctxt) p
+    | Ppat_extension e -> extension ctxt f e
+    | Ppat_open (lid, p) ->
+        let with_paren =
+        match p.ppat_desc with
+        | Ppat_array _ | Ppat_record _
+        | Ppat_construct (({txt=Lident ("()"|"[]");_}), _) -> false
+        | _ -> true in
+        pp f "@[<2>%a.%a @]" longident_loc lid
+          (paren with_paren @@ pattern1 ctxt) p
+    | _ -> paren true (pattern ctxt) f x
 
+and label_exp ctxt f (l,opt,p) =
+  match l with
+  | Nolabel ->
+      (* single case pattern parens needed here *)
+      pp f "%a@ " (simple_pattern ctxt) p
+  | Optional rest ->
+      begin match p with
+      | {ppat_desc = Ppat_var {txt;_}; ppat_attributes = []}
+        when txt = rest ->
+          (match opt with
+           | Some o -> pp f "?(%s=@;%a)@;" rest  (expression ctxt) o
+           | None -> pp f "?%s@ " rest)
+      | _ ->
+          (match opt with
+           | Some o ->
+               pp f "?%s:(%a=@;%a)@;"
+                 rest (pattern1 ctxt) p (expression ctxt) o
+           | None -> pp f "?%s:%a@;" rest (simple_pattern ctxt) p)
+      end
+  | Labelled l -> match p with
+    | {ppat_desc  = Ppat_var {txt;_}; ppat_attributes = []}
+      when txt = l ->
+        pp f "~%s@;" l
+    | _ ->  pp f "~%s:%a@;" l (simple_pattern ctxt) p
 
-    and iter_class_type_declaration cd =
-      Iter.enter_class_type_declaration cd;
-      List.iter iter_type_parameter cd.ci_params;
-      iter_class_type cd.ci_expr;
-      Iter.leave_class_type_declaration cd;
+and sugar_expr ctxt f e =
+  if e.pexp_attributes <> [] then false
+  else match e.pexp_desc with
+  | Pexp_apply ({ pexp_desc = Pexp_ident {txt = id; _};
+                  pexp_attributes=[]; _}, args)
+    when List.for_all (fun (lab, _) -> lab = Nolabel) args -> begin
+      let print_indexop a path_prefix assign left right print_index indices
+          rem_args =
+        let print_path ppf = function
+          | None -> ()
+          | Some m -> pp ppf ".%a" longident m in
+        match assign, rem_args with
+            | false, [] ->
+              pp f "@[%a%a%s%a%s@]"
+                (simple_expr ctxt) a print_path path_prefix
+                left (list ~sep:"," print_index) indices right; true
+            | true, [v] ->
+              pp f "@[%a%a%s%a%s@ <-@;<1 2>%a@]"
+                (simple_expr ctxt) a print_path path_prefix
+                left (list ~sep:"," print_index) indices right
+                (simple_expr ctxt) v; true
+            | _ -> false in
+      match id, List.map snd args with
+      | Lident "!", [e] ->
+        pp f "@[<hov>!%a@]" (simple_expr ctxt) e; true
+      | Ldot (path, ("get"|"set" as func)), a :: other_args -> begin
+          let assign = func = "set" in
+          let print = print_indexop a None assign in
+          match path, other_args with
+          | Lident "Array", i :: rest ->
+            print ".(" ")" (expression ctxt) [i] rest
+          | Lident "String", i :: rest ->
+            print ".[" "]" (expression ctxt) [i] rest
+          | Ldot (Lident "Bigarray", "Array1"), i1 :: rest ->
+            print ".{" "}" (simple_expr ctxt) [i1] rest
+          | Ldot (Lident "Bigarray", "Array2"), i1 :: i2 :: rest ->
+            print ".{" "}" (simple_expr ctxt) [i1; i2] rest
+          | Ldot (Lident "Bigarray", "Array3"), i1 :: i2 :: i3 :: rest ->
+            print ".{" "}" (simple_expr ctxt) [i1; i2; i3] rest
+          | Ldot (Lident "Bigarray", "Genarray"),
+            {pexp_desc = Pexp_array indexes; pexp_attributes = []} :: rest ->
+              print ".{" "}" (simple_expr ctxt) indexes rest
+          | _ -> false
+        end
+      | (Lident s | Ldot(_,s)) , a :: i :: rest
+        when s.[0] = '.' ->
+          let n = String.length s in
+          (* extract operator:
+             assignment operators end with [right_bracket ^ "<-"],
+             access operators end with [right_bracket] directly
+          *)
+          let assign = s.[n - 1] = '-'  in
+          let kind =
+            (* extract the right end bracket *)
+            if assign then s.[n - 3] else s.[n - 1] in
+          let left, right = match kind with
+            | ')' -> '(', ")"
+            | ']' -> '[', "]"
+            | '}' -> '{', "}"
+            | _ -> assert false in
+          let path_prefix = match id with
+            | Ldot(m,_) -> Some m
+            | _ -> None in
+          let left = String.sub s 0 (1+String.index s left) in
+          print_indexop a path_prefix assign left right
+            (expression ctxt) [i] rest
+      | _ -> false
+    end
+  | _ -> false
 
-    and iter_module_type mty =
-      Iter.enter_module_type mty;
-      begin
-        match mty.mty_desc with
-          Tmty_ident _ -> ()
-        | Tmty_alias _ -> ()
-        | Tmty_signature sg -> iter_signature sg
-        | Tmty_functor (_, _, mtype1, mtype2) ->
-            Misc.may iter_module_type mtype1; iter_module_type mtype2
-        | Tmty_with (mtype, list) ->
-            iter_module_type mtype;
-            List.iter (fun (_path, _, withc) ->
-                iter_with_constraint withc
-            ) list
-        | Tmty_typeof mexpr ->
-            iter_module_expr mexpr
-      end;
-      Iter.leave_module_type mty;
+and expression ctxt f x =
+  if x.pexp_attributes <> [] then
+    pp f "((%a)@,%a)" (expression ctxt) {x with pexp_attributes=[]}
+      (attributes ctxt) x.pexp_attributes
+  else match x.pexp_desc with
+    | Pexp_function _ | Pexp_fun _ | Pexp_match _ | Pexp_try _ | Pexp_sequence _
+      when ctxt.pipe || ctxt.semi ->
+        paren true (expression reset_ctxt) f x
+    | Pexp_ifthenelse _ | Pexp_sequence _ when ctxt.ifthenelse ->
+        paren true (expression reset_ctxt) f x
+    | Pexp_let _ | Pexp_letmodule _ | Pexp_open _ | Pexp_letexception _
+        when ctxt.semi ->
+        paren true (expression reset_ctxt) f x
+    | Pexp_fun (l, e0, p, e) ->
+        pp f "@[<2>fun@;%a->@;%a@]"
+          (label_exp ctxt) (l, e0, p)
+          (expression ctxt) e
+    | Pexp_function l ->
+        pp f "@[<hv>function%a@]" (case_list ctxt) l
+    | Pexp_match (e, l) ->
+        pp f "@[<hv0>@[<hv0>@[<2>match %a@]@ with@]%a@]"
+          (expression reset_ctxt) e (case_list ctxt) l
 
-    and iter_with_constraint cstr =
-      Iter.enter_with_constraint cstr;
-      begin
-        match cstr with
-          Twith_type decl -> iter_type_declaration decl
-        | Twith_module _ -> ()
-        | Twith_typesubst decl -> iter_type_declaration decl
-        | Twith_modsubst _ -> ()
-      end;
-      Iter.leave_with_constraint cstr;
+    | Pexp_try (e, l) ->
+        pp f "@[<0>@[<hv2>try@ %a@]@ @[<0>with%a@]@]"
+             (* "try@;@[<2>%a@]@\nwith@\n%a"*)
+          (expression reset_ctxt) e  (case_list ctxt) l
+    | Pexp_let (rf, l, e) ->
+        (* pp f "@[<2>let %a%a in@;<1 -2>%a@]"
+           (*no indentation here, a new line*) *)
+        (*   rec_flag rf *)
+        pp f "@[<2>%a in@;<1 -2>%a@]"
+          (bindings reset_ctxt) (rf,l)
+          (expression ctxt) e
+    | Pexp_apply (e, l) ->
+        begin if not (sugar_expr ctxt f x) then
+            match view_fixity_of_exp e with
+            | `Infix s ->
+                begin match l with
+                | [ (Nolabel, _) as arg1; (Nolabel, _) as arg2 ] ->
+                    (* FIXME associativity label_x_expression_param *)
+                    pp f "@[<2>%a@;%s@;%a@]"
+                      (label_x_expression_param reset_ctxt) arg1 s
+                      (label_x_expression_param ctxt) arg2
+                | _ ->
+                    pp f "@[<2>%a %a@]"
+                      (simple_expr ctxt) e
+                      (list (label_x_expression_param ctxt)) l
+                end
+            | `Prefix s ->
+                let s =
+                  if List.mem s ["~+";"~-";"~+.";"~-."] &&
+                   (match l with
+                    (* See #7200: avoid turning (~- 1) into (- 1) which is
+                       parsed as an int literal *)
+                    |[(_,{pexp_desc=Pexp_constant _})] -> false
+                    | _ -> true)
+                  then String.sub s 1 (String.length s -1)
+                  else s in
+                begin match l with
+                | [(Nolabel, x)] ->
+                  pp f "@[<2>%s@;%a@]" s (simple_expr ctxt) x
+                | _   ->
+                  pp f "@[<2>%a %a@]" (simple_expr ctxt) e
+                    (list (label_x_expression_param ctxt)) l
+                end
+            | _ ->
+                pp f "@[<hov2>%a@]" begin fun f (e,l) ->
+                  pp f "%a@ %a" (expression2 ctxt) e
+                    (list (label_x_expression_param reset_ctxt))  l
+                    (* reset here only because [function,match,try,sequence]
+                       are lower priority *)
+                end (e,l)
+        end
 
-    and iter_module_expr mexpr =
-      Iter.enter_module_expr mexpr;
-      begin
-        match mexpr.mod_desc with
-          Tmod_ident _ -> ()
-        | Tmod_structure st -> iter_structure st
-        | Tmod_functor (_, _, mtype, mexpr) ->
-            Misc.may iter_module_type mtype;
-            iter_module_expr mexpr
-        | Tmod_apply (mexp1, mexp2, _) ->
-            iter_module_expr mexp1;
-            iter_module_expr mexp2
-        | Tmod_constraint (mexpr, _, Tmodtype_implicit, _ ) ->
-            iter_module_expr mexpr
-        | Tmod_constraint (mexpr, _, Tmodtype_explicit mtype, _) ->
-            iter_module_expr mexpr;
-            iter_module_type mtype
-        | Tmod_unpack (exp, _mty) ->
-            iter_expression exp
-(*          iter_module_type mty *)
-      end;
-      Iter.leave_module_expr mexpr;
+    | Pexp_construct (li, Some eo)
+      when not (is_simple_construct (view_expr x))-> (* Not efficient FIXME*)
+        (match view_expr x with
+         | `cons ls -> list (simple_expr ctxt) f ls ~sep:"@;::@;"
+         | `normal ->
+             pp f "@[<2>%a@;%a@]" longident_loc li
+               (simple_expr ctxt) eo
+         | _ -> assert false)
+    | Pexp_setfield (e1, li, e2) ->
+        pp f "@[<2>%a.%a@ <-@ %a@]"
+          (simple_expr ctxt) e1 longident_loc li (simple_expr ctxt) e2
+    | Pexp_ifthenelse (e1, e2, eo) ->
+        (* @;@[<2>else@ %a@]@] *)
+        let fmt:(_,_,_)format ="@[<hv0>@[<2>if@ %a@]@;@[<2>then@ %a@]%a@]" in
+        let expression_under_ifthenelse = expression (under_ifthenelse ctxt) in
+        pp f fmt expression_under_ifthenelse e1 expression_under_ifthenelse e2
+          (fun f eo -> match eo with
+             | Some x ->
+                 pp f "@;@[<2>else@;%a@]" (expression (under_semi ctxt)) x
+             | None -> () (* pp f "()" *)) eo
+    | Pexp_sequence _ ->
+        let rec sequence_helper acc = function
+          | {pexp_desc=Pexp_sequence(e1,e2); pexp_attributes = []} ->
+              sequence_helper (e1::acc) e2
+          | v -> List.rev (v::acc) in
+        let lst = sequence_helper [] x in
+        pp f "@[<hv>%a@]"
+          (list (expression (under_semi ctxt)) ~sep:";@;") lst
+    | Pexp_new (li) ->
+        pp f "@[<hov2>new@ %a@]" longident_loc li;
+    | Pexp_setinstvar (s, e) ->
+        pp f "@[<hov2>%s@ <-@ %a@]" s.txt (expression ctxt) e
+    | Pexp_override l -> (* FIXME *)
+        let string_x_expression f (s, e) =
+          pp f "@[<hov2>%s@ =@ %a@]" s.txt (expression ctxt) e in
+        pp f "@[<hov2>{<%a>}@]"
+          (list string_x_expression  ~sep:";"  )  l;
+    | Pexp_letmodule (s, me, e) ->
+        pp f "@[<hov2>let@ module@ %s@ =@ %a@ in@ %a@]" s.txt
+          (module_expr reset_ctxt) me (expression ctxt) e
+    | Pexp_letexception (cd, e) ->
+        pp f "@[<hov2>let@ exception@ %a@ in@ %a@]"
+          (extension_constructor ctxt) cd
+          (expression ctxt) e
+    | Pexp_assert e ->
+        pp f "@[<hov2>assert@ %a@]" (simple_expr ctxt) e
+    | Pexp_lazy (e) ->
+        pp f "@[<hov2>lazy@ %a@]" (simple_expr ctxt) e
+    (* Pexp_poly: impossible but we should print it anyway, rather than
+       assert false *)
+    | Pexp_poly (e, None) ->
+        pp f "@[<hov2>!poly!@ %a@]" (simple_expr ctxt) e
+    | Pexp_poly (e, Some ct) ->
+        pp f "@[<hov2>(!poly!@ %a@ : %a)@]"
+          (simple_expr ctxt) e (core_type ctxt) ct
+    | Pexp_open (ovf, lid, e) ->
+        pp f "@[<2>let open%s %a in@;%a@]" (override ovf) longident_loc lid
+          (expression ctxt) e
+    | Pexp_variant (l,Some eo) ->
+        pp f "@[<2>`%s@;%a@]" l (simple_expr ctxt) eo
+    | Pexp_extension e -> extension ctxt f e
+    | Pexp_unreachable -> pp f "."
+    | _ -> expression1 ctxt f x
 
+and expression1 ctxt f x =
+  if x.pexp_attributes <> [] then expression ctxt f x
+  else match x.pexp_desc with
+    | Pexp_object cs -> pp f "%a" (class_structure ctxt) cs
+    | _ -> expression2 ctxt f x
+(* used in [Pexp_apply] *)
 
-    and iter_class_type ct =
-      Iter.enter_class_type ct;
-      begin
-        match ct.cltyp_desc with
-          Tcty_signature csg -> iter_class_signature csg
-        | Tcty_constr (_path, _, list) ->
-            List.iter iter_core_type list
-        | Tcty_arrow (_label, ct, cl) ->
-            iter_core_type ct;
-            iter_class_type cl
-        | Tcty_open (_, _, _, _, e) ->
-            iter_class_type e
-      end;
-      Iter.leave_class_type ct;
+and expression2 ctxt f x =
+  if x.pexp_attributes <> [] then expression ctxt f x
+  else match x.pexp_desc with
+    | Pexp_field (e, li) ->
+        pp f "@[<hov2>%a.%a@]" (simple_expr ctxt) e longident_loc li
+    | Pexp_send (e, s) -> pp f "@[<hov2>%a#%s@]" (simple_expr ctxt) e s.txt
 
-    and iter_class_signature cs =
-      Iter.enter_class_signature cs;
-      iter_core_type cs.csig_self;
-      List.iter iter_class_type_field cs.csig_fields;
-      Iter.leave_class_signature cs
+    | _ -> simple_expr ctxt f x
 
+and simple_expr ctxt f x =
+  if x.pexp_attributes <> [] then expression ctxt f x
+  else match x.pexp_desc with
+    | Pexp_construct _  when is_simple_construct (view_expr x) ->
+        (match view_expr x with
+         | `nil -> pp f "[]"
+         | `tuple -> pp f "()"
+         | `list xs ->
+             pp f "@[<hv0>[%a]@]"
+               (list (expression (under_semi ctxt)) ~sep:";@;") xs
+         | `simple x -> longident f x
+         | _ -> assert false)
+    | Pexp_ident li ->
+        longident_loc f li
+    (* (match view_fixity_of_exp x with *)
+    (* |`Normal -> longident_loc f li *)
+    (* | `Prefix _ | `Infix _ -> pp f "( %a )" longident_loc li) *)
+    | Pexp_constant c -> constant f c;
+    | Pexp_pack me ->
+        pp f "(module@;%a)" (module_expr ctxt) me
+    | Pexp_newtype (lid, e) ->
+        pp f "fun@;(type@;%s)@;->@;%a" lid.txt (expression ctxt) e
+    | Pexp_tuple l ->
+        pp f "@[<hov2>(%a)@]" (list (simple_expr ctxt) ~sep:",@;") l
+    | Pexp_constraint (e, ct) ->
+        pp f "(%a : %a)" (expression ctxt) e (core_type ctxt) ct
+    | Pexp_coerce (e, cto1, ct) ->
+        pp f "(%a%a :> %a)" (expression ctxt) e
+          (option (core_type ctxt) ~first:" : " ~last:" ") cto1 (* no sep hint*)
+          (core_type ctxt) ct
+    | Pexp_variant (l, None) -> pp f "`%s" l
+    | Pexp_record (l, eo) ->
+        let longident_x_expression f ( li, e) =
+          match e with
+          |  {pexp_desc=Pexp_ident {txt;_};
+              pexp_attributes=[]; _} when li.txt = txt ->
+              pp f "@[<hov2>%a@]" longident_loc li
+          | _ ->
+              pp f "@[<hov2>%a@;=@;%a@]" longident_loc li (simple_expr ctxt) e
+        in
+        pp f "@[<hv0>@[<hv2>{@;%a%a@]@;}@]"(* "@[<hov2>{%a%a}@]" *)
+          (option ~last:" with@;" (simple_expr ctxt)) eo
+          (list longident_x_expression ~sep:";@;") l
+    | Pexp_array (l) ->
+        pp f "@[<0>@[<2>[|%a|]@]@]"
+          (list (simple_expr (under_semi ctxt)) ~sep:";") l
+    | Pexp_while (e1, e2) ->
+        let fmt : (_,_,_) format = "@[<2>while@;%a@;do@;%a@;done@]" in
+        pp f fmt (expression ctxt) e1 (expression ctxt) e2
+    | Pexp_for (s, e1, e2, df, e3) ->
+        let fmt:(_,_,_)format =
+          "@[<hv0>@[<hv2>@[<2>for %a =@;%a@;%a%a@;do@]@;%a@]@;done@]" in
+        let expression = expression ctxt in
+        pp f fmt (pattern ctxt) s expression e1 direction_flag
+          df expression e2 expression e3
+    | _ ->  paren true (expression ctxt) f x
 
-    and iter_class_type_field ctf =
-      Iter.enter_class_type_field ctf;
-      begin
-        match ctf.ctf_desc with
-          Tctf_inherit ct -> iter_class_type ct
-        | Tctf_val (_s, _mut, _virt, ct) ->
-            iter_core_type ct
-        | Tctf_method (_s, _priv, _virt, ct) ->
-            iter_core_type ct
-        | Tctf_constraint  (ct1, ct2) ->
-            iter_core_type ct1;
-            iter_core_type ct2
-        | Tctf_attribute _ -> ()
-      end;
-      Iter.leave_class_type_field ctf
+and attributes ctxt f l =
+  List.iter (attribute ctxt f) l
 
-    and iter_core_type ct =
-      Iter.enter_core_type ct;
-      begin
-        match ct.ctyp_desc with
-          Ttyp_any -> ()
-        | Ttyp_var _ -> ()
-        | Ttyp_arrow (_label, ct1, ct2) ->
-            iter_core_type ct1;
-            iter_core_type ct2
-        | Ttyp_tuple list -> List.iter iter_core_type list
-        | Ttyp_constr (_path, _, list) ->
-            List.iter iter_core_type list
-        | Ttyp_object (list, _o) ->
-            List.iter iter_object_field list
-        | Ttyp_class (_path, _, list) ->
-            List.iter iter_core_type list
-        | Ttyp_alias (ct, _s) ->
-            iter_core_type ct
-        | Ttyp_variant (list, _bool, _labels) ->
-            List.iter iter_row_field list
-        | Ttyp_poly (_list, ct) -> iter_core_type ct
-        | Ttyp_package pack -> iter_package_type pack
-      end;
-      Iter.leave_core_type ct
+and item_attributes ctxt f l =
+  List.iter (item_attribute ctxt f) l
 
-    and iter_row_field rf =
-      match rf with
-        Ttag (_label, _attrs, _bool, list) ->
-          List.iter iter_core_type list
-      | Tinherit ct -> iter_core_type ct
+and attribute ctxt f (s, e) =
+  pp f "@[<2>[@@%s@ %a]@]" s.txt (payload ctxt) e
 
-    and iter_object_field ofield =
-      match ofield with
-        OTtag (_, _, ct) | OTinherit ct -> iter_core_type ct
+and item_attribute ctxt f (s, e) =
+  pp f "@[<2>[@@@@%s@ %a]@]" s.txt (payload ctxt) e
 
-  end
+and floating_attribute ctxt f (s, e) =
+  pp f "@[<2>[@@@@@@%s@ %a]@]" s.txt (payload ctxt) e
 
-module DefaultIteratorArgument = struct
+and value_description ctxt f x =
+  (* note: value_description has an attribute field,
+           but they're already printed by the callers this method *)
+  pp f "@[<hov2>%a%a@]" (core_type ctxt) x.pval_type
+    (fun f x ->
+        
+       if x.pval_prim <> []
+       then pp f "@ =@ %a" (list constant_string) x.pval_prim
 
-      let enter_structure _ = ()
-      let enter_value_description _ = ()
-      let enter_type_extension _ = ()
-      let enter_extension_constructor _ = ()
-      let enter_pattern _ = ()
-      let enter_expression _ = ()
-      let enter_package_type _ = ()
-      let enter_signature _ = ()
-      let enter_signature_item _ = ()
-      let enter_module_type_declaration _ = ()
-      let enter_module_type _ = ()
-      let enter_module_expr _ = ()
-      let enter_with_constraint _ = ()
-      let enter_class_signature _ = ()
+    ) x
 
-      let enter_class_description _ = ()
-      let enter_class_type_declaration _ = ()
-      let enter_class_type _ = ()
-      let enter_class_type_field _ = ()
-      let enter_core_type _ = ()
-    let enter_structure_item _ = ()
+and extension ctxt f (s, e) =
+  pp f "@[<2>[%%%s@ %a]@]" s.txt (payload ctxt) e
 
+and item_extension ctxt f (s, e) =
+  pp f "@[<2>[%%%%%s@ %a]@]" s.txt (payload ctxt) e
 
-      let leave_structure _ = ()
-      let leave_value_description _ = ()
-      let leave_type_extension _ = ()
-      let leave_extension_constructor _ = ()
-      let leave_pattern _ = ()
-      let leave_expression _ = ()
-      let leave_package_type _ = ()
-      let leave_signature _ = ()
-      let leave_signature_item _ = ()
-      let leave_module_type_declaration _ = ()
-      let leave_module_type _ = ()
-      let leave_module_expr _ = ()
-      let leave_with_constraint _ = ()
-      let leave_class_signature _ = ()
+and exception_declaration ctxt f ext =
+  pp f "@[<hov2>exception@ %a@]" (extension_constructor ctxt) ext
 
-      let leave_class_description _ = ()
-      let leave_class_type_declaration _ = ()
-      let leave_class_type _ = ()
-      let leave_class_type_field _ = ()
-      let leave_core_type _ = ()
-    let leave_structure_item _ = ()
+and class_signature ctxt f { pcsig_self = ct; pcsig_fields = l ;_} =
+  let class_type_field f x =
+    match x.pctf_desc with
+    | Pctf_inherit (ct) ->
+        pp f "@[<2>inherit@ %a@]%a" (class_type ctxt) ct
+          (item_attributes ctxt) x.pctf_attributes
+    | Pctf_val (s, mf, vf, ct) ->
+        pp f "@[<2>val @ %a%a%s@ :@ %a@]%a"
+          mutable_flag mf virtual_flag vf s.txt (core_type ctxt) ct
+          (item_attributes ctxt) x.pctf_attributes
+    | Pctf_method (s, pf, vf, ct) ->
+        pp f "@[<2>method %a %a%s :@;%a@]%a"
+          private_flag pf virtual_flag vf s.txt (core_type ctxt) ct
+          (item_attributes ctxt) x.pctf_attributes
+    | Pctf_constraint (ct1, ct2) ->
+        pp f "@[<2>constraint@ %a@ =@ %a@]%a"
+          (core_type ctxt) ct1 (core_type ctxt) ct2
+          (item_attributes ctxt) x.pctf_attributes
+    | Pctf_attribute a -> floating_attribute ctxt f a
+    | Pctf_extension e ->
+        item_extension ctxt f e;
+        item_attributes ctxt f x.pctf_attributes
+  in
+  pp f "@[<hv0>@[<hv2>object@[<1>%a@]@ %a@]@ end@]"
+    (fun f -> function
+         {ptyp_desc=Ptyp_any; ptyp_attributes=[]; _} -> ()
+       | ct -> pp f " (%a)" (core_type ctxt) ct) ct
+    (list class_type_field ~sep:"@;") l
 
-    let enter_binding _ = ()
-    let leave_binding _ = ()
+(* call [class_signature] called by [class_signature] *)
+and class_type ctxt f x =
+  match x.pcty_desc with
+  | Pcty_signature cs ->
+      class_signature ctxt f cs;
+      attributes ctxt f x.pcty_attributes
+  | Pcty_constr (li, l) ->
+      pp f "%a%a%a"
+        (fun f l -> match l with
+           | [] -> ()
+           | _  -> pp f "[%a]@ " (list (core_type ctxt) ~sep:"," ) l) l
+        longident_loc li
+        (attributes ctxt) x.pcty_attributes
+  | Pcty_arrow (l, co, cl) ->
+      pp f "@[<2>%a@;->@;%a@]" (* FIXME remove parens later *)
+        (type_with_label ctxt) (l,co)
+        (class_type ctxt) cl
+  | Pcty_extension e ->
+      extension ctxt f e;
+      attributes ctxt f x.pcty_attributes
+  | Pcty_open (ovf, lid, e) ->
+      pp f "@[<2>let open%s %a in@;%a@]" (override ovf) longident_loc lid
+        (class_type ctxt) e
 
-    let enter_bindings _ = ()
-    let leave_bindings _ = ()
+(* [class type a = object end] *)
+and class_type_declaration_list ctxt f l =
+  let class_type_declaration kwd f x =
+    let { pci_params=ls; pci_name={ txt; _ }; _ } = x in
+    pp f "@[<2>%s %a%a%s@ =@ %a@]%a" kwd
+      virtual_flag x.pci_virt
+      (class_params_def ctxt) ls txt
+      (class_type ctxt) x.pci_expr
+      (item_attributes ctxt) x.pci_attributes
+  in
+  match l with
+  | [] -> ()
+  | [x] -> class_type_declaration "class type" f x
+  | x :: xs ->
+      pp f "@[<v>%a@,%a@]"
+        (class_type_declaration "class type") x
+        (list ~sep:"@," (class_type_declaration "and")) xs
 
-    let enter_type_declaration _ = ()
-    let leave_type_declaration _ = ()
+and class_field ctxt f x =
+  match x.pcf_desc with
+  | Pcf_inherit () -> ()  
+  | Pcf_val (s, mf, Cfk_concrete (ovf, e)) ->
+      pp f "@[<2>val%s %a%s =@;%a@]%a" (override ovf)
+        mutable_flag mf s.txt
+        (expression ctxt) e
+        (item_attributes ctxt) x.pcf_attributes
+  | Pcf_method (s, pf, Cfk_virtual ct) ->
+      pp f "@[<2>method virtual %a %s :@;%a@]%a"
+        private_flag pf s.txt
+        (core_type ctxt) ct
+        (item_attributes ctxt) x.pcf_attributes
+  | Pcf_val (s, mf, Cfk_virtual ct) ->
+      pp f "@[<2>val virtual %a%s :@ %a@]%a"
+        mutable_flag mf s.txt
+        (core_type ctxt) ct
+        (item_attributes ctxt) x.pcf_attributes
+  | Pcf_method (s, pf, Cfk_concrete (ovf, e)) ->
+      let bind e =
+        binding ctxt f
+          {pvb_pat=
+             {ppat_desc=Ppat_var s;ppat_loc=Location.none;ppat_attributes=[]};
+           pvb_expr=e;
+           pvb_attributes=[];
+           pvb_loc=Location.none;
+          }
+      in
+      pp f "@[<2>method%s %a%a@]%a"
+        (override ovf)
+        private_flag pf
+        (fun f -> function
+           | {pexp_desc=Pexp_poly (e, Some ct); pexp_attributes=[]; _} ->
+               pp f "%s :@;%a=@;%a"
+                 s.txt (core_type ctxt) ct (expression ctxt) e
+           | {pexp_desc=Pexp_poly (e, None); pexp_attributes=[]; _} ->
+               bind e
+           | _ -> bind e) e
+        (item_attributes ctxt) x.pcf_attributes
+  | Pcf_constraint (ct1, ct2) ->
+      pp f "@[<2>constraint %a =@;%a@]%a"
+        (core_type ctxt) ct1
+        (core_type ctxt) ct2
+        (item_attributes ctxt) x.pcf_attributes
+  | Pcf_initializer (e) ->
+      pp f "@[<2>initializer@ %a@]%a"
+        (expression ctxt) e
+        (item_attributes ctxt) x.pcf_attributes
+  | Pcf_attribute a -> floating_attribute ctxt f a
+  | Pcf_extension e ->
+      item_extension ctxt f e;
+      item_attributes ctxt f x.pcf_attributes
 
-    let enter_type_declarations _ = ()
-    let leave_type_declarations _ = ()
-end
+and class_structure ctxt f { pcstr_self = p; pcstr_fields =  l } =
+  pp f "@[<hv0>@[<hv2>object%a@;%a@]@;end@]"
+    (fun f p -> match p.ppat_desc with
+       | Ppat_any -> ()
+       | Ppat_constraint _ -> pp f " %a" (pattern ctxt) p
+       | _ -> pp f " (%a)" (pattern ctxt) p) p
+    (list (class_field ctxt)) l
 
-end
-module Untypeast : sig 
-#1 "untypeast.mli"
-(**************************************************************************)
-(*                                                                        *)
-(*                                 OCaml                                  *)
-(*                                                                        *)
-(*      Thomas Gazagnaire (OCamlPro), Fabrice Le Fessant (INRIA Saclay)   *)
-(*                                                                        *)
-(*   Copyright 2007 Institut National de Recherche en Informatique et     *)
-(*     en Automatique.                                                    *)
-(*                                                                        *)
-(*   All rights reserved.  This file is distributed under the terms of    *)
-(*   the GNU Lesser General Public License version 2.1, with the          *)
-(*   special exception on linking described in the file LICENSE.          *)
-(*                                                                        *)
-(**************************************************************************)
+and module_type ctxt f x =
+  if x.pmty_attributes <> [] then begin
+    pp f "((%a)%a)" (module_type ctxt) {x with pmty_attributes=[]}
+      (attributes ctxt) x.pmty_attributes
+  end else
+    match x.pmty_desc with
+    | Pmty_ident li ->
+        pp f "%a" longident_loc li;
+    | Pmty_alias li ->
+        pp f "(module %a)" longident_loc li;
+    | Pmty_signature (s) ->
+        pp f "@[<hv0>@[<hv2>sig@ %a@]@ end@]" (* "@[<hov>sig@ %a@ end@]" *)
+          (list (signature_item ctxt)) s (* FIXME wrong indentation*)
+    | Pmty_functor (_, None, mt2) ->
+        pp f "@[<hov2>functor () ->@ %a@]" (module_type ctxt) mt2
+    | Pmty_functor (s, Some mt1, mt2) ->
+        if s.txt = "_" then
+          pp f "@[<hov2>%a@ ->@ %a@]"
+            (module_type ctxt) mt1 (module_type ctxt) mt2
+        else
+          pp f "@[<hov2>functor@ (%s@ :@ %a)@ ->@ %a@]" s.txt
+            (module_type ctxt) mt1 (module_type ctxt) mt2
+    | Pmty_with (mt, l) ->
+        let with_constraint f = function
+          | Pwith_type (li, ({ptype_params= ls ;_} as td)) ->
+              let ls = List.map fst ls in
+              pp f "type@ %a %a =@ %a"
+                (list (core_type ctxt) ~sep:"," ~first:"(" ~last:")")
+                ls longident_loc li (type_declaration ctxt) td
+          | Pwith_module (li, li2) ->
+              pp f "module %a =@ %a" longident_loc li longident_loc li2;
+          | Pwith_typesubst (li, ({ptype_params=ls;_} as td)) ->
+              let ls = List.map fst ls in
+              pp f "type@ %a %a :=@ %a"
+                (list (core_type ctxt) ~sep:"," ~first:"(" ~last:")")
+                ls longident_loc li
+                (type_declaration ctxt) td
+          | Pwith_modsubst (li, li2) ->
+             pp f "module %a :=@ %a" longident_loc li longident_loc li2 in
+        (match l with
+         | [] -> pp f "@[<hov2>%a@]" (module_type ctxt) mt
+         | _ -> pp f "@[<hov2>(%a@ with@ %a)@]"
+                  (module_type ctxt) mt (list with_constraint ~sep:"@ and@ ") l)
+    | Pmty_typeof me ->
+        pp f "@[<hov2>module@ type@ of@ %a@]" (module_expr ctxt) me
+    | Pmty_extension e -> extension ctxt f e
 
-open Parsetree
+and signature ctxt f x =  list ~sep:"@\n" (signature_item ctxt) f x
 
-val lident_of_path : Path.t -> Longident.t
+and signature_item ctxt f x : unit =
+  match x.psig_desc with
+  | Psig_type (rf, l) ->
+      type_def_list ctxt f (rf, l)
+  | Psig_value vd ->
+      let intro = if vd.pval_prim = [] then "val" else "external" in
+      pp f "@[<2>%s@ %a@ :@ %a@]%a" intro
+        protect_ident vd.pval_name.txt
+        (value_description ctxt) vd
+        (item_attributes ctxt) vd.pval_attributes
+  | Psig_typext te ->
+      type_extension ctxt f te
+  | Psig_exception ed ->
+      exception_declaration ctxt f ed
+  | Psig_class () ->
+    ()
+  | Psig_module ({pmd_type={pmty_desc=Pmty_alias alias;
+                            pmty_attributes=[]; _};_} as pmd) ->
+      pp f "@[<hov>module@ %s@ =@ %a@]%a" pmd.pmd_name.txt
+        longident_loc alias
+        (item_attributes ctxt) pmd.pmd_attributes
+  | Psig_module pmd ->
+      pp f "@[<hov>module@ %s@ :@ %a@]%a"
+        pmd.pmd_name.txt
+        (module_type ctxt) pmd.pmd_type
+        (item_attributes ctxt) pmd.pmd_attributes
+  | Psig_open od ->
+      pp f "@[<hov2>open%s@ %a@]%a"
+        (override od.popen_override)
+        longident_loc od.popen_lid
+        (item_attributes ctxt) od.popen_attributes
+  | Psig_include incl ->
+      pp f "@[<hov2>include@ %a@]%a"
+        (module_type ctxt) incl.pincl_mod
+        (item_attributes ctxt) incl.pincl_attributes
+  | Psig_modtype {pmtd_name=s; pmtd_type=md; pmtd_attributes=attrs} ->
+      pp f "@[<hov2>module@ type@ %s%a@]%a"
+        s.txt
+        (fun f md -> match md with
+           | None -> ()
+           | Some mt ->
+               pp_print_space f () ;
+               pp f "@ =@ %a" (module_type ctxt) mt
+        ) md
+        (item_attributes ctxt) attrs
+  | Psig_class_type (l) -> class_type_declaration_list ctxt f l
+  | Psig_recmodule decls ->
+      let rec  string_x_module_type_list f ?(first=true) l =
+        match l with
+        | [] -> () ;
+        | pmd :: tl ->
+            if not first then
+              pp f "@ @[<hov2>and@ %s:@ %a@]%a" pmd.pmd_name.txt
+                (module_type ctxt) pmd.pmd_type
+                (item_attributes ctxt) pmd.pmd_attributes
+            else
+              pp f "@[<hov2>module@ rec@ %s:@ %a@]%a" pmd.pmd_name.txt
+                (module_type ctxt) pmd.pmd_type
+                (item_attributes ctxt) pmd.pmd_attributes;
+            string_x_module_type_list f ~first:false tl
+      in
+      string_x_module_type_list f decls
+  | Psig_attribute a -> floating_attribute ctxt f a
+  | Psig_extension(e, a) ->
+      item_extension ctxt f e;
+      item_attributes ctxt f a
 
-type mapper = {
-  attribute: mapper -> Typedtree.attribute -> attribute;
-  attributes: mapper -> Typedtree.attribute list -> attribute list;
-  case: mapper -> Typedtree.case -> case;
-  cases: mapper -> Typedtree.case list -> case list;
-  class_signature: mapper -> Typedtree.class_signature -> class_signature;
-  class_type: mapper -> Typedtree.class_type -> class_type;
-  class_type_declaration: mapper -> Typedtree.class_type_declaration
-                          -> class_type_declaration;
-  class_type_field: mapper -> Typedtree.class_type_field -> class_type_field;
-  constructor_declaration: mapper -> Typedtree.constructor_declaration
-                           -> constructor_declaration;
-  expr: mapper -> Typedtree.expression -> expression;
-  extension_constructor: mapper -> Typedtree.extension_constructor
-                         -> extension_constructor;
-  include_declaration:
-    mapper -> Typedtree.include_declaration -> include_declaration;
-  include_description:
-    mapper -> Typedtree.include_description -> include_description;
-  label_declaration:
-    mapper -> Typedtree.label_declaration -> label_declaration;
-  location: mapper -> Location.t -> Location.t;
-  module_binding: mapper -> Typedtree.module_binding -> module_binding;
-  module_declaration:
-    mapper -> Typedtree.module_declaration -> module_declaration;
-  module_expr: mapper -> Typedtree.module_expr -> module_expr;
-  module_type: mapper -> Typedtree.module_type -> module_type;
-  module_type_declaration:
-    mapper -> Typedtree.module_type_declaration -> module_type_declaration;
-  package_type: mapper -> Typedtree.package_type -> package_type;
-  open_description: mapper -> Typedtree.open_description -> open_description;
-  pat: mapper -> Typedtree.pattern -> pattern;
-  row_field: mapper -> Typedtree.row_field -> row_field;
-  object_field: mapper -> Typedtree.object_field -> object_field;
-  signature: mapper -> Typedtree.signature -> signature;
-  signature_item: mapper -> Typedtree.signature_item -> signature_item;
-  structure: mapper -> Typedtree.structure -> structure;
-  structure_item: mapper -> Typedtree.structure_item -> structure_item;
-  typ: mapper -> Typedtree.core_type -> core_type;
-  type_declaration: mapper -> Typedtree.type_declaration -> type_declaration;
-  type_extension: mapper -> Typedtree.type_extension -> type_extension;
-  type_kind: mapper -> Typedtree.type_kind -> type_kind;
-  value_binding: mapper -> Typedtree.value_binding -> value_binding;
-  value_description: mapper -> Typedtree.value_description -> value_description;
-  with_constraint:
-    mapper -> (Path.t * Longident.t Location.loc * Typedtree.with_constraint)
-    -> with_constraint;
-}
+and module_expr ctxt f x =
+  if x.pmod_attributes <> [] then
+    pp f "((%a)%a)" (module_expr ctxt) {x with pmod_attributes=[]}
+      (attributes ctxt) x.pmod_attributes
+  else match x.pmod_desc with
+    | Pmod_structure (s) ->
+        pp f "@[<hv2>struct@;@[<0>%a@]@;<1 -2>end@]"
+          (list (structure_item ctxt) ~sep:"@\n") s;
+    | Pmod_constraint (me, mt) ->
+        pp f "@[<hov2>(%a@ :@ %a)@]"
+          (module_expr ctxt) me
+          (module_type ctxt) mt
+    | Pmod_ident (li) ->
+        pp f "%a" longident_loc li;
+    | Pmod_functor (_, None, me) ->
+        pp f "functor ()@;->@;%a" (module_expr ctxt) me
+    | Pmod_functor (s, Some mt, me) ->
+        pp f "functor@ (%s@ :@ %a)@;->@;%a"
+          s.txt (module_type ctxt) mt (module_expr ctxt) me
+    | Pmod_apply (me1, me2) ->
+        pp f "(%a)(%a)" (module_expr ctxt) me1 (module_expr ctxt) me2
+        (* Cf: #7200 *)
+    | Pmod_unpack e ->
+        pp f "(val@ %a)" (expression ctxt) e
+    | Pmod_extension e -> extension ctxt f e
 
-val default_mapper : mapper
+and structure ctxt f x = list ~sep:"@\n" (structure_item ctxt) f x
 
-val untype_structure : ?mapper:mapper -> Typedtree.structure -> structure
-val untype_signature : ?mapper:mapper -> Typedtree.signature -> signature
+and payload ctxt f = function
+  | PStr [{pstr_desc = Pstr_eval (e, attrs)}] ->
+      pp f "@[<2>%a@]%a"
+        (expression ctxt) e
+        (item_attributes ctxt) attrs
+  | PStr x -> structure ctxt f x
+  | PTyp x -> pp f ":"; core_type ctxt f x
+  | PSig x -> pp f ":"; signature ctxt f x
+  | PPat (x, None) -> pp f "?"; pattern ctxt f x
+  | PPat (x, Some e) ->
+      pp f "?"; pattern ctxt f x;
+      pp f " when "; expression ctxt f e
 
-val constant : Asttypes.constant -> Parsetree.constant
+(* transform [f = fun g h -> ..] to [f g h = ... ] could be improved *)
+and binding ctxt f {pvb_pat=p; pvb_expr=x; _} =
+  (* .pvb_attributes have already been printed by the caller, #bindings *)
+  let rec pp_print_pexp_function f x =
+    if x.pexp_attributes <> [] then pp f "=@;%a" (expression ctxt) x
+    else match x.pexp_desc with
+      | Pexp_fun (label, eo, p, e) ->
+          if label=Nolabel then
+            pp f "%a@ %a" (simple_pattern ctxt) p pp_print_pexp_function e
+          else
+            pp f "%a@ %a"
+              (label_exp ctxt) (label,eo,p) pp_print_pexp_function e
+      | Pexp_newtype (str,e) ->
+          pp f "(type@ %s)@ %a" str.txt pp_print_pexp_function e
+      | _ -> pp f "=@;%a" (expression ctxt) x
+  in
+  let tyvars_str tyvars = List.map (fun v -> v.txt) tyvars in
+  let is_desugared_gadt p e =
+    let gadt_pattern =
+      match p with
+      | {ppat_desc=Ppat_constraint({ppat_desc=Ppat_var _} as pat,
+                                   {ptyp_desc=Ptyp_poly (args_tyvars, rt)});
+         ppat_attributes=[]}->
+          Some (pat, args_tyvars, rt)
+      | _ -> None in
+    let rec gadt_exp tyvars e =
+      match e with
+      | {pexp_desc=Pexp_newtype (tyvar, e); pexp_attributes=[]} ->
+          gadt_exp (tyvar :: tyvars) e
+      | {pexp_desc=Pexp_constraint (e, ct); pexp_attributes=[]} ->
+          Some (List.rev tyvars, e, ct)
+      | _ -> None in
+    let gadt_exp = gadt_exp [] e in
+    match gadt_pattern, gadt_exp with
+    | Some (p, pt_tyvars, pt_ct), Some (e_tyvars, e, e_ct)
+      when tyvars_str pt_tyvars = tyvars_str e_tyvars ->
+      let ety = Typ.varify_constructors e_tyvars e_ct in
+      if ety = pt_ct then
+      Some (p, pt_tyvars, e_ct, e) else None
+    | _ -> None in
+  if x.pexp_attributes <> []
+  then pp f "%a@;=@;%a" (pattern ctxt) p (expression ctxt) x else
+  match is_desugared_gadt p x with
+  | Some (p, [], ct, e) ->
+      pp f "%a@;: %a@;=@;%a"
+        (simple_pattern ctxt) p (core_type ctxt) ct (expression ctxt) e
+  | Some (p, tyvars, ct, e) -> begin
+    pp f "%a@;: type@;%a.@;%a@;=@;%a"
+    (simple_pattern ctxt) p (list pp_print_string ~sep:"@;")
+    (tyvars_str tyvars) (core_type ctxt) ct (expression ctxt) e
+    end
+  | None -> begin
+      match p with
+      | {ppat_desc=Ppat_constraint(p ,ty);
+         ppat_attributes=[]} -> (* special case for the first*)
+          begin match ty with
+          | {ptyp_desc=Ptyp_poly _; ptyp_attributes=[]} ->
+              pp f "%a@;:@;%a@;=@;%a" (simple_pattern ctxt) p
+                (core_type ctxt) ty (expression ctxt) x
+          | _ ->
+              pp f "(%a@;:@;%a)@;=@;%a" (simple_pattern ctxt) p
+                (core_type ctxt) ty (expression ctxt) x
+          end
+      | {ppat_desc=Ppat_var _; ppat_attributes=[]} ->
+          pp f "%a@ %a" (simple_pattern ctxt) p pp_print_pexp_function x
+      | _ ->
+          pp f "%a@;=@;%a" (pattern ctxt) p (expression ctxt) x
+    end
 
-end = struct
-#1 "untypeast.ml"
+(* [in] is not printed *)
+and bindings ctxt f (rf,l) =
+  let binding kwd rf f x =
+    pp f "@[<2>%s %a%a@]%a" kwd rec_flag rf
+      (binding ctxt) x (item_attributes ctxt) x.pvb_attributes
+  in
+  match l with
+  | [] -> ()
+  | [x] -> binding "let" rf f x
+  | x::xs ->
+      pp f "@[<v>%a@,%a@]"
+        (binding "let" rf) x
+        (list ~sep:"@," (binding "and" Nonrecursive)) xs
+
+and structure_item ctxt f x =
+  match x.pstr_desc with
+  | Pstr_eval (e, attrs) ->
+      pp f "@[<hov2>;;%a@]%a"
+        (expression ctxt) e
+        (item_attributes ctxt) attrs
+  | Pstr_type (_, []) -> assert false
+  | Pstr_type (rf, l)  -> type_def_list ctxt f (rf, l)
+  | Pstr_value (rf, l) ->
+      (* pp f "@[<hov2>let %a%a@]"  rec_flag rf bindings l *)
+      pp f "@[<2>%a@]" (bindings ctxt) (rf,l)
+  | Pstr_typext te -> type_extension ctxt f te
+  | Pstr_exception ed -> exception_declaration ctxt f ed
+  | Pstr_module x ->
+      let rec module_helper = function
+        | {pmod_desc=Pmod_functor(s,mt,me'); pmod_attributes = []} ->
+            if mt = None then pp f "()"
+            else Misc.may (pp f "(%s:%a)" s.txt (module_type ctxt)) mt;
+            module_helper me'
+        | me -> me
+      in
+      pp f "@[<hov2>module %s%a@]%a"
+        x.pmb_name.txt
+        (fun f me ->
+           let me = module_helper me in
+           match me with
+           | {pmod_desc=
+                Pmod_constraint
+                  (me',
+                   ({pmty_desc=(Pmty_ident (_)
+                               | Pmty_signature (_));_} as mt));
+              pmod_attributes = []} ->
+               pp f " :@;%a@;=@;%a@;"
+                 (module_type ctxt) mt (module_expr ctxt) me'
+           | _ -> pp f " =@ %a" (module_expr ctxt) me
+        ) x.pmb_expr
+        (item_attributes ctxt) x.pmb_attributes
+  | Pstr_open od ->
+      pp f "@[<2>open%s@;%a@]%a"
+        (override od.popen_override)
+        longident_loc od.popen_lid
+        (item_attributes ctxt) od.popen_attributes
+  | Pstr_modtype {pmtd_name=s; pmtd_type=md; pmtd_attributes=attrs} ->
+      pp f "@[<hov2>module@ type@ %s%a@]%a"
+        s.txt
+        (fun f md -> match md with
+           | None -> ()
+           | Some mt ->
+               pp_print_space f () ;
+               pp f "@ =@ %a" (module_type ctxt) mt
+        ) md
+        (item_attributes ctxt) attrs
+  | Pstr_class () -> ()
+  | Pstr_class_type l -> class_type_declaration_list ctxt f l
+  | Pstr_primitive vd ->
+      pp f "@[<hov2>external@ %a@ :@ %a@]%a"
+        protect_ident vd.pval_name.txt
+        (value_description ctxt) vd
+        (item_attributes ctxt) vd.pval_attributes
+  | Pstr_include incl ->
+      pp f "@[<hov2>include@ %a@]%a"
+        (module_expr ctxt) incl.pincl_mod
+        (item_attributes ctxt) incl.pincl_attributes
+  | Pstr_recmodule decls -> (* 3.07 *)
+      let aux f = function
+        | ({pmb_expr={pmod_desc=Pmod_constraint (expr, typ)}} as pmb) ->
+            pp f "@[<hov2>@ and@ %s:%a@ =@ %a@]%a" pmb.pmb_name.txt
+              (module_type ctxt) typ
+              (module_expr ctxt) expr
+              (item_attributes ctxt) pmb.pmb_attributes
+        | _ -> assert false
+      in
+      begin match decls with
+      | ({pmb_expr={pmod_desc=Pmod_constraint (expr, typ)}} as pmb) :: l2 ->
+          pp f "@[<hv>@[<hov2>module@ rec@ %s:%a@ =@ %a@]%a@ %a@]"
+            pmb.pmb_name.txt
+            (module_type ctxt) typ
+            (module_expr ctxt) expr
+            (item_attributes ctxt) pmb.pmb_attributes
+            (fun f l2 -> List.iter (aux f) l2) l2
+      | _ -> assert false
+      end
+  | Pstr_attribute a -> floating_attribute ctxt f a
+  | Pstr_extension(e, a) ->
+      item_extension ctxt f e;
+      item_attributes ctxt f a
+
+and type_param ctxt f (ct, a) =
+  pp f "%s%a" (type_variance a) (core_type ctxt) ct
+
+and type_params ctxt f = function
+  | [] -> ()
+  | l -> pp f "%a " (list (type_param ctxt) ~first:"(" ~last:")" ~sep:",@;") l
+
+and type_def_list ctxt f (rf, l) =
+  let type_decl kwd rf f x =
+    let eq =
+      if (x.ptype_kind = Ptype_abstract)
+         && (x.ptype_manifest = None) then ""
+      else " ="
+    in
+    pp f "@[<2>%s %a%a%s%s%a@]%a" kwd
+      nonrec_flag rf
+      (type_params ctxt) x.ptype_params
+      x.ptype_name.txt eq
+      (type_declaration ctxt) x
+      (item_attributes ctxt) x.ptype_attributes
+  in
+  match l with
+  | [] -> assert false
+  | [x] -> type_decl "type" rf f x
+  | x :: xs -> pp f "@[<v>%a@,%a@]"
+                 (type_decl "type" rf) x
+                 (list ~sep:"@," (type_decl "and" Recursive)) xs
+
+and record_declaration ctxt f lbls =
+  let type_record_field f pld =
+    pp f "@[<2>%a%s:@;%a@;%a@]"
+      mutable_flag pld.pld_mutable
+      pld.pld_name.txt
+      (core_type ctxt) pld.pld_type
+      (attributes ctxt) pld.pld_attributes
+  in
+  pp f "{@\n%a}"
+    (list type_record_field ~sep:";@\n" )  lbls
+
+and type_declaration ctxt f x =
+  (* type_declaration has an attribute field,
+     but it's been printed by the caller of this method *)
+  let priv f =
+    match x.ptype_private with
+    | Public -> ()
+    | Private -> pp f "@;private"
+  in
+  let manifest f =
+    match x.ptype_manifest with
+    | None -> ()
+    | Some y ->
+        if x.ptype_kind = Ptype_abstract then
+          pp f "%t@;%a" priv (core_type ctxt) y
+        else
+          pp f "@;%a" (core_type ctxt) y
+  in
+  let constructor_declaration f pcd =
+    pp f "|@;";
+    constructor_declaration ctxt f
+      (pcd.pcd_name.txt, pcd.pcd_args, pcd.pcd_res, pcd.pcd_attributes)
+  in
+  let repr f =
+    let intro f =
+      if x.ptype_manifest = None then ()
+      else pp f "@;="
+    in
+    match x.ptype_kind with
+    | Ptype_variant xs ->
+        pp f "%t%t@\n%a" intro priv
+          (list ~sep:"@\n" constructor_declaration) xs
+    | Ptype_abstract -> ()
+    | Ptype_record l ->
+        pp f "%t%t@;%a" intro priv (record_declaration ctxt) l
+    | Ptype_open -> pp f "%t%t@;.." intro priv
+  in
+  let constraints f =
+    List.iter
+      (fun (ct1,ct2,_) ->
+         pp f "@[<hov2>@ constraint@ %a@ =@ %a@]"
+           (core_type ctxt) ct1 (core_type ctxt) ct2)
+      x.ptype_cstrs
+  in
+  pp f "%t%t%t" manifest repr constraints
+
+and type_extension ctxt f x =
+  let extension_constructor f x =
+    pp f "@\n|@;%a" (extension_constructor ctxt) x
+  in
+  pp f "@[<2>type %a%a += %a@ %a@]%a"
+    (fun f -> function
+       | [] -> ()
+       | l ->
+           pp f "%a@;" (list (type_param ctxt) ~first:"(" ~last:")" ~sep:",") l)
+    x.ptyext_params
+    longident_loc x.ptyext_path
+    private_flag x.ptyext_private (* Cf: #7200 *)
+    (list ~sep:"" extension_constructor)
+    x.ptyext_constructors
+    (item_attributes ctxt) x.ptyext_attributes
+
+and constructor_declaration ctxt f (name, args, res, attrs) =
+  let name =
+    match name with
+    | "::" -> "(::)"
+    | s -> s in
+  match res with
+  | None ->
+      pp f "%s%a@;%a" name
+        (fun f -> function
+           | Pcstr_tuple [] -> ()
+           | Pcstr_tuple l ->
+             pp f "@;of@;%a" (list (core_type1 ctxt) ~sep:"@;*@;") l
+           | Pcstr_record l -> pp f "@;of@;%a" (record_declaration ctxt) l
+        ) args
+        (attributes ctxt) attrs
+  | Some r ->
+      pp f "%s:@;%a@;%a" name
+        (fun f -> function
+           | Pcstr_tuple [] -> core_type1 ctxt f r
+           | Pcstr_tuple l -> pp f "%a@;->@;%a"
+                                (list (core_type1 ctxt) ~sep:"@;*@;") l
+                                (core_type1 ctxt) r
+           | Pcstr_record l ->
+               pp f "%a@;->@;%a" (record_declaration ctxt) l (core_type1 ctxt) r
+        )
+        args
+        (attributes ctxt) attrs
+
+and extension_constructor ctxt f x =
+  (* Cf: #7200 *)
+  match x.pext_kind with
+  | Pext_decl(l, r) ->
+      constructor_declaration ctxt f (x.pext_name.txt, l, r, x.pext_attributes)
+  | Pext_rebind li ->
+      pp f "%s%a@;=@;%a" x.pext_name.txt
+        (attributes ctxt) x.pext_attributes
+        longident_loc li
+
+and case_list ctxt f l : unit =
+  let aux f {pc_lhs; pc_guard; pc_rhs} =
+    pp f "@;| @[<2>%a%a@;->@;%a@]"
+      (pattern ctxt) pc_lhs (option (expression ctxt) ~first:"@;when@;")
+      pc_guard (expression (under_pipe ctxt)) pc_rhs
+  in
+  list aux f l ~sep:""
+
+and label_x_expression_param ctxt f (l,e) =
+  let simple_name = match e with
+    | {pexp_desc=Pexp_ident {txt=Lident l;_};
+       pexp_attributes=[]} -> Some l
+    | _ -> None
+  in match l with
+  | Nolabel  -> expression2 ctxt f e (* level 2*)
+  | Optional str ->
+      if Some str = simple_name then
+        pp f "?%s" str
+      else
+        pp f "?%s:%a" str (simple_expr ctxt) e
+  | Labelled lbl ->
+      if Some lbl = simple_name then
+        pp f "~%s" lbl
+      else
+        pp f "~%s:%a" lbl (simple_expr ctxt) e
+
+
+
+let expression f x =
+  pp f "@[%a@]" (expression reset_ctxt) x
+
+let string_of_expression x =
+  ignore (flush_str_formatter ()) ;
+  let f = str_formatter in
+  expression f x;
+  flush_str_formatter ()
+
+let string_of_structure x =
+  ignore (flush_str_formatter ());
+  let f = str_formatter in
+  structure reset_ctxt f x;
+  flush_str_formatter ()
+
+
+let core_type = core_type reset_ctxt
+let pattern = pattern reset_ctxt
+let signature = signature reset_ctxt
+let structure = structure reset_ctxt
+
+end
+module TypedtreeIter : sig 
+#1 "typedtreeIter.mli"
 (**************************************************************************)
 (*                                                                        *)
 (*                                 OCaml                                  *)
@@ -187445,27 +188207,793 @@ end = struct
 (*                                                                        *)
 (**************************************************************************)
 
-open Longident
 open Asttypes
-open Parsetree
-open Ast_helper
+open Typedtree
 
-module T = Typedtree
 
-type mapper = {
-  attribute: mapper -> T.attribute -> attribute;
-  attributes: mapper -> T.attribute list -> attribute list;
-  case: mapper -> T.case -> case;
-  cases: mapper -> T.case list -> case list;
-  class_signature: mapper -> T.class_signature -> class_signature;
-  class_type: mapper -> T.class_type -> class_type;
-  class_type_declaration: mapper -> T.class_type_declaration
-                          -> class_type_declaration;
-  class_type_field: mapper -> T.class_type_field -> class_type_field;
-  constructor_declaration: mapper -> T.constructor_declaration
-                           -> constructor_declaration;
-  expr: mapper -> T.expression -> expression;
-  extension_constructor: mapper -> T.extension_constructor
+module type IteratorArgument = sig
+    val enter_structure : structure -> unit
+    val enter_value_description : value_description -> unit
+    val enter_type_extension : type_extension -> unit
+    val enter_extension_constructor : extension_constructor -> unit
+    val enter_pattern : pattern -> unit
+    val enter_expression : expression -> unit
+    val enter_package_type : package_type -> unit
+    val enter_signature : signature -> unit
+    val enter_signature_item : signature_item -> unit
+    val enter_module_type_declaration : module_type_declaration -> unit
+    val enter_module_type : module_type -> unit
+    val enter_module_expr : module_expr -> unit
+    val enter_with_constraint : with_constraint -> unit
+    val enter_class_signature : class_signature -> unit
+    val enter_class_description : class_description -> unit
+    val enter_class_type_declaration : class_type_declaration -> unit
+    val enter_class_type : class_type -> unit
+    val enter_class_type_field : class_type_field -> unit
+    val enter_core_type : core_type -> unit
+    val enter_structure_item : structure_item -> unit
+
+
+    val leave_structure : structure -> unit
+    val leave_value_description : value_description -> unit
+    val leave_type_extension : type_extension -> unit
+    val leave_extension_constructor : extension_constructor -> unit
+    val leave_pattern : pattern -> unit
+    val leave_expression : expression -> unit
+    val leave_package_type : package_type -> unit
+    val leave_signature : signature -> unit
+    val leave_signature_item : signature_item -> unit
+    val leave_module_type_declaration : module_type_declaration -> unit
+    val leave_module_type : module_type -> unit
+    val leave_module_expr : module_expr -> unit
+    val leave_with_constraint : with_constraint -> unit
+    val leave_class_signature : class_signature -> unit
+    val leave_class_description : class_description -> unit
+    val leave_class_type_declaration : class_type_declaration -> unit
+    val leave_class_type : class_type -> unit
+    val leave_class_type_field : class_type_field -> unit
+    val leave_core_type : core_type -> unit
+    val leave_structure_item : structure_item -> unit
+
+    val enter_bindings : rec_flag -> unit
+    val enter_binding : value_binding -> unit
+    val leave_binding : value_binding -> unit
+    val leave_bindings : rec_flag -> unit
+
+    val enter_type_declarations : rec_flag -> unit
+    val enter_type_declaration : type_declaration -> unit
+    val leave_type_declaration : type_declaration -> unit
+    val leave_type_declarations : rec_flag -> unit
+
+end
+
+module [@warning "-67"] MakeIterator :
+  functor (Iter : IteratorArgument) ->
+    sig
+      val iter_structure : structure -> unit
+      val iter_signature : signature -> unit
+      val iter_structure_item : structure_item -> unit
+      val iter_signature_item : signature_item -> unit
+      val iter_expression : expression -> unit
+      val iter_module_type : module_type -> unit
+      val iter_pattern : pattern -> unit
+    end
+
+module DefaultIteratorArgument : IteratorArgument
+
+end = struct
+#1 "typedtreeIter.ml"
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*    Thomas Gazagnaire (OCamlPro), Fabrice Le Fessant (INRIA Saclay)     *)
+(*                                                                        *)
+(*   Copyright 2007 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(*
+TODO:
+ - 2012/05/10: Follow camlp4 way of building map and iter using classes
+     and inheritance ?
+*)
+
+open Asttypes
+open Typedtree
+
+module type IteratorArgument = sig
+
+    val enter_structure : structure -> unit
+    val enter_value_description : value_description -> unit
+    val enter_type_extension : type_extension -> unit
+    val enter_extension_constructor : extension_constructor -> unit
+    val enter_pattern : pattern -> unit
+    val enter_expression : expression -> unit
+    val enter_package_type : package_type -> unit
+    val enter_signature : signature -> unit
+    val enter_signature_item : signature_item -> unit
+    val enter_module_type_declaration : module_type_declaration -> unit
+    val enter_module_type : module_type -> unit
+    val enter_module_expr : module_expr -> unit
+    val enter_with_constraint : with_constraint -> unit
+    val enter_class_signature : class_signature -> unit
+
+    val enter_class_description : class_description -> unit
+    val enter_class_type_declaration : class_type_declaration -> unit
+    val enter_class_type : class_type -> unit
+    val enter_class_type_field : class_type_field -> unit
+    val enter_core_type : core_type -> unit
+    val enter_structure_item : structure_item -> unit
+
+
+    val leave_structure : structure -> unit
+    val leave_value_description : value_description -> unit
+    val leave_type_extension : type_extension -> unit
+    val leave_extension_constructor : extension_constructor -> unit
+    val leave_pattern : pattern -> unit
+    val leave_expression : expression -> unit
+    val leave_package_type : package_type -> unit
+    val leave_signature : signature -> unit
+    val leave_signature_item : signature_item -> unit
+    val leave_module_type_declaration : module_type_declaration -> unit
+    val leave_module_type : module_type -> unit
+    val leave_module_expr : module_expr -> unit
+    val leave_with_constraint : with_constraint -> unit
+    val leave_class_signature : class_signature -> unit
+
+    val leave_class_description : class_description -> unit
+    val leave_class_type_declaration : class_type_declaration -> unit
+    val leave_class_type : class_type -> unit
+    val leave_class_type_field : class_type_field -> unit
+    val leave_core_type : core_type -> unit
+    val leave_structure_item : structure_item -> unit
+
+    val enter_bindings : rec_flag -> unit
+    val enter_binding : value_binding -> unit
+    val leave_binding : value_binding -> unit
+    val leave_bindings : rec_flag -> unit
+
+    val enter_type_declarations : rec_flag -> unit
+    val enter_type_declaration : type_declaration -> unit
+    val leave_type_declaration : type_declaration -> unit
+    val leave_type_declarations : rec_flag -> unit
+
+      end
+
+module MakeIterator(Iter : IteratorArgument) : sig
+
+    val iter_structure : structure -> unit
+    val iter_signature : signature -> unit
+    val iter_structure_item : structure_item -> unit
+    val iter_signature_item : signature_item -> unit
+    val iter_expression : expression -> unit
+    val iter_module_type : module_type -> unit
+    val iter_pattern : pattern -> unit
+
+  end = struct
+
+    let may_iter f v =
+      match v with
+        None -> ()
+      | Some x -> f x
+
+
+    let rec iter_structure str =
+      Iter.enter_structure str;
+      List.iter iter_structure_item str.str_items;
+      Iter.leave_structure str
+
+
+    and iter_binding vb =
+      Iter.enter_binding vb;
+      iter_pattern vb.vb_pat;
+      iter_expression vb.vb_expr;
+      Iter.leave_binding vb
+
+    and iter_bindings rec_flag list =
+      Iter.enter_bindings rec_flag;
+      List.iter iter_binding list;
+      Iter.leave_bindings rec_flag
+
+    and iter_case {c_lhs; c_guard; c_rhs} =
+      iter_pattern c_lhs;
+      may_iter iter_expression c_guard;
+      iter_expression c_rhs
+
+    and iter_cases cases =
+      List.iter iter_case cases
+
+    and iter_structure_item item =
+      Iter.enter_structure_item item;
+      begin
+        match item.str_desc with
+          Tstr_eval (exp, _attrs) -> iter_expression exp
+        | Tstr_value (rec_flag, list) ->
+            iter_bindings rec_flag list
+        | Tstr_primitive vd -> iter_value_description vd
+        | Tstr_type (rf, list) -> iter_type_declarations rf list
+        | Tstr_typext tyext -> iter_type_extension tyext
+        | Tstr_exception ext -> iter_extension_constructor ext
+        | Tstr_module x -> iter_module_binding x
+        | Tstr_recmodule list -> List.iter iter_module_binding list
+        | Tstr_modtype mtd -> iter_module_type_declaration mtd
+        | Tstr_open _ -> ()
+        | Tstr_class () -> ()
+        | Tstr_class_type list ->
+            List.iter
+              (fun (_, _, ct) -> iter_class_type_declaration ct)
+              list
+        | Tstr_include incl -> iter_module_expr incl.incl_mod
+        | Tstr_attribute _ ->
+            ()
+      end;
+      Iter.leave_structure_item item
+
+    and iter_module_binding x =
+      iter_module_expr x.mb_expr
+
+    and iter_value_description v =
+      Iter.enter_value_description v;
+      iter_core_type v.val_desc;
+      Iter.leave_value_description v
+
+    and iter_constructor_arguments = function
+      | Cstr_tuple l -> List.iter iter_core_type l
+      | Cstr_record l -> List.iter (fun ld -> iter_core_type ld.ld_type) l
+
+    and iter_constructor_declaration cd =
+      iter_constructor_arguments cd.cd_args;
+      option iter_core_type cd.cd_res;
+
+    and iter_type_parameter (ct, _v) =
+      iter_core_type ct
+
+    and iter_type_declaration decl =
+      Iter.enter_type_declaration decl;
+      List.iter iter_type_parameter decl.typ_params;
+      List.iter (fun (ct1, ct2, _loc) ->
+          iter_core_type ct1;
+          iter_core_type ct2
+      ) decl.typ_cstrs;
+      begin match decl.typ_kind with
+          Ttype_abstract -> ()
+        | Ttype_variant list ->
+            List.iter iter_constructor_declaration list
+        | Ttype_record list ->
+            List.iter
+              (fun ld ->
+                iter_core_type ld.ld_type
+            ) list
+        | Ttype_open -> ()
+      end;
+      option iter_core_type decl.typ_manifest;
+      Iter.leave_type_declaration decl
+
+    and iter_type_declarations rec_flag decls =
+      Iter.enter_type_declarations rec_flag;
+      List.iter iter_type_declaration decls;
+      Iter.leave_type_declarations rec_flag
+
+    and iter_extension_constructor ext =
+      Iter.enter_extension_constructor ext;
+      begin match ext.ext_kind with
+          Text_decl(args, ret) ->
+          iter_constructor_arguments args;
+            option iter_core_type ret
+        | Text_rebind _ -> ()
+      end;
+      Iter.leave_extension_constructor ext;
+
+    and iter_type_extension tyext =
+      Iter.enter_type_extension tyext;
+      List.iter iter_type_parameter tyext.tyext_params;
+      List.iter iter_extension_constructor tyext.tyext_constructors;
+      Iter.leave_type_extension tyext
+
+    and iter_pattern pat =
+      Iter.enter_pattern pat;
+      List.iter (fun (cstr, _, _attrs) -> match cstr with
+              | Tpat_type _ -> ()
+              | Tpat_unpack -> ()
+              | Tpat_open _ -> ()
+              | Tpat_constraint ct -> iter_core_type ct) pat.pat_extra;
+      begin
+        match pat.pat_desc with
+          Tpat_any -> ()
+        | Tpat_var _ -> ()
+        | Tpat_alias (pat1, _, _) -> iter_pattern pat1
+        | Tpat_constant _ -> ()
+        | Tpat_tuple list ->
+            List.iter iter_pattern list
+        | Tpat_construct (_, _, args) ->
+            List.iter iter_pattern args
+        | Tpat_variant (_, pato, _) ->
+            begin match pato with
+                None -> ()
+              | Some pat -> iter_pattern pat
+            end
+        | Tpat_record (list, _closed) ->
+            List.iter (fun (_, _, pat) -> iter_pattern pat) list
+        | Tpat_array list -> List.iter iter_pattern list
+        | Tpat_or (p1, p2, _) -> iter_pattern p1; iter_pattern p2
+        | Tpat_lazy p -> iter_pattern p
+      end;
+      Iter.leave_pattern pat
+
+    and option f x = match x with None -> () | Some e -> f e
+
+    and iter_expression exp =
+      Iter.enter_expression exp;
+      List.iter (function (cstr, _, _attrs) ->
+        match cstr with
+          Texp_constraint ct ->
+            iter_core_type ct
+        | Texp_coerce (cty1, cty2) ->
+            option iter_core_type cty1; iter_core_type cty2
+        | Texp_open _ -> ()
+        | Texp_poly cto -> option iter_core_type cto
+        | Texp_newtype _ -> ())
+        exp.exp_extra;
+      begin
+        match exp.exp_desc with
+          Texp_ident _ -> ()
+        | Texp_constant _ -> ()
+        | Texp_let (rec_flag, list, exp) ->
+            iter_bindings rec_flag list;
+            iter_expression exp
+        | Texp_function { cases; _ } ->
+            iter_cases cases
+        | Texp_apply (exp, list) ->
+            iter_expression exp;
+            List.iter (fun (_label, expo) ->
+                match expo with
+                  None -> ()
+                | Some exp -> iter_expression exp
+            ) list
+        | Texp_match (exp, list1, list2, _) ->
+            iter_expression exp;
+            iter_cases list1;
+            iter_cases list2;
+        | Texp_try (exp, list) ->
+            iter_expression exp;
+            iter_cases list
+        | Texp_tuple list ->
+            List.iter iter_expression list
+        | Texp_construct (_, _, args) ->
+            List.iter iter_expression args
+        | Texp_variant (_label, expo) ->
+            begin match expo with
+                None -> ()
+              | Some exp -> iter_expression exp
+            end
+        | Texp_record { fields; extended_expression; _ } ->
+            Array.iter (function
+                | _, Kept _ -> ()
+                | _, Overridden (_, exp) -> iter_expression exp)
+              fields;
+            begin match extended_expression with
+                None -> ()
+              | Some exp -> iter_expression exp
+            end
+        | Texp_field (exp, _, _label) ->
+            iter_expression exp
+        | Texp_setfield (exp1, _, _label, exp2) ->
+            iter_expression exp1;
+            iter_expression exp2
+        | Texp_array list ->
+            List.iter iter_expression list
+        | Texp_ifthenelse (exp1, exp2, expo) ->
+            iter_expression exp1;
+            iter_expression exp2;
+            begin match expo with
+                None -> ()
+              | Some exp -> iter_expression exp
+            end
+        | Texp_sequence (exp1, exp2) ->
+            iter_expression exp1;
+            iter_expression exp2
+        | Texp_while (exp1, exp2) ->
+            iter_expression exp1;
+            iter_expression exp2
+        | Texp_for (_id, _, exp1, exp2, _dir, exp3) ->
+            iter_expression exp1;
+            iter_expression exp2;
+            iter_expression exp3
+        | Texp_send (exp, _meth, expo) ->
+            iter_expression exp;
+          begin
+            match expo with
+                None -> ()
+              | Some exp -> iter_expression exp
+          end
+        | Texp_new _ 
+        | Texp_instvar _ 
+        | Texp_setinstvar _ 
+        | Texp_override _ -> ()
+        | Texp_letmodule (_id, _, mexpr, exp) ->
+            iter_module_expr mexpr;
+            iter_expression exp
+        | Texp_letexception (cd, exp) ->
+            iter_extension_constructor cd;
+            iter_expression exp
+        | Texp_assert exp -> iter_expression exp
+        | Texp_lazy exp -> iter_expression exp
+        | Texp_object () ->
+            ()
+        | Texp_pack (mexpr) ->
+            iter_module_expr mexpr
+        | Texp_unreachable ->
+            ()
+        | Texp_extension_constructor _ ->
+            ()
+      end;
+      Iter.leave_expression exp;
+
+    and iter_package_type pack =
+      Iter.enter_package_type pack;
+      List.iter (fun (_s, ct) -> iter_core_type ct) pack.pack_fields;
+      Iter.leave_package_type pack;
+
+    and iter_signature sg =
+      Iter.enter_signature sg;
+      List.iter iter_signature_item sg.sig_items;
+      Iter.leave_signature sg;
+
+    and iter_signature_item item =
+      Iter.enter_signature_item item;
+      begin
+        match item.sig_desc with
+          Tsig_value vd ->
+            iter_value_description vd
+        | Tsig_type (rf, list) ->
+            iter_type_declarations rf list
+        | Tsig_exception ext ->
+            iter_extension_constructor ext
+        | Tsig_typext tyext ->
+            iter_type_extension tyext
+        | Tsig_module md ->
+            iter_module_type md.md_type
+        | Tsig_recmodule list ->
+            List.iter (fun md -> iter_module_type md.md_type) list
+        | Tsig_modtype mtd ->
+            iter_module_type_declaration mtd
+        | Tsig_open _ -> ()
+        | Tsig_include incl -> iter_module_type incl.incl_mod
+        | Tsig_class () -> ()
+        | Tsig_class_type list ->
+            List.iter iter_class_type_declaration list
+        | Tsig_attribute _ -> ()
+      end;
+      Iter.leave_signature_item item;
+
+    and iter_module_type_declaration mtd =
+      Iter.enter_module_type_declaration mtd;
+      begin
+        match mtd.mtd_type with
+        | None -> ()
+        | Some mtype -> iter_module_type mtype
+      end;
+      Iter.leave_module_type_declaration mtd
+
+
+
+    and iter_class_type_declaration cd =
+      Iter.enter_class_type_declaration cd;
+      List.iter iter_type_parameter cd.ci_params;
+      iter_class_type cd.ci_expr;
+      Iter.leave_class_type_declaration cd;
+
+    and iter_module_type mty =
+      Iter.enter_module_type mty;
+      begin
+        match mty.mty_desc with
+          Tmty_ident _ -> ()
+        | Tmty_alias _ -> ()
+        | Tmty_signature sg -> iter_signature sg
+        | Tmty_functor (_, _, mtype1, mtype2) ->
+            Misc.may iter_module_type mtype1; iter_module_type mtype2
+        | Tmty_with (mtype, list) ->
+            iter_module_type mtype;
+            List.iter (fun (_path, _, withc) ->
+                iter_with_constraint withc
+            ) list
+        | Tmty_typeof mexpr ->
+            iter_module_expr mexpr
+      end;
+      Iter.leave_module_type mty;
+
+    and iter_with_constraint cstr =
+      Iter.enter_with_constraint cstr;
+      begin
+        match cstr with
+          Twith_type decl -> iter_type_declaration decl
+        | Twith_module _ -> ()
+        | Twith_typesubst decl -> iter_type_declaration decl
+        | Twith_modsubst _ -> ()
+      end;
+      Iter.leave_with_constraint cstr;
+
+    and iter_module_expr mexpr =
+      Iter.enter_module_expr mexpr;
+      begin
+        match mexpr.mod_desc with
+          Tmod_ident _ -> ()
+        | Tmod_structure st -> iter_structure st
+        | Tmod_functor (_, _, mtype, mexpr) ->
+            Misc.may iter_module_type mtype;
+            iter_module_expr mexpr
+        | Tmod_apply (mexp1, mexp2, _) ->
+            iter_module_expr mexp1;
+            iter_module_expr mexp2
+        | Tmod_constraint (mexpr, _, Tmodtype_implicit, _ ) ->
+            iter_module_expr mexpr
+        | Tmod_constraint (mexpr, _, Tmodtype_explicit mtype, _) ->
+            iter_module_expr mexpr;
+            iter_module_type mtype
+        | Tmod_unpack (exp, _mty) ->
+            iter_expression exp
+(*          iter_module_type mty *)
+      end;
+      Iter.leave_module_expr mexpr;
+
+
+    and iter_class_type ct =
+      Iter.enter_class_type ct;
+      begin
+        match ct.cltyp_desc with
+          Tcty_signature csg -> iter_class_signature csg
+        | Tcty_constr (_path, _, list) ->
+            List.iter iter_core_type list
+        | Tcty_arrow (_label, ct, cl) ->
+            iter_core_type ct;
+            iter_class_type cl
+        | Tcty_open (_, _, _, _, e) ->
+            iter_class_type e
+      end;
+      Iter.leave_class_type ct;
+
+    and iter_class_signature cs =
+      Iter.enter_class_signature cs;
+      iter_core_type cs.csig_self;
+      List.iter iter_class_type_field cs.csig_fields;
+      Iter.leave_class_signature cs
+
+
+    and iter_class_type_field ctf =
+      Iter.enter_class_type_field ctf;
+      begin
+        match ctf.ctf_desc with
+          Tctf_inherit ct -> iter_class_type ct
+        | Tctf_val (_s, _mut, _virt, ct) ->
+            iter_core_type ct
+        | Tctf_method (_s, _priv, _virt, ct) ->
+            iter_core_type ct
+        | Tctf_constraint  (ct1, ct2) ->
+            iter_core_type ct1;
+            iter_core_type ct2
+        | Tctf_attribute _ -> ()
+      end;
+      Iter.leave_class_type_field ctf
+
+    and iter_core_type ct =
+      Iter.enter_core_type ct;
+      begin
+        match ct.ctyp_desc with
+          Ttyp_any -> ()
+        | Ttyp_var _ -> ()
+        | Ttyp_arrow (_label, ct1, ct2) ->
+            iter_core_type ct1;
+            iter_core_type ct2
+        | Ttyp_tuple list -> List.iter iter_core_type list
+        | Ttyp_constr (_path, _, list) ->
+            List.iter iter_core_type list
+        | Ttyp_object (list, _o) ->
+            List.iter iter_object_field list
+        | Ttyp_class (_path, _, list) ->
+            List.iter iter_core_type list
+        | Ttyp_alias (ct, _s) ->
+            iter_core_type ct
+        | Ttyp_variant (list, _bool, _labels) ->
+            List.iter iter_row_field list
+        | Ttyp_poly (_list, ct) -> iter_core_type ct
+        | Ttyp_package pack -> iter_package_type pack
+      end;
+      Iter.leave_core_type ct
+
+    and iter_row_field rf =
+      match rf with
+        Ttag (_label, _attrs, _bool, list) ->
+          List.iter iter_core_type list
+      | Tinherit ct -> iter_core_type ct
+
+    and iter_object_field ofield =
+      match ofield with
+        OTtag (_, _, ct) | OTinherit ct -> iter_core_type ct
+
+  end
+
+module DefaultIteratorArgument = struct
+
+      let enter_structure _ = ()
+      let enter_value_description _ = ()
+      let enter_type_extension _ = ()
+      let enter_extension_constructor _ = ()
+      let enter_pattern _ = ()
+      let enter_expression _ = ()
+      let enter_package_type _ = ()
+      let enter_signature _ = ()
+      let enter_signature_item _ = ()
+      let enter_module_type_declaration _ = ()
+      let enter_module_type _ = ()
+      let enter_module_expr _ = ()
+      let enter_with_constraint _ = ()
+      let enter_class_signature _ = ()
+
+      let enter_class_description _ = ()
+      let enter_class_type_declaration _ = ()
+      let enter_class_type _ = ()
+      let enter_class_type_field _ = ()
+      let enter_core_type _ = ()
+    let enter_structure_item _ = ()
+
+
+      let leave_structure _ = ()
+      let leave_value_description _ = ()
+      let leave_type_extension _ = ()
+      let leave_extension_constructor _ = ()
+      let leave_pattern _ = ()
+      let leave_expression _ = ()
+      let leave_package_type _ = ()
+      let leave_signature _ = ()
+      let leave_signature_item _ = ()
+      let leave_module_type_declaration _ = ()
+      let leave_module_type _ = ()
+      let leave_module_expr _ = ()
+      let leave_with_constraint _ = ()
+      let leave_class_signature _ = ()
+
+      let leave_class_description _ = ()
+      let leave_class_type_declaration _ = ()
+      let leave_class_type _ = ()
+      let leave_class_type_field _ = ()
+      let leave_core_type _ = ()
+    let leave_structure_item _ = ()
+
+    let enter_binding _ = ()
+    let leave_binding _ = ()
+
+    let enter_bindings _ = ()
+    let leave_bindings _ = ()
+
+    let enter_type_declaration _ = ()
+    let leave_type_declaration _ = ()
+
+    let enter_type_declarations _ = ()
+    let leave_type_declarations _ = ()
+end
+
+end
+module Untypeast : sig 
+#1 "untypeast.mli"
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*      Thomas Gazagnaire (OCamlPro), Fabrice Le Fessant (INRIA Saclay)   *)
+(*                                                                        *)
+(*   Copyright 2007 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Parsetree
+
+val lident_of_path : Path.t -> Longident.t
+
+type mapper = {
+  attribute: mapper -> Typedtree.attribute -> attribute;
+  attributes: mapper -> Typedtree.attribute list -> attribute list;
+  case: mapper -> Typedtree.case -> case;
+  cases: mapper -> Typedtree.case list -> case list;
+  class_signature: mapper -> Typedtree.class_signature -> class_signature;
+  class_type: mapper -> Typedtree.class_type -> class_type;
+  class_type_declaration: mapper -> Typedtree.class_type_declaration
+                          -> class_type_declaration;
+  class_type_field: mapper -> Typedtree.class_type_field -> class_type_field;
+  constructor_declaration: mapper -> Typedtree.constructor_declaration
+                           -> constructor_declaration;
+  expr: mapper -> Typedtree.expression -> expression;
+  extension_constructor: mapper -> Typedtree.extension_constructor
+                         -> extension_constructor;
+  include_declaration:
+    mapper -> Typedtree.include_declaration -> include_declaration;
+  include_description:
+    mapper -> Typedtree.include_description -> include_description;
+  label_declaration:
+    mapper -> Typedtree.label_declaration -> label_declaration;
+  location: mapper -> Location.t -> Location.t;
+  module_binding: mapper -> Typedtree.module_binding -> module_binding;
+  module_declaration:
+    mapper -> Typedtree.module_declaration -> module_declaration;
+  module_expr: mapper -> Typedtree.module_expr -> module_expr;
+  module_type: mapper -> Typedtree.module_type -> module_type;
+  module_type_declaration:
+    mapper -> Typedtree.module_type_declaration -> module_type_declaration;
+  package_type: mapper -> Typedtree.package_type -> package_type;
+  open_description: mapper -> Typedtree.open_description -> open_description;
+  pat: mapper -> Typedtree.pattern -> pattern;
+  row_field: mapper -> Typedtree.row_field -> row_field;
+  object_field: mapper -> Typedtree.object_field -> object_field;
+  signature: mapper -> Typedtree.signature -> signature;
+  signature_item: mapper -> Typedtree.signature_item -> signature_item;
+  structure: mapper -> Typedtree.structure -> structure;
+  structure_item: mapper -> Typedtree.structure_item -> structure_item;
+  typ: mapper -> Typedtree.core_type -> core_type;
+  type_declaration: mapper -> Typedtree.type_declaration -> type_declaration;
+  type_extension: mapper -> Typedtree.type_extension -> type_extension;
+  type_kind: mapper -> Typedtree.type_kind -> type_kind;
+  value_binding: mapper -> Typedtree.value_binding -> value_binding;
+  value_description: mapper -> Typedtree.value_description -> value_description;
+  with_constraint:
+    mapper -> (Path.t * Longident.t Location.loc * Typedtree.with_constraint)
+    -> with_constraint;
+}
+
+val default_mapper : mapper
+
+val untype_structure : ?mapper:mapper -> Typedtree.structure -> structure
+val untype_signature : ?mapper:mapper -> Typedtree.signature -> signature
+
+val constant : Asttypes.constant -> Parsetree.constant
+
+end = struct
+#1 "untypeast.ml"
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*    Thomas Gazagnaire (OCamlPro), Fabrice Le Fessant (INRIA Saclay)     *)
+(*                                                                        *)
+(*   Copyright 2007 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Longident
+open Asttypes
+open Parsetree
+open Ast_helper
+
+module T = Typedtree
+
+type mapper = {
+  attribute: mapper -> T.attribute -> attribute;
+  attributes: mapper -> T.attribute list -> attribute list;
+  case: mapper -> T.case -> case;
+  cases: mapper -> T.case list -> case list;
+  class_signature: mapper -> T.class_signature -> class_signature;
+  class_type: mapper -> T.class_type -> class_type;
+  class_type_declaration: mapper -> T.class_type_declaration
+                          -> class_type_declaration;
+  class_type_field: mapper -> T.class_type_field -> class_type_field;
+  constructor_declaration: mapper -> T.constructor_declaration
+                           -> constructor_declaration;
+  expr: mapper -> T.expression -> expression;
+  extension_constructor: mapper -> T.extension_constructor
                          -> extension_constructor;
   include_declaration: mapper -> T.include_declaration -> include_declaration;
   include_description: mapper -> T.include_description -> include_description;
@@ -188636,7 +190164,7 @@ let is_cons = function
 
 let pretty_const c = match c with
 | Const_int i -> Printf.sprintf "%d" i
-| Const_char c -> Printf.sprintf "%C" c
+| Const_char i -> Printf.sprintf "%s" (Pprintast.string_of_int_as_char i)
 | Const_string (s, _) -> Printf.sprintf "%S" s
 | Const_float f -> Printf.sprintf "%s" f
 | Const_int32 i -> Printf.sprintf "%ldl" i
@@ -189294,7 +190822,7 @@ let build_other_constant proj make first next p env =
 
 let some_other_tag = "<some other tag>"
 
-let build_other ext env = match env with
+let build_other ext env : Typedtree.pattern = match env with
 | ({pat_desc = Tpat_construct (lid, {cstr_tag=Cstr_extension _},_)},_) :: _ ->
         (* let c = {c with cstr_name = "*extension*"} in *) (* PR#7330 *)
         make_pat (Tpat_var (Ident.create "*extension*",
@@ -189336,13 +190864,19 @@ let build_other ext env = match env with
             make_pat (Tpat_or (pat, p_res, None)) p.pat_type p.pat_env)
           pat other_pats
     end
-| ({pat_desc=(Tpat_constant (Const_int _ | Const_char _))} as p,_) :: _ ->
+| ({pat_desc=(Tpat_constant (Const_int _ ))} as p,_) :: _ ->
     build_other_constant
       (function Tpat_constant(Const_int i) -> i 
-      | Tpat_constant (Const_char i) -> Char.code i
       | _ -> assert false)
       (function i -> Tpat_constant(Const_int i))
       0 succ p env
+| ({pat_desc=(Tpat_constant (Const_char _ ))} as p,_) :: _ ->
+        build_other_constant
+          (function 
+          | Tpat_constant (Const_char i) -> i
+          | _ -> assert false)
+          (function i -> Tpat_constant(Const_char i))
+          0 succ p env      
 | ({pat_desc=(Tpat_constant (Const_int32 _))} as p,_) :: _ ->
     build_other_constant
       (function Tpat_constant(Const_int32 i) -> i | _ -> assert false)
@@ -190921,7 +192455,7 @@ open Lambda
 
 let rec struct_const ppf = function
   | Const_base(Const_int n) -> fprintf ppf "%i" n
-  | Const_base(Const_char c) -> fprintf ppf "%C" c
+  | Const_base(Const_char i) -> fprintf ppf "%s" (Pprintast.string_of_int_as_char i)
   | Const_base(Const_string (s, _)) -> fprintf ppf "%S" s
   | Const_immstring s -> fprintf ppf "#%S" s
   | Const_base(Const_float f) -> fprintf ppf "%s" f
@@ -202547,7 +204081,7 @@ let yyact = [|
     let _1 = (Parsing.peek_val __caml_parser_env 0 : char) in
     Obj.repr(
 # 2155 "ml/parser.mly"
-                 ( Pconst_char _1 )
+                 ( Pconst_char (Char.code _1) )
 # 11020 "ml/parser.ml"
                : 'constant))
 ; (fun __caml_parser_env ->
@@ -216349,7 +217883,7 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env
         else
           or_ ~loc:gloc
             (constant ~loc:gloc (Pconst_char c1))
-            (loop (Char.chr(Char.code c1 + 1)) c2)
+            (loop (c1 + 1) c2)
       in
       let p = if c1 <= c2 then loop c1 c2 else loop c2 c1 in
       let p = {p with ppat_loc=loc} in
@@ -221442,7 +222976,7 @@ let combine_constant names loc arg cst partial ctx def
         call_switcher loc fail arg min_int max_int int_lambda_list names
     | Const_char _ ->
         let int_lambda_list =
-          List.map (function Const_char c, l -> (Char.code c, l)
+          List.map (function Const_char c, l -> (c, l)
             | _ -> assert false)
             const_lambda_list in
         call_switcher loc fail arg 0 max_int int_lambda_list names
@@ -227051,7 +228585,7 @@ type t =
   | Open
   | True
   | False
-  | Codepoint of {c: char; original: string}
+  | Codepoint of {c: int; original: string}
   | Int of {i: string; suffix: char option}
   | Float of {f: string; suffix: char option}
   | String of string
@@ -228054,7 +229588,7 @@ let printConstant ?(templateLiteral = false) c =
   | Pconst_float (s, _) -> Doc.text s
   | Pconst_char c ->
     let str =
-      match c with
+      match Char.unsafe_chr c with
       | '\'' -> "\\'"
       | '\\' -> "\\\\"
       | '\n' -> "\\n"
@@ -228065,7 +229599,7 @@ let printConstant ?(templateLiteral = false) c =
         let s = (Bytes.create [@doesNotRaise]) 1 in
         Bytes.unsafe_set s 0 c;
         Bytes.unsafe_to_string s
-      | c -> Res_utf8.encodeCodePoint (Obj.magic c)
+      | _ -> Res_utf8.encodeCodePoint c
     in
     Doc.text ("'" ^ str ^ "'")
 
@@ -245750,7 +247284,7 @@ type t =
   | Const_js_true
   | Const_js_false
   | Const_int of { i : int32; comment : pointer_info }
-  | Const_char of char
+  | Const_char of int
   | Const_string of { s : string; unicode : bool }
   | Const_float of string
   | Const_int64 of int64
@@ -245813,7 +247347,7 @@ type t =
   | Const_js_true
   | Const_js_false
   | Const_int of { i : int32; comment : pointer_info }
-  | Const_char of char
+  | Const_char of int
   | Const_string of { s : string; unicode : bool }
   | Const_float of string
   | Const_int64 of int64
@@ -247858,7 +249392,7 @@ let prim ~primitive:(prim : Lam_primitive.t) ~args loc : t =
       | ( (Pstringrefs | Pstringrefu),
           Const_string { s = a; unicode = false },
           Const_int { i = b } ) -> (
-          try Lift.char (String.get a (Int32.to_int b)) with _ -> default ())
+          try Lift.char (Char.code (String.get a (Int32.to_int b))) with _ -> default ())
       | _ -> default ())
   | _ -> (
       match prim with
@@ -247929,7 +249463,7 @@ let rec complete_range (sw_consts : (int * _) list) ~(start : int) ~finish =
 let rec eval_const_as_bool (v : Lam_constant.t) : bool =
   match v with
   | Const_int { i = x } -> x <> 0l
-  | Const_char x -> Char.code x <> 0
+  | Const_char x -> x <> 0
   | Const_int64 x -> x <> 0L
   | Const_js_false | Const_js_null | Const_module_alias | Const_js_undefined ->
       false
@@ -253048,7 +254582,7 @@ val method_ :
 
 val econd : ?comment:string -> t -> t -> t -> t
 
-val int : ?comment:string -> ?c:char -> int32 -> t
+val int : ?comment:string -> ?c:int -> int32 -> t
 
 val uint32 : ?comment:string -> int32 -> t
 
@@ -255857,7 +257391,7 @@ and expression_desc cxt ~(level : int) f x : cxt =
         match v with
         | Float { f } -> Js_number.caml_float_literal_to_js_string f
         (* attach string here for float constant folding?*)
-        | Int { i; c = Some c } -> Format.asprintf "/* %C */%ld" c i
+        | Int { i; c = Some c } -> Format.asprintf "/* %s */%ld" (Ext_util.string_of_int_as_char c) i
         | Int { i; c = None } ->
             Int32.to_string i
             (* check , js convention with ocaml lexical convention *)
@@ -261685,7 +263219,7 @@ let rec struct_const ppf (cst : Lam_constant.t) =
   | Const_module_alias -> fprintf ppf "#alias"
   | Const_js_undefined -> fprintf ppf "#undefined"
   | Const_int { i } -> fprintf ppf "%ld" i
-  | Const_char c -> fprintf ppf "%C" c
+  | Const_char i -> fprintf ppf "%s" (Ext_util.string_of_int_as_char i)
   | Const_string { s } -> fprintf ppf "%S" s
   | Const_float f -> fprintf ppf "%s" f
   | Const_int64 n -> fprintf ppf "%LiL" n
@@ -264487,7 +266021,7 @@ val ref_byte : J.expression -> J.expression -> J.expression
 
 val set_byte : J.expression -> J.expression -> J.expression -> J.expression
 
-val const_char : char -> J.expression
+val const_char : int -> J.expression
 
 val bytes_to_string : J.expression -> J.expression
 
@@ -264524,7 +266058,7 @@ module E = Js_exp_make
     currently, it follows the same patten of ocaml, [char] is [int]
 *)
 
-let const_char (i : char) = E.int ~c:i (Int32.of_int @@ Char.code i)
+let const_char (i : int) = E.int ~c:i (Int32.of_int @@ i)
 
 (* string [s[i]] expects to return a [ocaml_char] *)
 let ref_string e e1 = E.string_index e e1
@@ -273729,7 +275263,7 @@ let lets_helper (count_var : Ident.t -> Lam_pass_count.used_info) lam : Lam.t =
           |Lconst((Const_int {i})) -> 
             let i = Int32.to_int i in
             if i < String.length l_s && i >= 0  then
-              Lam.const ((Const_char l_s.[i]))
+              Lam.const ((Const_char (Char.code l_s.[i])))
             else 
               Lam.prim ~primitive ~args:[l';r'] loc 
           | _ -> 
@@ -274334,1839 +275868,376 @@ let get_dependent_module_effect (maybe_pure : string option)
   else maybe_pure
 
 (* Note that
-   [lambda_exports] is
-   lambda expression to be exported
-   for the js backend, we compile to js
-   for the inliner, we try to seriaize it --
-   relies on other optimizations to make this happen
-   {[
-     exports.Make = function () {.....}
-   ]}
-   TODO: check that we don't do this in browser environment
-*)
-let export_to_cmj (meta : Lam_stats.t) effect export_map case : Js_cmj_format.t
-    =
-  let values = values_of_export meta export_map in
-
-  Js_cmj_format.make ~values ~effect
-    ~package_spec:(Js_packages_state.get_packages_info ())
-    ~case
-(* FIXME: make sure [-o] would not change its case
-   add test for ns/non-ns
-*)
-
-end
-module Lam_compile_main : sig 
-#1 "lam_compile_main.mli"
-(* Copyright (C) 2015 - 2016 Bloomberg Finance L.P.
- * Copyright (C) 2017 - Hongbo Zhang, Authors of ReScript 
- * This program is free software: you can redistribute it and/or modify
- * it under the terms of the GNU Lesser General Public License as published by
- * the Free Software Foundation, either version 3 of the License, or
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU Lesser General Public License for more details.
- * 
- * You should have received a copy of the GNU Lesser General Public License
- * along with this program; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
-
-(** ReScript entry point in the OCaml compiler *)
-
-(** Compile and register the hook of function to compile  a lambda to JS IR 
-*)
-
-val compile : string -> Ident.t list -> Lambda.lambda -> J.deps_program
-(** For toplevel, [filename] is [""] which is the same as
-    {!Env.get_unit_name ()}
-*)
-
-val lambda_as_module : J.deps_program -> string -> unit
-
-end = struct
-#1 "lam_compile_main.pp.ml"
-(* Copyright (C) 2015 - 2016 Bloomberg Finance L.P.
- * Copyright (C) 2017 - Hongbo Zhang, Authors of ReScript 
- * This program is free software: you can redistribute it and/or modify
- * it under the terms of the GNU Lesser General Public License as published by
- * the Free Software Foundation, either version 3 of the License, or
- * (at your option) any later version.
- *
- * In addition to the permissions granted to you by the LGPL, you may combine
- * or link a "work that uses the Library" with a publicly distributed version
- * of this file to produce a combined library or application, then distribute
- * that combined work under the terms of your choosing, with no requirement
- * to comply with the obligations normally placed on you by section 4 of the
- * LGPL version 3 (or the corresponding section of a later version of the LGPL
- * should you choose to use a later version).
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU Lesser General Public License for more details.
- * 
- * You should have received a copy of the GNU Lesser General Public License
- * along with this program; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
-
-
-
-
-
-
-
-
-(* module E = Js_exp_make  *)
-(* module S = Js_stmt_make   *)
-
-
-let compile_group (meta : Lam_stats.t) 
-    (x : Lam_group.t) : Js_output.t  = 
-  match x with 
-  (* 
-        We need
-
-        2. [E.builtin_dot] for javascript builtin
-        3. [E.mldot]
-     *)
-  (* ATTENTION: check {!Lam_compile_global} for consistency  *)      
-  (* Special handling for values in [Pervasives] *)  
-  (* 
-         we delegate [stdout, stderr, and stdin] into [caml_io] module, 
-         the motivation is to help dead code eliminatiion, it's helpful 
-         to make those parts pure (not a function call), then it can be removed 
-         if unused 
-      *)                     
-
-  (* QUICK hack to make hello world example nicer,
-     Note the arity of [print_endline] is already analyzed before, 
-     so it should be safe
-  *)
-
-  | Single (kind, id, lam) -> 
-    (* let lam = Optimizer.simplify_lets [] lam in  *)
-    (* can not apply again, it's wrong USE it with care*)
-    (* ([Js_stmt_make.comment (Gen_of_env.query_type id  env )], None)  ++ *)
-    Lam_compile.compile_lambda { continuation = Declare (kind, id);
-                                 jmp_table = Lam_compile_context.empty_handler_map;
-                                 meta
-                               } lam
-
-  | Recursive id_lams   -> 
-    Lam_compile.compile_recursive_lets 
-      { continuation = EffectCall Not_tail; 
-        jmp_table = Lam_compile_context.empty_handler_map;
-        meta
-      } 
-      id_lams
-  | Nop lam -> (* TODO: Side effect callls, log and see statistics *)
-    Lam_compile.compile_lambda {continuation = EffectCall Not_tail;
-                                jmp_table = Lam_compile_context.empty_handler_map;
-                                meta
-                               } lam
-
-;;
-
-(** Also need analyze its depenency is pure or not *)
-let no_side_effects (rest : Lam_group.t list) : string option = 
-  Ext_list.find_opt rest (fun x -> 
-      match x with 
-      | Single(kind,id,body) -> 
-        begin 
-          match kind with 
-          | Strict | Variable -> 
-            if not @@ Lam_analysis.no_side_effects body 
-            then Some  (Printf.sprintf "%s" id.name)
-            else None
-          | _ -> None
-        end
-      | Recursive bindings -> 
-        Ext_list.find_opt  bindings (fun (id,lam) -> 
-            if not @@ Lam_analysis.no_side_effects lam 
-            then Some (Printf.sprintf "%s" id.Ident.name )
-            else None
-          )
-      | Nop lam -> 
-        if not @@ Lam_analysis.no_side_effects lam 
-        then 
-          (*  (Lam_util.string_of_lambda lam) *)
-          Some ""
-        else None (* TODO :*))
-
-
-let _d  = fun  s lam -> 
-
-  lam
-
-let _j = Js_pass_debug.dump 
-
-(** Actually simplify_lets is kind of global optimization since it requires you to know whether 
-    it's used or not 
-*)
-let compile  
-    (output_prefix : string) 
-    export_idents
-    (lam : Lambda.lambda)  = 
-  let export_ident_sets = Set_ident.of_list export_idents in 
-  (* To make toplevel happy - reentrant for js-demo *)
-  let () = 
-      
-    Lam_compile_env.reset () ;
-  in 
-  let lam, may_required_modules = Lam_convert.convert export_ident_sets lam in 
-
-
-  let lam = _d "initial"  lam in
-  let lam  = Lam_pass_deep_flatten.deep_flatten lam in
-  let lam = _d  "flatten0" lam in
-  let meta  : Lam_stats.t = 
-    Lam_stats.make 
-      ~export_idents
-      ~export_ident_sets in 
-  let () = Lam_pass_collect.collect_info meta lam in 
-  let lam = 
-    let lam =  
-      lam
-      |> _d "flattern1"
-      |>  Lam_pass_exits.simplify_exits
-      |> _d "simplyf_exits"
-      |> (fun lam -> Lam_pass_collect.collect_info meta lam; 
-      
-      lam)
-      |>  Lam_pass_remove_alias.simplify_alias  meta
-      |> _d "simplify_alias"
-      |> Lam_pass_deep_flatten.deep_flatten
-      |> _d  "flatten2"
-    in  (* Inling happens*)
-
-    let ()  = Lam_pass_collect.collect_info meta lam in
-    let lam = Lam_pass_remove_alias.simplify_alias meta lam  in
-    let lam = Lam_pass_deep_flatten.deep_flatten lam in
-    let ()  = Lam_pass_collect.collect_info meta lam in
-    let lam = 
-      lam
-      |> _d "alpha_before"
-      |> Lam_pass_alpha_conversion.alpha_conversion meta
-      |> _d "alpha_after"
-      |> Lam_pass_exits.simplify_exits in    
-    let () = Lam_pass_collect.collect_info meta lam in
-
-
-    lam
-    |> _d "simplify_alias_before"
-    |>  Lam_pass_remove_alias.simplify_alias meta 
-    |> _d "alpha_conversion"
-    |>  Lam_pass_alpha_conversion.alpha_conversion meta
-    |> _d  "before-simplify_lets"
-    (* we should investigate a better way to put different passes : )*)
-    |> Lam_pass_lets_dce.simplify_lets 
-
-    |> _d "before-simplify-exits"
-    (* |> (fun lam -> Lam_pass_collect.collect_info meta lam 
-       ; Lam_pass_remove_alias.simplify_alias meta lam) *)
-    (* |> Lam_group_pass.scc_pass
-       |> _d "scc" *)
-    |> Lam_pass_exits.simplify_exits
-    |> _d "simplify_lets"
-    
-  in
-
-  let ({Lam_coercion.groups = groups } as coerced_input , meta) = 
-    Lam_coercion.coerce_and_group_big_lambda  meta lam
-  in 
-
-  
-let maybe_pure = no_side_effects groups in
-  
-let body  =     
-  Ext_list.map groups (fun group -> compile_group meta group)
-  |> Js_output.concat
-  |> Js_output.output_as_block
-in
-    
-(* The file is not big at all compared with [cmo] *)
-(* Ext_marshal.to_file (Ext_path.chop_extension filename ^ ".mj")  js; *)
-let meta_exports = meta.exports in 
-let export_set = Set_ident.of_list meta_exports in 
-let js : J.program = 
-  { 
-    exports = meta_exports ; 
-    export_set; 
-    block = body}
-in
-js 
-|> _j "initial"
-|> Js_pass_flatten.program
-|> _j "flattern"
-|> Js_pass_tailcall_inline.tailcall_inline
-|> _j "inline_and_shake"
-|> Js_pass_flatten_and_mark_dead.program
-|> _j "flatten_and_mark_dead"
-(* |> Js_inline_and_eliminate.inline_and_shake *)
-(* |> _j "inline_and_shake" *)
-|> (fun js -> ignore @@ Js_pass_scope.program  js ; js )
-|> Js_shake.shake_program
-|> _j "shake"
-|> ( fun (program:  J.program) -> 
-    let external_module_ids : Lam_module_ident.t list = 
-      if !Js_config.all_module_aliases then []
-      else
-        let hard_deps = 
-          Js_fold_basic.calculate_hard_dependencies program.block in  
-        Lam_compile_env.populate_required_modules  
-          may_required_modules hard_deps ;        
-        Ext_list.sort_via_array (Lam_module_ident.Hash_set.to_list hard_deps)
-          (fun id1 id2 ->
-             Ext_string.compare (Lam_module_ident.name id1) (Lam_module_ident.name id2)
-          ) 
-    in
-    Warnings.check_fatal();
-    let effect = 
-      Lam_stats_export.get_dependent_module_effect
-        maybe_pure external_module_ids in 
-    let v : Js_cmj_format.t = 
-      Lam_stats_export.export_to_cmj 
-        meta  
-        effect 
-        coerced_input.export_map          
-        (if Ext_char.is_lower_case (Filename.basename output_prefix).[0] then Little else Upper)
-    in
-    (if not !Clflags.dont_write_files then
-       Js_cmj_format.to_file 
-         ~check_exists:(not !Js_config.force_cmj)
-         (output_prefix ^ Literals.suffix_cmj) v);
-    {J.program = program ; side_effect = effect ; modules = external_module_ids }      
-  )
-;;
-
-let (//) = Filename.concat  
-
-let lambda_as_module 
-    (lambda_output : J.deps_program)
-    (output_prefix : string)
-  : unit = 
-  let package_info = Js_packages_state.get_packages_info () in 
-  if Js_packages_info.is_empty package_info && !Js_config.js_stdout then begin    
-    Js_dump_program.dump_deps_program ~output_prefix NodeJS lambda_output stdout
-  end else
-    Js_packages_info.iter package_info (fun {module_system; path; suffix} -> 
-        let output_chan chan  = 
-          Js_dump_program.dump_deps_program ~output_prefix
-            module_system 
-            lambda_output
-            chan in
-        let basename =  
-          Ext_namespace.change_ext_ns_suffix 
-            (Filename.basename
-               output_prefix) 
-            (Ext_js_suffix.to_string  suffix) 
-        in
-        let target_file = 
-          (Lazy.force Ext_path.package_dir //
-           path //
-           basename
-           (* #913 only generate little-case js file *)
-          ) in     
-        (if not !Clflags.dont_write_files then 
-           Ext_pervasives.with_file_as_chan
-             target_file output_chan );
-        if !Warnings.has_warnings  then begin 
-          Warnings.has_warnings := false ;
-          (* 5206: When there were warnings found during the compilation, we want the file
-             to be rebuilt on the next "rescript build" so that the warnings keep being shown.
-             Set the timestamp of the ast file to 1970-01-01 to make this rebuild happen.
-             (Do *not* set the timestamp of the JS output file instead
-             as that does not play well with every bundler.) *)
-          let ast_file = output_prefix ^ Literals.suffix_ast in
-          if Sys.file_exists ast_file then begin 
-            Bs_hash_stubs.set_as_old_file ast_file
-          end          
-          
-        end             
-      )
-
-
-
-(* We can use {!Env.current_unit = "Pervasives"} to tell if it is some specific module, 
-    We need handle some definitions in standard libraries in a special way, most are io specific, 
-    includes {!Pervasives.stdin, Pervasives.stdout, Pervasives.stderr}
-
-    However, use filename instead of {!Env.current_unit} is more honest, since node-js module system is coupled with the file name 
-*)
-
-end
-module Pprintast : sig 
-#1 "pprintast.mli"
-(**************************************************************************)
-(*                                                                        *)
-(*                                 OCaml                                  *)
-(*                                                                        *)
-(*             Hongbo Zhang (University of Pennsylvania)                  *)
-(*                                                                        *)
-(*   Copyright 1996 Institut National de Recherche en Informatique et     *)
-(*     en Automatique.                                                    *)
-(*                                                                        *)
-(*   All rights reserved.  This file is distributed under the terms of    *)
-(*   the GNU Lesser General Public License version 2.1, with the          *)
-(*   special exception on linking described in the file LICENSE.          *)
-(*                                                                        *)
-(**************************************************************************)
-
-type space_formatter = (unit, Format.formatter, unit) format
-
-
-val expression : Format.formatter -> Parsetree.expression -> unit
-val string_of_expression : Parsetree.expression -> string
-
-val core_type: Format.formatter -> Parsetree.core_type -> unit
-val pattern: Format.formatter -> Parsetree.pattern -> unit
-val signature: Format.formatter -> Parsetree.signature -> unit
-val structure: Format.formatter -> Parsetree.structure -> unit
-val string_of_structure: Parsetree.structure -> string
-
-end = struct
-#1 "pprintast.pp.ml"
-(**************************************************************************)
-(*                                                                        *)
-(*                                 OCaml                                  *)
-(*                                                                        *)
-(*                      Thomas Gazagnaire, OCamlPro                       *)
-(*                   Fabrice Le Fessant, INRIA Saclay                     *)
-(*               Hongbo Zhang, University of Pennsylvania                 *)
-(*                                                                        *)
-(*   Copyright 2007 Institut National de Recherche en Informatique et     *)
-(*     en Automatique.                                                    *)
-(*                                                                        *)
-(*   All rights reserved.  This file is distributed under the terms of    *)
-(*   the GNU Lesser General Public License version 2.1, with the          *)
-(*   special exception on linking described in the file LICENSE.          *)
-(*                                                                        *)
-(**************************************************************************)
-
-(* Original Code from Ber-metaocaml, modified for 3.12.0 and fixed *)
-(* Printing code expressions *)
-(* Authors:  Ed Pizzi, Fabrice Le Fessant *)
-(* Extensive Rewrite: Hongbo Zhang: University of Pennsylvania *)
-(* TODO more fine-grained precedence pretty-printing *)
-
-open Asttypes
-open Format
-open Location
-open Longident
-open Parsetree
-open Ast_helper
-
-let prefix_symbols  = [ '!'; '?'; '~' ] ;;
-let infix_symbols = [ '='; '<'; '>'; '@'; '^'; '|'; '&'; '+'; '-'; '*'; '/';
-                      '$'; '%'; '#' ]
-
-(* type fixity = Infix| Prefix  *)
-let special_infix_strings =
-  ["asr"; "land"; "lor"; "lsl"; "lsr"; "lxor"; "mod"; "or"; ":="; "!="; "::" ]
-
-(* determines if the string is an infix string.
-   checks backwards, first allowing a renaming postfix ("_102") which
-   may have resulted from Pexp -> Texp -> Pexp translation, then checking
-   if all the characters in the beginning of the string are valid infix
-   characters. *)
-let fixity_of_string  = function
-  | s when List.mem s special_infix_strings -> `Infix s
-  | s when List.mem s.[0] infix_symbols -> `Infix s
-  | s when List.mem s.[0] prefix_symbols -> `Prefix s
-  | s when s.[0] = '.' -> `Mixfix s
-  | _ -> `Normal
-
-let view_fixity_of_exp = function
-  | {pexp_desc = Pexp_ident {txt=Lident l;_}; pexp_attributes = []} ->
-      fixity_of_string l
-  | _ -> `Normal
-
-let is_infix  = function  | `Infix _ -> true | _  -> false
-let is_mixfix = function `Mixfix _ -> true | _ -> false
-
-(* which identifiers are in fact operators needing parentheses *)
-let needs_parens txt =
-  let fix = fixity_of_string txt in
-  is_infix fix
-  || is_mixfix fix
-  || List.mem txt.[0] prefix_symbols
-
-(* some infixes need spaces around parens to avoid clashes with comment
-   syntax *)
-let needs_spaces txt =
-  txt.[0]='*' || txt.[String.length txt - 1] = '*'
-
-(* add parentheses to binders when they are in fact infix or prefix operators *)
-let protect_ident ppf txt =
-  let format : (_, _, _) format =
-    if not (needs_parens txt) then "%s"
-    else if needs_spaces txt then "(@;%s@;)"
-    else "(%s)"
-  in fprintf ppf format txt
-
-let protect_longident ppf print_longident longprefix txt =
-  let format : (_, _, _) format =
-    if not (needs_parens txt) then "%a.%s"
-    else if needs_spaces txt then  "%a.(@;%s@;)"
-    else "%a.(%s)" in
-  fprintf ppf format print_longident longprefix txt
-
-type space_formatter = (unit, Format.formatter, unit) format
-
-let override = function
-  | Override -> "!"
-  | Fresh -> ""
-
-(* variance encoding: need to sync up with the [parser.mly] *)
-let type_variance = function
-  | Invariant -> ""
-  | Covariant -> "+"
-  | Contravariant -> "-"
-
-type construct =
-  [ `cons of expression list
-  | `list of expression list
-  | `nil
-  | `normal
-  | `simple of Longident.t
-  | `tuple ]
-
-let view_expr x =
-  match x.pexp_desc with
-  | Pexp_construct ( {txt= Lident "()"; _},_) -> `tuple
-  | Pexp_construct ( {txt= Lident "[]";_},_) -> `nil
-  | Pexp_construct ( {txt= Lident"::";_},Some _) ->
-      let rec loop exp acc = match exp with
-          | {pexp_desc=Pexp_construct ({txt=Lident "[]";_},_);
-             pexp_attributes = []} ->
-              (List.rev acc,true)
-          | {pexp_desc=
-             Pexp_construct ({txt=Lident "::";_},
-                             Some ({pexp_desc= Pexp_tuple([e1;e2]);
-                                    pexp_attributes = []}));
-             pexp_attributes = []}
-            ->
-              loop e2 (e1::acc)
-          | e -> (List.rev (e::acc),false) in
-      let (ls,b) = loop x []  in
-      if b then
-        `list ls
-      else `cons ls
-  | Pexp_construct (x,None) -> `simple (x.txt)
-  | _ -> `normal
-
-let is_simple_construct :construct -> bool = function
-  | `nil | `tuple | `list _ | `simple _  -> true
-  | `cons _ | `normal -> false
-
-let pp = fprintf
-
-type ctxt = {
-  pipe : bool;
-  semi : bool;
-  ifthenelse : bool;
-}
-
-let reset_ctxt = { pipe=false; semi=false; ifthenelse=false }
-let under_pipe ctxt = { ctxt with pipe=true }
-let under_semi ctxt = { ctxt with semi=true }
-let under_ifthenelse ctxt = { ctxt with ifthenelse=true }
-(*
-let reset_semi ctxt = { ctxt with semi=false }
-let reset_ifthenelse ctxt = { ctxt with ifthenelse=false }
-let reset_pipe ctxt = { ctxt with pipe=false }
-*)
-
-let list : 'a . ?sep:space_formatter -> ?first:space_formatter ->
-  ?last:space_formatter -> (Format.formatter -> 'a -> unit) ->
-  Format.formatter -> 'a list -> unit
-  = fun ?sep ?first ?last fu f xs ->
-    let first = match first with Some x -> x |None -> ("": _ format6)
-    and last = match last with Some x -> x |None -> ("": _ format6)
-    and sep = match sep with Some x -> x |None -> ("@ ": _ format6) in
-    let aux f = function
-      | [] -> ()
-      | [x] -> fu f x
-      | xs ->
-          let rec loop  f = function
-            | [x] -> fu f x
-            | x::xs ->  fu f x; pp f sep; loop f xs;
-            | _ -> assert false in begin
-            pp f first; loop f xs; pp f last;
-          end in
-    aux f xs
-
-let option : 'a. ?first:space_formatter -> ?last:space_formatter ->
-  (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a option -> unit
-  = fun  ?first  ?last fu f a ->
-    let first = match first with Some x -> x | None -> ("": _ format6)
-    and last = match last with Some x -> x | None -> ("": _ format6) in
-    match a with
-    | None -> ()
-    | Some x -> pp f first; fu f x; pp f last
-
-let paren: 'a . ?first:space_formatter -> ?last:space_formatter ->
-  bool -> (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a -> unit
-  = fun  ?(first=("": _ format6)) ?(last=("": _ format6)) b fu f x ->
-    if b then (pp f "("; pp f first; fu f x; pp f last; pp f ")")
-    else fu f x
-
-let rec longident f = function
-  | Lident s -> protect_ident f s
-  | Ldot(y,s) -> protect_longident f longident y s
-  | Lapply (y,s) ->
-      pp f "%a(%a)" longident y longident s
-
-let longident_loc f x = pp f "%a" longident x.txt
-
-let constant f = function
-  | Pconst_char i -> pp f "%C"  i
-  | Pconst_string (i, None) -> pp f "%S" i
-  | Pconst_string (i, Some delim) -> pp f "{%s|%s|%s}" delim i delim
-  | Pconst_integer (i, None) -> paren (i.[0]='-') (fun f -> pp f "%s") f i
-  | Pconst_integer (i, Some m) ->
-    paren (i.[0]='-') (fun f (i, m) -> pp f "%s%c" i m) f (i,m)
-  | Pconst_float (i, None) -> paren (i.[0]='-') (fun f -> pp f "%s") f i
-  | Pconst_float (i, Some m) -> paren (i.[0]='-') (fun f (i,m) ->
-      pp f "%s%c" i m) f (i,m)
-
-(* trailing space*)
-let mutable_flag f = function
-  | Immutable -> ()
-  | Mutable -> pp f "mutable@;"
-let virtual_flag f  = function
-  | Concrete -> ()
-  | Virtual -> pp f "virtual@;"
-
-(* trailing space added *)
-let rec_flag f rf =
-  match rf with
-  | Nonrecursive -> ()
-  | Recursive -> pp f "rec "
-let nonrec_flag f rf =
-  match rf with
-  | Nonrecursive -> pp f "nonrec "
-  | Recursive -> ()
-let direction_flag f = function
-  | Upto -> pp f "to@ "
-  | Downto -> pp f "downto@ "
-let private_flag f = function
-  | Public -> ()
-  | Private -> pp f "private@ "
-
-let constant_string f s = pp f "%S" s
-let tyvar f str = pp f "'%s" str
-let tyvar_loc f str = pp f "'%s" str.txt
-let string_quot f x = pp f "`%s" x
-
-(* c ['a,'b] *)
-let rec class_params_def ctxt f =  function
-  | [] -> ()
-  | l ->
-      pp f "[%a] " (* space *)
-        (list (type_param ctxt) ~sep:",") l
-
-and type_with_label ctxt f (label, c) =
-  match label with
-  | Nolabel    -> core_type1 ctxt f c (* otherwise parenthesize *)
-  | Labelled s -> pp f "%s:%a" s (core_type1 ctxt) c
-  | Optional s -> pp f "?%s:%a" s (core_type1 ctxt) c
-
-and core_type ctxt f x =
-  if x.ptyp_attributes <> [] then begin
-    pp f "((%a)%a)" (core_type ctxt) {x with ptyp_attributes=[]}
-      (attributes ctxt) x.ptyp_attributes
-  end
-  else match x.ptyp_desc with
-    | Ptyp_arrow (l, ct1, ct2) ->
-        pp f "@[<2>%a@;->@;%a@]" (* FIXME remove parens later *)
-          (type_with_label ctxt) (l,ct1) (core_type ctxt) ct2
-    | Ptyp_alias (ct, s) ->
-        pp f "@[<2>%a@;as@;'%s@]" (core_type1 ctxt) ct s
-    | Ptyp_poly ([], ct) ->
-        core_type ctxt f ct
-    | Ptyp_poly (sl, ct) ->
-        pp f "@[<2>%a%a@]"
-          (fun f l ->
-             pp f "%a"
-               (fun f l -> match l with
-                  | [] -> ()
-                  | _ ->
-                      pp f "%a@;.@;"
-                        (list tyvar_loc ~sep:"@;")  l)
-               l)
-          sl (core_type ctxt) ct
-    | _ -> pp f "@[<2>%a@]" (core_type1 ctxt) x
-
-and core_type1 ctxt f x =
-  if x.ptyp_attributes <> [] then core_type ctxt f x
-  else match x.ptyp_desc with
-    | Ptyp_any -> pp f "_";
-    | Ptyp_var s -> tyvar f  s;
-    | Ptyp_tuple l ->  pp f "(%a)" (list (core_type1 ctxt) ~sep:"@;*@;") l
-    | Ptyp_constr (li, l) ->
-        pp f (* "%a%a@;" *) "%a%a"
-          (fun f l -> match l with
-             |[] -> ()
-             |[x]-> pp f "%a@;" (core_type1 ctxt)  x
-             | _ -> list ~first:"(" ~last:")@;" (core_type ctxt) ~sep:",@;" f l)
-          l longident_loc li
-    | Ptyp_variant (l, closed, low) ->
-        let type_variant_helper f x =
-          match x with
-          | Rtag (l, attrs, _, ctl) ->
-              pp f "@[<2>%a%a@;%a@]" string_quot l.txt
-                (fun f l -> match l with
-                   |[] -> ()
-                   | _ -> pp f "@;of@;%a"
-                            (list (core_type ctxt) ~sep:"&")  ctl) ctl
-                (attributes ctxt) attrs
-          | Rinherit ct -> core_type ctxt f ct in
-        pp f "@[<2>[%a%a]@]"
-          (fun f l ->
-             match l, closed with
-             | [], Closed -> ()
-             | [], Open -> pp f ">" (* Cf #7200: print [>] correctly *)
-             | _ ->
-                 pp f "%s@;%a"
-                   (match (closed,low) with
-                    | (Closed,None) -> ""
-                    | (Closed,Some _) -> "<" (* FIXME desugar the syntax sugar*)
-                    | (Open,_) -> ">")
-                   (list type_variant_helper ~sep:"@;<1 -2>| ") l) l
-          (fun f low -> match low with
-             |Some [] |None -> ()
-             |Some xs ->
-                 pp f ">@ %a"
-                   (list string_quot) xs) low
-    | Ptyp_object (l, o) ->
-        let core_field_type f = function
-          | Otag (l, attrs, ct) ->
-            pp f "@[<hov2>%s: %a@ %a@ @]" l.txt
-              (core_type ctxt) ct (attributes ctxt) attrs (* Cf #7200 *)
-          | Oinherit ct ->
-            pp f "@[<hov2>%a@ @]" (core_type ctxt) ct
-        in
-        let field_var f = function
-          | Asttypes.Closed -> ()
-          | Asttypes.Open ->
-              match l with
-              | [] -> pp f ".."
-              | _ -> pp f " ;.."
-        in
-        pp f "@[<hov2><@ %a%a@ > @]" (list core_field_type ~sep:";") l
-          field_var o (* Cf #7200 *)
-    | Ptyp_class (li, l) ->   (*FIXME*)
-        pp f "@[<hov2>%a#%a@]"
-          (list (core_type ctxt) ~sep:"," ~first:"(" ~last:")") l
-          longident_loc li
-    | Ptyp_package (lid, cstrs) ->
-        let aux f (s, ct) =
-          pp f "type %a@ =@ %a" longident_loc s (core_type ctxt) ct  in
-        (match cstrs with
-         |[] -> pp f "@[<hov2>(module@ %a)@]" longident_loc lid
-         |_ ->
-             pp f "@[<hov2>(module@ %a@ with@ %a)@]" longident_loc lid
-               (list aux  ~sep:"@ and@ ")  cstrs)
-    | Ptyp_extension e -> extension ctxt f e
-    | _ -> paren true (core_type ctxt) f x
-
-(********************pattern********************)
-(* be cautious when use [pattern], [pattern1] is preferred *)
-and pattern ctxt f x =
-  let rec list_of_pattern acc = function (* only consider ((A|B)|C)*)
-    | {ppat_desc= Ppat_or (p1,p2); ppat_attributes = []} ->
-        list_of_pattern  (p2::acc) p1
-    | x -> x::acc
-  in
-  if x.ppat_attributes <> [] then begin
-    pp f "((%a)%a)" (pattern ctxt) {x with ppat_attributes=[]}
-      (attributes ctxt) x.ppat_attributes
-  end
-  else match x.ppat_desc with
-    | Ppat_alias (p, s) ->
-        pp f "@[<2>%a@;as@;%a@]" (pattern ctxt) p protect_ident s.txt (* RA*)
-    | Ppat_or _ -> (* *)
-        pp f "@[<hov0>%a@]" (list ~sep:"@,|" (pattern ctxt))
-          (list_of_pattern [] x)
-    | _ -> pattern1 ctxt f x
-
-and pattern1 ctxt (f:Format.formatter) (x:pattern) : unit =
-  let rec pattern_list_helper f = function
-    | {ppat_desc =
-         Ppat_construct
-           ({ txt = Lident("::") ;_},
-            Some ({ppat_desc = Ppat_tuple([pat1; pat2]);_}));
-       ppat_attributes = []}
-
-      ->
-        pp f "%a::%a" (simple_pattern ctxt) pat1 pattern_list_helper pat2 (*RA*)
-    | p -> pattern1 ctxt f p
-  in
-  if x.ppat_attributes <> [] then pattern ctxt f x
-  else match x.ppat_desc with
-    | Ppat_variant (l, Some p) ->
-        pp f "@[<2>`%s@;%a@]" l (simple_pattern ctxt) p
-    | Ppat_construct (({txt=Lident("()"|"[]");_}), _) -> simple_pattern ctxt f x
-    | Ppat_construct (({txt;_} as li), po) ->
-        (* FIXME The third field always false *)
-        if txt = Lident "::" then
-          pp f "%a" pattern_list_helper x
-        else
-          (match po with
-           | Some x -> pp f "%a@;%a"  longident_loc li (simple_pattern ctxt) x
-           | None -> pp f "%a" longident_loc li)
-    | _ -> simple_pattern ctxt f x
-
-and simple_pattern ctxt (f:Format.formatter) (x:pattern) : unit =
-  if x.ppat_attributes <> [] then pattern ctxt f x
-  else match x.ppat_desc with
-    | Ppat_construct (({txt=Lident ("()"|"[]" as x);_}), _) -> pp f  "%s" x
-    | Ppat_any -> pp f "_";
-    | Ppat_var ({txt = txt;_}) -> protect_ident f txt
-    | Ppat_array l ->
-        pp f "@[<2>[|%a|]@]"  (list (pattern1 ctxt) ~sep:";") l
-    | Ppat_unpack (s) ->
-        pp f "(module@ %s)@ " s.txt
-    | Ppat_type li ->
-        pp f "#%a" longident_loc li
-    | Ppat_record (l, closed) ->
-        let longident_x_pattern f (li, p) =
-          match (li,p) with
-          | ({txt=Lident s;_ },
-             {ppat_desc=Ppat_var {txt;_};
-              ppat_attributes=[]; _})
-            when s = txt ->
-              pp f "@[<2>%a@]"  longident_loc li
-          | _ ->
-              pp f "@[<2>%a@;=@;%a@]" longident_loc li (pattern1 ctxt) p
-        in
-        begin match closed with
-        | Closed ->
-            pp f "@[<2>{@;%a@;}@]" (list longident_x_pattern ~sep:";@;") l
-        | _ ->
-            pp f "@[<2>{@;%a;_}@]" (list longident_x_pattern ~sep:";@;") l
-        end
-    | Ppat_tuple l ->
-        pp f "@[<1>(%a)@]" (list  ~sep:",@;" (pattern1 ctxt))  l (* level1*)
-    | Ppat_constant (c) -> pp f "%a" constant c
-    | Ppat_interval (c1, c2) -> pp f "%a..%a" constant c1 constant c2
-    | Ppat_variant (l,None) ->  pp f "`%s" l
-    | Ppat_constraint (p, ct) ->
-        pp f "@[<2>(%a@;:@;%a)@]" (pattern1 ctxt) p (core_type ctxt) ct
-    | Ppat_lazy p ->
-        pp f "@[<2>(lazy@;%a)@]" (pattern1 ctxt) p
-    | Ppat_exception p ->
-        pp f "@[<2>exception@;%a@]" (pattern1 ctxt) p
-    | Ppat_extension e -> extension ctxt f e
-    | Ppat_open (lid, p) ->
-        let with_paren =
-        match p.ppat_desc with
-        | Ppat_array _ | Ppat_record _
-        | Ppat_construct (({txt=Lident ("()"|"[]");_}), _) -> false
-        | _ -> true in
-        pp f "@[<2>%a.%a @]" longident_loc lid
-          (paren with_paren @@ pattern1 ctxt) p
-    | _ -> paren true (pattern ctxt) f x
-
-and label_exp ctxt f (l,opt,p) =
-  match l with
-  | Nolabel ->
-      (* single case pattern parens needed here *)
-      pp f "%a@ " (simple_pattern ctxt) p
-  | Optional rest ->
-      begin match p with
-      | {ppat_desc = Ppat_var {txt;_}; ppat_attributes = []}
-        when txt = rest ->
-          (match opt with
-           | Some o -> pp f "?(%s=@;%a)@;" rest  (expression ctxt) o
-           | None -> pp f "?%s@ " rest)
-      | _ ->
-          (match opt with
-           | Some o ->
-               pp f "?%s:(%a=@;%a)@;"
-                 rest (pattern1 ctxt) p (expression ctxt) o
-           | None -> pp f "?%s:%a@;" rest (simple_pattern ctxt) p)
-      end
-  | Labelled l -> match p with
-    | {ppat_desc  = Ppat_var {txt;_}; ppat_attributes = []}
-      when txt = l ->
-        pp f "~%s@;" l
-    | _ ->  pp f "~%s:%a@;" l (simple_pattern ctxt) p
-
-and sugar_expr ctxt f e =
-  if e.pexp_attributes <> [] then false
-  else match e.pexp_desc with
-  | Pexp_apply ({ pexp_desc = Pexp_ident {txt = id; _};
-                  pexp_attributes=[]; _}, args)
-    when List.for_all (fun (lab, _) -> lab = Nolabel) args -> begin
-      let print_indexop a path_prefix assign left right print_index indices
-          rem_args =
-        let print_path ppf = function
-          | None -> ()
-          | Some m -> pp ppf ".%a" longident m in
-        match assign, rem_args with
-            | false, [] ->
-              pp f "@[%a%a%s%a%s@]"
-                (simple_expr ctxt) a print_path path_prefix
-                left (list ~sep:"," print_index) indices right; true
-            | true, [v] ->
-              pp f "@[%a%a%s%a%s@ <-@;<1 2>%a@]"
-                (simple_expr ctxt) a print_path path_prefix
-                left (list ~sep:"," print_index) indices right
-                (simple_expr ctxt) v; true
-            | _ -> false in
-      match id, List.map snd args with
-      | Lident "!", [e] ->
-        pp f "@[<hov>!%a@]" (simple_expr ctxt) e; true
-      | Ldot (path, ("get"|"set" as func)), a :: other_args -> begin
-          let assign = func = "set" in
-          let print = print_indexop a None assign in
-          match path, other_args with
-          | Lident "Array", i :: rest ->
-            print ".(" ")" (expression ctxt) [i] rest
-          | Lident "String", i :: rest ->
-            print ".[" "]" (expression ctxt) [i] rest
-          | Ldot (Lident "Bigarray", "Array1"), i1 :: rest ->
-            print ".{" "}" (simple_expr ctxt) [i1] rest
-          | Ldot (Lident "Bigarray", "Array2"), i1 :: i2 :: rest ->
-            print ".{" "}" (simple_expr ctxt) [i1; i2] rest
-          | Ldot (Lident "Bigarray", "Array3"), i1 :: i2 :: i3 :: rest ->
-            print ".{" "}" (simple_expr ctxt) [i1; i2; i3] rest
-          | Ldot (Lident "Bigarray", "Genarray"),
-            {pexp_desc = Pexp_array indexes; pexp_attributes = []} :: rest ->
-              print ".{" "}" (simple_expr ctxt) indexes rest
-          | _ -> false
-        end
-      | (Lident s | Ldot(_,s)) , a :: i :: rest
-        when s.[0] = '.' ->
-          let n = String.length s in
-          (* extract operator:
-             assignment operators end with [right_bracket ^ "<-"],
-             access operators end with [right_bracket] directly
-          *)
-          let assign = s.[n - 1] = '-'  in
-          let kind =
-            (* extract the right end bracket *)
-            if assign then s.[n - 3] else s.[n - 1] in
-          let left, right = match kind with
-            | ')' -> '(', ")"
-            | ']' -> '[', "]"
-            | '}' -> '{', "}"
-            | _ -> assert false in
-          let path_prefix = match id with
-            | Ldot(m,_) -> Some m
-            | _ -> None in
-          let left = String.sub s 0 (1+String.index s left) in
-          print_indexop a path_prefix assign left right
-            (expression ctxt) [i] rest
-      | _ -> false
-    end
-  | _ -> false
-
-and expression ctxt f x =
-  if x.pexp_attributes <> [] then
-    pp f "((%a)@,%a)" (expression ctxt) {x with pexp_attributes=[]}
-      (attributes ctxt) x.pexp_attributes
-  else match x.pexp_desc with
-    | Pexp_function _ | Pexp_fun _ | Pexp_match _ | Pexp_try _ | Pexp_sequence _
-      when ctxt.pipe || ctxt.semi ->
-        paren true (expression reset_ctxt) f x
-    | Pexp_ifthenelse _ | Pexp_sequence _ when ctxt.ifthenelse ->
-        paren true (expression reset_ctxt) f x
-    | Pexp_let _ | Pexp_letmodule _ | Pexp_open _ | Pexp_letexception _
-        when ctxt.semi ->
-        paren true (expression reset_ctxt) f x
-    | Pexp_fun (l, e0, p, e) ->
-        pp f "@[<2>fun@;%a->@;%a@]"
-          (label_exp ctxt) (l, e0, p)
-          (expression ctxt) e
-    | Pexp_function l ->
-        pp f "@[<hv>function%a@]" (case_list ctxt) l
-    | Pexp_match (e, l) ->
-        pp f "@[<hv0>@[<hv0>@[<2>match %a@]@ with@]%a@]"
-          (expression reset_ctxt) e (case_list ctxt) l
-
-    | Pexp_try (e, l) ->
-        pp f "@[<0>@[<hv2>try@ %a@]@ @[<0>with%a@]@]"
-             (* "try@;@[<2>%a@]@\nwith@\n%a"*)
-          (expression reset_ctxt) e  (case_list ctxt) l
-    | Pexp_let (rf, l, e) ->
-        (* pp f "@[<2>let %a%a in@;<1 -2>%a@]"
-           (*no indentation here, a new line*) *)
-        (*   rec_flag rf *)
-        pp f "@[<2>%a in@;<1 -2>%a@]"
-          (bindings reset_ctxt) (rf,l)
-          (expression ctxt) e
-    | Pexp_apply (e, l) ->
-        begin if not (sugar_expr ctxt f x) then
-            match view_fixity_of_exp e with
-            | `Infix s ->
-                begin match l with
-                | [ (Nolabel, _) as arg1; (Nolabel, _) as arg2 ] ->
-                    (* FIXME associativity label_x_expression_param *)
-                    pp f "@[<2>%a@;%s@;%a@]"
-                      (label_x_expression_param reset_ctxt) arg1 s
-                      (label_x_expression_param ctxt) arg2
-                | _ ->
-                    pp f "@[<2>%a %a@]"
-                      (simple_expr ctxt) e
-                      (list (label_x_expression_param ctxt)) l
-                end
-            | `Prefix s ->
-                let s =
-                  if List.mem s ["~+";"~-";"~+.";"~-."] &&
-                   (match l with
-                    (* See #7200: avoid turning (~- 1) into (- 1) which is
-                       parsed as an int literal *)
-                    |[(_,{pexp_desc=Pexp_constant _})] -> false
-                    | _ -> true)
-                  then String.sub s 1 (String.length s -1)
-                  else s in
-                begin match l with
-                | [(Nolabel, x)] ->
-                  pp f "@[<2>%s@;%a@]" s (simple_expr ctxt) x
-                | _   ->
-                  pp f "@[<2>%a %a@]" (simple_expr ctxt) e
-                    (list (label_x_expression_param ctxt)) l
-                end
-            | _ ->
-                pp f "@[<hov2>%a@]" begin fun f (e,l) ->
-                  pp f "%a@ %a" (expression2 ctxt) e
-                    (list (label_x_expression_param reset_ctxt))  l
-                    (* reset here only because [function,match,try,sequence]
-                       are lower priority *)
-                end (e,l)
-        end
-
-    | Pexp_construct (li, Some eo)
-      when not (is_simple_construct (view_expr x))-> (* Not efficient FIXME*)
-        (match view_expr x with
-         | `cons ls -> list (simple_expr ctxt) f ls ~sep:"@;::@;"
-         | `normal ->
-             pp f "@[<2>%a@;%a@]" longident_loc li
-               (simple_expr ctxt) eo
-         | _ -> assert false)
-    | Pexp_setfield (e1, li, e2) ->
-        pp f "@[<2>%a.%a@ <-@ %a@]"
-          (simple_expr ctxt) e1 longident_loc li (simple_expr ctxt) e2
-    | Pexp_ifthenelse (e1, e2, eo) ->
-        (* @;@[<2>else@ %a@]@] *)
-        let fmt:(_,_,_)format ="@[<hv0>@[<2>if@ %a@]@;@[<2>then@ %a@]%a@]" in
-        let expression_under_ifthenelse = expression (under_ifthenelse ctxt) in
-        pp f fmt expression_under_ifthenelse e1 expression_under_ifthenelse e2
-          (fun f eo -> match eo with
-             | Some x ->
-                 pp f "@;@[<2>else@;%a@]" (expression (under_semi ctxt)) x
-             | None -> () (* pp f "()" *)) eo
-    | Pexp_sequence _ ->
-        let rec sequence_helper acc = function
-          | {pexp_desc=Pexp_sequence(e1,e2); pexp_attributes = []} ->
-              sequence_helper (e1::acc) e2
-          | v -> List.rev (v::acc) in
-        let lst = sequence_helper [] x in
-        pp f "@[<hv>%a@]"
-          (list (expression (under_semi ctxt)) ~sep:";@;") lst
-    | Pexp_new (li) ->
-        pp f "@[<hov2>new@ %a@]" longident_loc li;
-    | Pexp_setinstvar (s, e) ->
-        pp f "@[<hov2>%s@ <-@ %a@]" s.txt (expression ctxt) e
-    | Pexp_override l -> (* FIXME *)
-        let string_x_expression f (s, e) =
-          pp f "@[<hov2>%s@ =@ %a@]" s.txt (expression ctxt) e in
-        pp f "@[<hov2>{<%a>}@]"
-          (list string_x_expression  ~sep:";"  )  l;
-    | Pexp_letmodule (s, me, e) ->
-        pp f "@[<hov2>let@ module@ %s@ =@ %a@ in@ %a@]" s.txt
-          (module_expr reset_ctxt) me (expression ctxt) e
-    | Pexp_letexception (cd, e) ->
-        pp f "@[<hov2>let@ exception@ %a@ in@ %a@]"
-          (extension_constructor ctxt) cd
-          (expression ctxt) e
-    | Pexp_assert e ->
-        pp f "@[<hov2>assert@ %a@]" (simple_expr ctxt) e
-    | Pexp_lazy (e) ->
-        pp f "@[<hov2>lazy@ %a@]" (simple_expr ctxt) e
-    (* Pexp_poly: impossible but we should print it anyway, rather than
-       assert false *)
-    | Pexp_poly (e, None) ->
-        pp f "@[<hov2>!poly!@ %a@]" (simple_expr ctxt) e
-    | Pexp_poly (e, Some ct) ->
-        pp f "@[<hov2>(!poly!@ %a@ : %a)@]"
-          (simple_expr ctxt) e (core_type ctxt) ct
-    | Pexp_open (ovf, lid, e) ->
-        pp f "@[<2>let open%s %a in@;%a@]" (override ovf) longident_loc lid
-          (expression ctxt) e
-    | Pexp_variant (l,Some eo) ->
-        pp f "@[<2>`%s@;%a@]" l (simple_expr ctxt) eo
-    | Pexp_extension e -> extension ctxt f e
-    | Pexp_unreachable -> pp f "."
-    | _ -> expression1 ctxt f x
-
-and expression1 ctxt f x =
-  if x.pexp_attributes <> [] then expression ctxt f x
-  else match x.pexp_desc with
-    | Pexp_object cs -> pp f "%a" (class_structure ctxt) cs
-    | _ -> expression2 ctxt f x
-(* used in [Pexp_apply] *)
-
-and expression2 ctxt f x =
-  if x.pexp_attributes <> [] then expression ctxt f x
-  else match x.pexp_desc with
-    | Pexp_field (e, li) ->
-        pp f "@[<hov2>%a.%a@]" (simple_expr ctxt) e longident_loc li
-    | Pexp_send (e, s) -> pp f "@[<hov2>%a#%s@]" (simple_expr ctxt) e s.txt
-
-    | _ -> simple_expr ctxt f x
+   [lambda_exports] is
+   lambda expression to be exported
+   for the js backend, we compile to js
+   for the inliner, we try to seriaize it --
+   relies on other optimizations to make this happen
+   {[
+     exports.Make = function () {.....}
+   ]}
+   TODO: check that we don't do this in browser environment
+*)
+let export_to_cmj (meta : Lam_stats.t) effect export_map case : Js_cmj_format.t
+    =
+  let values = values_of_export meta export_map in
 
-and simple_expr ctxt f x =
-  if x.pexp_attributes <> [] then expression ctxt f x
-  else match x.pexp_desc with
-    | Pexp_construct _  when is_simple_construct (view_expr x) ->
-        (match view_expr x with
-         | `nil -> pp f "[]"
-         | `tuple -> pp f "()"
-         | `list xs ->
-             pp f "@[<hv0>[%a]@]"
-               (list (expression (under_semi ctxt)) ~sep:";@;") xs
-         | `simple x -> longident f x
-         | _ -> assert false)
-    | Pexp_ident li ->
-        longident_loc f li
-    (* (match view_fixity_of_exp x with *)
-    (* |`Normal -> longident_loc f li *)
-    (* | `Prefix _ | `Infix _ -> pp f "( %a )" longident_loc li) *)
-    | Pexp_constant c -> constant f c;
-    | Pexp_pack me ->
-        pp f "(module@;%a)" (module_expr ctxt) me
-    | Pexp_newtype (lid, e) ->
-        pp f "fun@;(type@;%s)@;->@;%a" lid.txt (expression ctxt) e
-    | Pexp_tuple l ->
-        pp f "@[<hov2>(%a)@]" (list (simple_expr ctxt) ~sep:",@;") l
-    | Pexp_constraint (e, ct) ->
-        pp f "(%a : %a)" (expression ctxt) e (core_type ctxt) ct
-    | Pexp_coerce (e, cto1, ct) ->
-        pp f "(%a%a :> %a)" (expression ctxt) e
-          (option (core_type ctxt) ~first:" : " ~last:" ") cto1 (* no sep hint*)
-          (core_type ctxt) ct
-    | Pexp_variant (l, None) -> pp f "`%s" l
-    | Pexp_record (l, eo) ->
-        let longident_x_expression f ( li, e) =
-          match e with
-          |  {pexp_desc=Pexp_ident {txt;_};
-              pexp_attributes=[]; _} when li.txt = txt ->
-              pp f "@[<hov2>%a@]" longident_loc li
-          | _ ->
-              pp f "@[<hov2>%a@;=@;%a@]" longident_loc li (simple_expr ctxt) e
-        in
-        pp f "@[<hv0>@[<hv2>{@;%a%a@]@;}@]"(* "@[<hov2>{%a%a}@]" *)
-          (option ~last:" with@;" (simple_expr ctxt)) eo
-          (list longident_x_expression ~sep:";@;") l
-    | Pexp_array (l) ->
-        pp f "@[<0>@[<2>[|%a|]@]@]"
-          (list (simple_expr (under_semi ctxt)) ~sep:";") l
-    | Pexp_while (e1, e2) ->
-        let fmt : (_,_,_) format = "@[<2>while@;%a@;do@;%a@;done@]" in
-        pp f fmt (expression ctxt) e1 (expression ctxt) e2
-    | Pexp_for (s, e1, e2, df, e3) ->
-        let fmt:(_,_,_)format =
-          "@[<hv0>@[<hv2>@[<2>for %a =@;%a@;%a%a@;do@]@;%a@]@;done@]" in
-        let expression = expression ctxt in
-        pp f fmt (pattern ctxt) s expression e1 direction_flag
-          df expression e2 expression e3
-    | _ ->  paren true (expression ctxt) f x
+  Js_cmj_format.make ~values ~effect
+    ~package_spec:(Js_packages_state.get_packages_info ())
+    ~case
+(* FIXME: make sure [-o] would not change its case
+   add test for ns/non-ns
+*)
 
-and attributes ctxt f l =
-  List.iter (attribute ctxt f) l
+end
+module Lam_compile_main : sig 
+#1 "lam_compile_main.mli"
+(* Copyright (C) 2015 - 2016 Bloomberg Finance L.P.
+ * Copyright (C) 2017 - Hongbo Zhang, Authors of ReScript 
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ * 
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
-and item_attributes ctxt f l =
-  List.iter (item_attribute ctxt f) l
+(** ReScript entry point in the OCaml compiler *)
 
-and attribute ctxt f (s, e) =
-  pp f "@[<2>[@@%s@ %a]@]" s.txt (payload ctxt) e
+(** Compile and register the hook of function to compile  a lambda to JS IR 
+*)
 
-and item_attribute ctxt f (s, e) =
-  pp f "@[<2>[@@@@%s@ %a]@]" s.txt (payload ctxt) e
+val compile : string -> Ident.t list -> Lambda.lambda -> J.deps_program
+(** For toplevel, [filename] is [""] which is the same as
+    {!Env.get_unit_name ()}
+*)
 
-and floating_attribute ctxt f (s, e) =
-  pp f "@[<2>[@@@@@@%s@ %a]@]" s.txt (payload ctxt) e
+val lambda_as_module : J.deps_program -> string -> unit
 
-and value_description ctxt f x =
-  (* note: value_description has an attribute field,
-           but they're already printed by the callers this method *)
-  pp f "@[<hov2>%a%a@]" (core_type ctxt) x.pval_type
-    (fun f x ->
-        
-       if x.pval_prim <> []
-       then pp f "@ =@ %a" (list constant_string) x.pval_prim
+end = struct
+#1 "lam_compile_main.pp.ml"
+(* Copyright (C) 2015 - 2016 Bloomberg Finance L.P.
+ * Copyright (C) 2017 - Hongbo Zhang, Authors of ReScript 
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ * 
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
-    ) x
 
-and extension ctxt f (s, e) =
-  pp f "@[<2>[%%%s@ %a]@]" s.txt (payload ctxt) e
 
-and item_extension ctxt f (s, e) =
-  pp f "@[<2>[%%%%%s@ %a]@]" s.txt (payload ctxt) e
 
-and exception_declaration ctxt f ext =
-  pp f "@[<hov2>exception@ %a@]" (extension_constructor ctxt) ext
 
-and class_signature ctxt f { pcsig_self = ct; pcsig_fields = l ;_} =
-  let class_type_field f x =
-    match x.pctf_desc with
-    | Pctf_inherit (ct) ->
-        pp f "@[<2>inherit@ %a@]%a" (class_type ctxt) ct
-          (item_attributes ctxt) x.pctf_attributes
-    | Pctf_val (s, mf, vf, ct) ->
-        pp f "@[<2>val @ %a%a%s@ :@ %a@]%a"
-          mutable_flag mf virtual_flag vf s.txt (core_type ctxt) ct
-          (item_attributes ctxt) x.pctf_attributes
-    | Pctf_method (s, pf, vf, ct) ->
-        pp f "@[<2>method %a %a%s :@;%a@]%a"
-          private_flag pf virtual_flag vf s.txt (core_type ctxt) ct
-          (item_attributes ctxt) x.pctf_attributes
-    | Pctf_constraint (ct1, ct2) ->
-        pp f "@[<2>constraint@ %a@ =@ %a@]%a"
-          (core_type ctxt) ct1 (core_type ctxt) ct2
-          (item_attributes ctxt) x.pctf_attributes
-    | Pctf_attribute a -> floating_attribute ctxt f a
-    | Pctf_extension e ->
-        item_extension ctxt f e;
-        item_attributes ctxt f x.pctf_attributes
-  in
-  pp f "@[<hv0>@[<hv2>object@[<1>%a@]@ %a@]@ end@]"
-    (fun f -> function
-         {ptyp_desc=Ptyp_any; ptyp_attributes=[]; _} -> ()
-       | ct -> pp f " (%a)" (core_type ctxt) ct) ct
-    (list class_type_field ~sep:"@;") l
 
-(* call [class_signature] called by [class_signature] *)
-and class_type ctxt f x =
-  match x.pcty_desc with
-  | Pcty_signature cs ->
-      class_signature ctxt f cs;
-      attributes ctxt f x.pcty_attributes
-  | Pcty_constr (li, l) ->
-      pp f "%a%a%a"
-        (fun f l -> match l with
-           | [] -> ()
-           | _  -> pp f "[%a]@ " (list (core_type ctxt) ~sep:"," ) l) l
-        longident_loc li
-        (attributes ctxt) x.pcty_attributes
-  | Pcty_arrow (l, co, cl) ->
-      pp f "@[<2>%a@;->@;%a@]" (* FIXME remove parens later *)
-        (type_with_label ctxt) (l,co)
-        (class_type ctxt) cl
-  | Pcty_extension e ->
-      extension ctxt f e;
-      attributes ctxt f x.pcty_attributes
-  | Pcty_open (ovf, lid, e) ->
-      pp f "@[<2>let open%s %a in@;%a@]" (override ovf) longident_loc lid
-        (class_type ctxt) e
 
-(* [class type a = object end] *)
-and class_type_declaration_list ctxt f l =
-  let class_type_declaration kwd f x =
-    let { pci_params=ls; pci_name={ txt; _ }; _ } = x in
-    pp f "@[<2>%s %a%a%s@ =@ %a@]%a" kwd
-      virtual_flag x.pci_virt
-      (class_params_def ctxt) ls txt
-      (class_type ctxt) x.pci_expr
-      (item_attributes ctxt) x.pci_attributes
-  in
-  match l with
-  | [] -> ()
-  | [x] -> class_type_declaration "class type" f x
-  | x :: xs ->
-      pp f "@[<v>%a@,%a@]"
-        (class_type_declaration "class type") x
-        (list ~sep:"@," (class_type_declaration "and")) xs
 
-and class_field ctxt f x =
-  match x.pcf_desc with
-  | Pcf_inherit () -> ()  
-  | Pcf_val (s, mf, Cfk_concrete (ovf, e)) ->
-      pp f "@[<2>val%s %a%s =@;%a@]%a" (override ovf)
-        mutable_flag mf s.txt
-        (expression ctxt) e
-        (item_attributes ctxt) x.pcf_attributes
-  | Pcf_method (s, pf, Cfk_virtual ct) ->
-      pp f "@[<2>method virtual %a %s :@;%a@]%a"
-        private_flag pf s.txt
-        (core_type ctxt) ct
-        (item_attributes ctxt) x.pcf_attributes
-  | Pcf_val (s, mf, Cfk_virtual ct) ->
-      pp f "@[<2>val virtual %a%s :@ %a@]%a"
-        mutable_flag mf s.txt
-        (core_type ctxt) ct
-        (item_attributes ctxt) x.pcf_attributes
-  | Pcf_method (s, pf, Cfk_concrete (ovf, e)) ->
-      let bind e =
-        binding ctxt f
-          {pvb_pat=
-             {ppat_desc=Ppat_var s;ppat_loc=Location.none;ppat_attributes=[]};
-           pvb_expr=e;
-           pvb_attributes=[];
-           pvb_loc=Location.none;
-          }
-      in
-      pp f "@[<2>method%s %a%a@]%a"
-        (override ovf)
-        private_flag pf
-        (fun f -> function
-           | {pexp_desc=Pexp_poly (e, Some ct); pexp_attributes=[]; _} ->
-               pp f "%s :@;%a=@;%a"
-                 s.txt (core_type ctxt) ct (expression ctxt) e
-           | {pexp_desc=Pexp_poly (e, None); pexp_attributes=[]; _} ->
-               bind e
-           | _ -> bind e) e
-        (item_attributes ctxt) x.pcf_attributes
-  | Pcf_constraint (ct1, ct2) ->
-      pp f "@[<2>constraint %a =@;%a@]%a"
-        (core_type ctxt) ct1
-        (core_type ctxt) ct2
-        (item_attributes ctxt) x.pcf_attributes
-  | Pcf_initializer (e) ->
-      pp f "@[<2>initializer@ %a@]%a"
-        (expression ctxt) e
-        (item_attributes ctxt) x.pcf_attributes
-  | Pcf_attribute a -> floating_attribute ctxt f a
-  | Pcf_extension e ->
-      item_extension ctxt f e;
-      item_attributes ctxt f x.pcf_attributes
+(* module E = Js_exp_make  *)
+(* module S = Js_stmt_make   *)
 
-and class_structure ctxt f { pcstr_self = p; pcstr_fields =  l } =
-  pp f "@[<hv0>@[<hv2>object%a@;%a@]@;end@]"
-    (fun f p -> match p.ppat_desc with
-       | Ppat_any -> ()
-       | Ppat_constraint _ -> pp f " %a" (pattern ctxt) p
-       | _ -> pp f " (%a)" (pattern ctxt) p) p
-    (list (class_field ctxt)) l
 
-and module_type ctxt f x =
-  if x.pmty_attributes <> [] then begin
-    pp f "((%a)%a)" (module_type ctxt) {x with pmty_attributes=[]}
-      (attributes ctxt) x.pmty_attributes
-  end else
-    match x.pmty_desc with
-    | Pmty_ident li ->
-        pp f "%a" longident_loc li;
-    | Pmty_alias li ->
-        pp f "(module %a)" longident_loc li;
-    | Pmty_signature (s) ->
-        pp f "@[<hv0>@[<hv2>sig@ %a@]@ end@]" (* "@[<hov>sig@ %a@ end@]" *)
-          (list (signature_item ctxt)) s (* FIXME wrong indentation*)
-    | Pmty_functor (_, None, mt2) ->
-        pp f "@[<hov2>functor () ->@ %a@]" (module_type ctxt) mt2
-    | Pmty_functor (s, Some mt1, mt2) ->
-        if s.txt = "_" then
-          pp f "@[<hov2>%a@ ->@ %a@]"
-            (module_type ctxt) mt1 (module_type ctxt) mt2
-        else
-          pp f "@[<hov2>functor@ (%s@ :@ %a)@ ->@ %a@]" s.txt
-            (module_type ctxt) mt1 (module_type ctxt) mt2
-    | Pmty_with (mt, l) ->
-        let with_constraint f = function
-          | Pwith_type (li, ({ptype_params= ls ;_} as td)) ->
-              let ls = List.map fst ls in
-              pp f "type@ %a %a =@ %a"
-                (list (core_type ctxt) ~sep:"," ~first:"(" ~last:")")
-                ls longident_loc li (type_declaration ctxt) td
-          | Pwith_module (li, li2) ->
-              pp f "module %a =@ %a" longident_loc li longident_loc li2;
-          | Pwith_typesubst (li, ({ptype_params=ls;_} as td)) ->
-              let ls = List.map fst ls in
-              pp f "type@ %a %a :=@ %a"
-                (list (core_type ctxt) ~sep:"," ~first:"(" ~last:")")
-                ls longident_loc li
-                (type_declaration ctxt) td
-          | Pwith_modsubst (li, li2) ->
-             pp f "module %a :=@ %a" longident_loc li longident_loc li2 in
-        (match l with
-         | [] -> pp f "@[<hov2>%a@]" (module_type ctxt) mt
-         | _ -> pp f "@[<hov2>(%a@ with@ %a)@]"
-                  (module_type ctxt) mt (list with_constraint ~sep:"@ and@ ") l)
-    | Pmty_typeof me ->
-        pp f "@[<hov2>module@ type@ of@ %a@]" (module_expr ctxt) me
-    | Pmty_extension e -> extension ctxt f e
+let compile_group (meta : Lam_stats.t) 
+    (x : Lam_group.t) : Js_output.t  = 
+  match x with 
+  (* 
+        We need
 
-and signature ctxt f x =  list ~sep:"@\n" (signature_item ctxt) f x
+        2. [E.builtin_dot] for javascript builtin
+        3. [E.mldot]
+     *)
+  (* ATTENTION: check {!Lam_compile_global} for consistency  *)      
+  (* Special handling for values in [Pervasives] *)  
+  (* 
+         we delegate [stdout, stderr, and stdin] into [caml_io] module, 
+         the motivation is to help dead code eliminatiion, it's helpful 
+         to make those parts pure (not a function call), then it can be removed 
+         if unused 
+      *)                     
 
-and signature_item ctxt f x : unit =
-  match x.psig_desc with
-  | Psig_type (rf, l) ->
-      type_def_list ctxt f (rf, l)
-  | Psig_value vd ->
-      let intro = if vd.pval_prim = [] then "val" else "external" in
-      pp f "@[<2>%s@ %a@ :@ %a@]%a" intro
-        protect_ident vd.pval_name.txt
-        (value_description ctxt) vd
-        (item_attributes ctxt) vd.pval_attributes
-  | Psig_typext te ->
-      type_extension ctxt f te
-  | Psig_exception ed ->
-      exception_declaration ctxt f ed
-  | Psig_class () ->
-    ()
-  | Psig_module ({pmd_type={pmty_desc=Pmty_alias alias;
-                            pmty_attributes=[]; _};_} as pmd) ->
-      pp f "@[<hov>module@ %s@ =@ %a@]%a" pmd.pmd_name.txt
-        longident_loc alias
-        (item_attributes ctxt) pmd.pmd_attributes
-  | Psig_module pmd ->
-      pp f "@[<hov>module@ %s@ :@ %a@]%a"
-        pmd.pmd_name.txt
-        (module_type ctxt) pmd.pmd_type
-        (item_attributes ctxt) pmd.pmd_attributes
-  | Psig_open od ->
-      pp f "@[<hov2>open%s@ %a@]%a"
-        (override od.popen_override)
-        longident_loc od.popen_lid
-        (item_attributes ctxt) od.popen_attributes
-  | Psig_include incl ->
-      pp f "@[<hov2>include@ %a@]%a"
-        (module_type ctxt) incl.pincl_mod
-        (item_attributes ctxt) incl.pincl_attributes
-  | Psig_modtype {pmtd_name=s; pmtd_type=md; pmtd_attributes=attrs} ->
-      pp f "@[<hov2>module@ type@ %s%a@]%a"
-        s.txt
-        (fun f md -> match md with
-           | None -> ()
-           | Some mt ->
-               pp_print_space f () ;
-               pp f "@ =@ %a" (module_type ctxt) mt
-        ) md
-        (item_attributes ctxt) attrs
-  | Psig_class_type (l) -> class_type_declaration_list ctxt f l
-  | Psig_recmodule decls ->
-      let rec  string_x_module_type_list f ?(first=true) l =
-        match l with
-        | [] -> () ;
-        | pmd :: tl ->
-            if not first then
-              pp f "@ @[<hov2>and@ %s:@ %a@]%a" pmd.pmd_name.txt
-                (module_type ctxt) pmd.pmd_type
-                (item_attributes ctxt) pmd.pmd_attributes
-            else
-              pp f "@[<hov2>module@ rec@ %s:@ %a@]%a" pmd.pmd_name.txt
-                (module_type ctxt) pmd.pmd_type
-                (item_attributes ctxt) pmd.pmd_attributes;
-            string_x_module_type_list f ~first:false tl
-      in
-      string_x_module_type_list f decls
-  | Psig_attribute a -> floating_attribute ctxt f a
-  | Psig_extension(e, a) ->
-      item_extension ctxt f e;
-      item_attributes ctxt f a
+  (* QUICK hack to make hello world example nicer,
+     Note the arity of [print_endline] is already analyzed before, 
+     so it should be safe
+  *)
 
-and module_expr ctxt f x =
-  if x.pmod_attributes <> [] then
-    pp f "((%a)%a)" (module_expr ctxt) {x with pmod_attributes=[]}
-      (attributes ctxt) x.pmod_attributes
-  else match x.pmod_desc with
-    | Pmod_structure (s) ->
-        pp f "@[<hv2>struct@;@[<0>%a@]@;<1 -2>end@]"
-          (list (structure_item ctxt) ~sep:"@\n") s;
-    | Pmod_constraint (me, mt) ->
-        pp f "@[<hov2>(%a@ :@ %a)@]"
-          (module_expr ctxt) me
-          (module_type ctxt) mt
-    | Pmod_ident (li) ->
-        pp f "%a" longident_loc li;
-    | Pmod_functor (_, None, me) ->
-        pp f "functor ()@;->@;%a" (module_expr ctxt) me
-    | Pmod_functor (s, Some mt, me) ->
-        pp f "functor@ (%s@ :@ %a)@;->@;%a"
-          s.txt (module_type ctxt) mt (module_expr ctxt) me
-    | Pmod_apply (me1, me2) ->
-        pp f "(%a)(%a)" (module_expr ctxt) me1 (module_expr ctxt) me2
-        (* Cf: #7200 *)
-    | Pmod_unpack e ->
-        pp f "(val@ %a)" (expression ctxt) e
-    | Pmod_extension e -> extension ctxt f e
+  | Single (kind, id, lam) -> 
+    (* let lam = Optimizer.simplify_lets [] lam in  *)
+    (* can not apply again, it's wrong USE it with care*)
+    (* ([Js_stmt_make.comment (Gen_of_env.query_type id  env )], None)  ++ *)
+    Lam_compile.compile_lambda { continuation = Declare (kind, id);
+                                 jmp_table = Lam_compile_context.empty_handler_map;
+                                 meta
+                               } lam
 
-and structure ctxt f x = list ~sep:"@\n" (structure_item ctxt) f x
+  | Recursive id_lams   -> 
+    Lam_compile.compile_recursive_lets 
+      { continuation = EffectCall Not_tail; 
+        jmp_table = Lam_compile_context.empty_handler_map;
+        meta
+      } 
+      id_lams
+  | Nop lam -> (* TODO: Side effect callls, log and see statistics *)
+    Lam_compile.compile_lambda {continuation = EffectCall Not_tail;
+                                jmp_table = Lam_compile_context.empty_handler_map;
+                                meta
+                               } lam
 
-and payload ctxt f = function
-  | PStr [{pstr_desc = Pstr_eval (e, attrs)}] ->
-      pp f "@[<2>%a@]%a"
-        (expression ctxt) e
-        (item_attributes ctxt) attrs
-  | PStr x -> structure ctxt f x
-  | PTyp x -> pp f ":"; core_type ctxt f x
-  | PSig x -> pp f ":"; signature ctxt f x
-  | PPat (x, None) -> pp f "?"; pattern ctxt f x
-  | PPat (x, Some e) ->
-      pp f "?"; pattern ctxt f x;
-      pp f " when "; expression ctxt f e
+;;
 
-(* transform [f = fun g h -> ..] to [f g h = ... ] could be improved *)
-and binding ctxt f {pvb_pat=p; pvb_expr=x; _} =
-  (* .pvb_attributes have already been printed by the caller, #bindings *)
-  let rec pp_print_pexp_function f x =
-    if x.pexp_attributes <> [] then pp f "=@;%a" (expression ctxt) x
-    else match x.pexp_desc with
-      | Pexp_fun (label, eo, p, e) ->
-          if label=Nolabel then
-            pp f "%a@ %a" (simple_pattern ctxt) p pp_print_pexp_function e
-          else
-            pp f "%a@ %a"
-              (label_exp ctxt) (label,eo,p) pp_print_pexp_function e
-      | Pexp_newtype (str,e) ->
-          pp f "(type@ %s)@ %a" str.txt pp_print_pexp_function e
-      | _ -> pp f "=@;%a" (expression ctxt) x
-  in
-  let tyvars_str tyvars = List.map (fun v -> v.txt) tyvars in
-  let is_desugared_gadt p e =
-    let gadt_pattern =
-      match p with
-      | {ppat_desc=Ppat_constraint({ppat_desc=Ppat_var _} as pat,
-                                   {ptyp_desc=Ptyp_poly (args_tyvars, rt)});
-         ppat_attributes=[]}->
-          Some (pat, args_tyvars, rt)
-      | _ -> None in
-    let rec gadt_exp tyvars e =
-      match e with
-      | {pexp_desc=Pexp_newtype (tyvar, e); pexp_attributes=[]} ->
-          gadt_exp (tyvar :: tyvars) e
-      | {pexp_desc=Pexp_constraint (e, ct); pexp_attributes=[]} ->
-          Some (List.rev tyvars, e, ct)
-      | _ -> None in
-    let gadt_exp = gadt_exp [] e in
-    match gadt_pattern, gadt_exp with
-    | Some (p, pt_tyvars, pt_ct), Some (e_tyvars, e, e_ct)
-      when tyvars_str pt_tyvars = tyvars_str e_tyvars ->
-      let ety = Typ.varify_constructors e_tyvars e_ct in
-      if ety = pt_ct then
-      Some (p, pt_tyvars, e_ct, e) else None
-    | _ -> None in
-  if x.pexp_attributes <> []
-  then pp f "%a@;=@;%a" (pattern ctxt) p (expression ctxt) x else
-  match is_desugared_gadt p x with
-  | Some (p, [], ct, e) ->
-      pp f "%a@;: %a@;=@;%a"
-        (simple_pattern ctxt) p (core_type ctxt) ct (expression ctxt) e
-  | Some (p, tyvars, ct, e) -> begin
-    pp f "%a@;: type@;%a.@;%a@;=@;%a"
-    (simple_pattern ctxt) p (list pp_print_string ~sep:"@;")
-    (tyvars_str tyvars) (core_type ctxt) ct (expression ctxt) e
-    end
-  | None -> begin
-      match p with
-      | {ppat_desc=Ppat_constraint(p ,ty);
-         ppat_attributes=[]} -> (* special case for the first*)
-          begin match ty with
-          | {ptyp_desc=Ptyp_poly _; ptyp_attributes=[]} ->
-              pp f "%a@;:@;%a@;=@;%a" (simple_pattern ctxt) p
-                (core_type ctxt) ty (expression ctxt) x
-          | _ ->
-              pp f "(%a@;:@;%a)@;=@;%a" (simple_pattern ctxt) p
-                (core_type ctxt) ty (expression ctxt) x
-          end
-      | {ppat_desc=Ppat_var _; ppat_attributes=[]} ->
-          pp f "%a@ %a" (simple_pattern ctxt) p pp_print_pexp_function x
-      | _ ->
-          pp f "%a@;=@;%a" (pattern ctxt) p (expression ctxt) x
-    end
+(** Also need analyze its depenency is pure or not *)
+let no_side_effects (rest : Lam_group.t list) : string option = 
+  Ext_list.find_opt rest (fun x -> 
+      match x with 
+      | Single(kind,id,body) -> 
+        begin 
+          match kind with 
+          | Strict | Variable -> 
+            if not @@ Lam_analysis.no_side_effects body 
+            then Some  (Printf.sprintf "%s" id.name)
+            else None
+          | _ -> None
+        end
+      | Recursive bindings -> 
+        Ext_list.find_opt  bindings (fun (id,lam) -> 
+            if not @@ Lam_analysis.no_side_effects lam 
+            then Some (Printf.sprintf "%s" id.Ident.name )
+            else None
+          )
+      | Nop lam -> 
+        if not @@ Lam_analysis.no_side_effects lam 
+        then 
+          (*  (Lam_util.string_of_lambda lam) *)
+          Some ""
+        else None (* TODO :*))
 
-(* [in] is not printed *)
-and bindings ctxt f (rf,l) =
-  let binding kwd rf f x =
-    pp f "@[<2>%s %a%a@]%a" kwd rec_flag rf
-      (binding ctxt) x (item_attributes ctxt) x.pvb_attributes
-  in
-  match l with
-  | [] -> ()
-  | [x] -> binding "let" rf f x
-  | x::xs ->
-      pp f "@[<v>%a@,%a@]"
-        (binding "let" rf) x
-        (list ~sep:"@," (binding "and" Nonrecursive)) xs
 
-and structure_item ctxt f x =
-  match x.pstr_desc with
-  | Pstr_eval (e, attrs) ->
-      pp f "@[<hov2>;;%a@]%a"
-        (expression ctxt) e
-        (item_attributes ctxt) attrs
-  | Pstr_type (_, []) -> assert false
-  | Pstr_type (rf, l)  -> type_def_list ctxt f (rf, l)
-  | Pstr_value (rf, l) ->
-      (* pp f "@[<hov2>let %a%a@]"  rec_flag rf bindings l *)
-      pp f "@[<2>%a@]" (bindings ctxt) (rf,l)
-  | Pstr_typext te -> type_extension ctxt f te
-  | Pstr_exception ed -> exception_declaration ctxt f ed
-  | Pstr_module x ->
-      let rec module_helper = function
-        | {pmod_desc=Pmod_functor(s,mt,me'); pmod_attributes = []} ->
-            if mt = None then pp f "()"
-            else Misc.may (pp f "(%s:%a)" s.txt (module_type ctxt)) mt;
-            module_helper me'
-        | me -> me
-      in
-      pp f "@[<hov2>module %s%a@]%a"
-        x.pmb_name.txt
-        (fun f me ->
-           let me = module_helper me in
-           match me with
-           | {pmod_desc=
-                Pmod_constraint
-                  (me',
-                   ({pmty_desc=(Pmty_ident (_)
-                               | Pmty_signature (_));_} as mt));
-              pmod_attributes = []} ->
-               pp f " :@;%a@;=@;%a@;"
-                 (module_type ctxt) mt (module_expr ctxt) me'
-           | _ -> pp f " =@ %a" (module_expr ctxt) me
-        ) x.pmb_expr
-        (item_attributes ctxt) x.pmb_attributes
-  | Pstr_open od ->
-      pp f "@[<2>open%s@;%a@]%a"
-        (override od.popen_override)
-        longident_loc od.popen_lid
-        (item_attributes ctxt) od.popen_attributes
-  | Pstr_modtype {pmtd_name=s; pmtd_type=md; pmtd_attributes=attrs} ->
-      pp f "@[<hov2>module@ type@ %s%a@]%a"
-        s.txt
-        (fun f md -> match md with
-           | None -> ()
-           | Some mt ->
-               pp_print_space f () ;
-               pp f "@ =@ %a" (module_type ctxt) mt
-        ) md
-        (item_attributes ctxt) attrs
-  | Pstr_class () -> ()
-  | Pstr_class_type l -> class_type_declaration_list ctxt f l
-  | Pstr_primitive vd ->
-      pp f "@[<hov2>external@ %a@ :@ %a@]%a"
-        protect_ident vd.pval_name.txt
-        (value_description ctxt) vd
-        (item_attributes ctxt) vd.pval_attributes
-  | Pstr_include incl ->
-      pp f "@[<hov2>include@ %a@]%a"
-        (module_expr ctxt) incl.pincl_mod
-        (item_attributes ctxt) incl.pincl_attributes
-  | Pstr_recmodule decls -> (* 3.07 *)
-      let aux f = function
-        | ({pmb_expr={pmod_desc=Pmod_constraint (expr, typ)}} as pmb) ->
-            pp f "@[<hov2>@ and@ %s:%a@ =@ %a@]%a" pmb.pmb_name.txt
-              (module_type ctxt) typ
-              (module_expr ctxt) expr
-              (item_attributes ctxt) pmb.pmb_attributes
-        | _ -> assert false
-      in
-      begin match decls with
-      | ({pmb_expr={pmod_desc=Pmod_constraint (expr, typ)}} as pmb) :: l2 ->
-          pp f "@[<hv>@[<hov2>module@ rec@ %s:%a@ =@ %a@]%a@ %a@]"
-            pmb.pmb_name.txt
-            (module_type ctxt) typ
-            (module_expr ctxt) expr
-            (item_attributes ctxt) pmb.pmb_attributes
-            (fun f l2 -> List.iter (aux f) l2) l2
-      | _ -> assert false
-      end
-  | Pstr_attribute a -> floating_attribute ctxt f a
-  | Pstr_extension(e, a) ->
-      item_extension ctxt f e;
-      item_attributes ctxt f a
+let _d  = fun  s lam -> 
 
-and type_param ctxt f (ct, a) =
-  pp f "%s%a" (type_variance a) (core_type ctxt) ct
+  lam
 
-and type_params ctxt f = function
-  | [] -> ()
-  | l -> pp f "%a " (list (type_param ctxt) ~first:"(" ~last:")" ~sep:",@;") l
+let _j = Js_pass_debug.dump 
 
-and type_def_list ctxt f (rf, l) =
-  let type_decl kwd rf f x =
-    let eq =
-      if (x.ptype_kind = Ptype_abstract)
-         && (x.ptype_manifest = None) then ""
-      else " ="
-    in
-    pp f "@[<2>%s %a%a%s%s%a@]%a" kwd
-      nonrec_flag rf
-      (type_params ctxt) x.ptype_params
-      x.ptype_name.txt eq
-      (type_declaration ctxt) x
-      (item_attributes ctxt) x.ptype_attributes
-  in
-  match l with
-  | [] -> assert false
-  | [x] -> type_decl "type" rf f x
-  | x :: xs -> pp f "@[<v>%a@,%a@]"
-                 (type_decl "type" rf) x
-                 (list ~sep:"@," (type_decl "and" Recursive)) xs
+(** Actually simplify_lets is kind of global optimization since it requires you to know whether 
+    it's used or not 
+*)
+let compile  
+    (output_prefix : string) 
+    export_idents
+    (lam : Lambda.lambda)  = 
+  let export_ident_sets = Set_ident.of_list export_idents in 
+  (* To make toplevel happy - reentrant for js-demo *)
+  let () = 
+      
+    Lam_compile_env.reset () ;
+  in 
+  let lam, may_required_modules = Lam_convert.convert export_ident_sets lam in 
 
-and record_declaration ctxt f lbls =
-  let type_record_field f pld =
-    pp f "@[<2>%a%s:@;%a@;%a@]"
-      mutable_flag pld.pld_mutable
-      pld.pld_name.txt
-      (core_type ctxt) pld.pld_type
-      (attributes ctxt) pld.pld_attributes
-  in
-  pp f "{@\n%a}"
-    (list type_record_field ~sep:";@\n" )  lbls
 
-and type_declaration ctxt f x =
-  (* type_declaration has an attribute field,
-     but it's been printed by the caller of this method *)
-  let priv f =
-    match x.ptype_private with
-    | Public -> ()
-    | Private -> pp f "@;private"
-  in
-  let manifest f =
-    match x.ptype_manifest with
-    | None -> ()
-    | Some y ->
-        if x.ptype_kind = Ptype_abstract then
-          pp f "%t@;%a" priv (core_type ctxt) y
-        else
-          pp f "@;%a" (core_type ctxt) y
-  in
-  let constructor_declaration f pcd =
-    pp f "|@;";
-    constructor_declaration ctxt f
-      (pcd.pcd_name.txt, pcd.pcd_args, pcd.pcd_res, pcd.pcd_attributes)
-  in
-  let repr f =
-    let intro f =
-      if x.ptype_manifest = None then ()
-      else pp f "@;="
-    in
-    match x.ptype_kind with
-    | Ptype_variant xs ->
-        pp f "%t%t@\n%a" intro priv
-          (list ~sep:"@\n" constructor_declaration) xs
-    | Ptype_abstract -> ()
-    | Ptype_record l ->
-        pp f "%t%t@;%a" intro priv (record_declaration ctxt) l
-    | Ptype_open -> pp f "%t%t@;.." intro priv
-  in
-  let constraints f =
-    List.iter
-      (fun (ct1,ct2,_) ->
-         pp f "@[<hov2>@ constraint@ %a@ =@ %a@]"
-           (core_type ctxt) ct1 (core_type ctxt) ct2)
-      x.ptype_cstrs
-  in
-  pp f "%t%t%t" manifest repr constraints
+  let lam = _d "initial"  lam in
+  let lam  = Lam_pass_deep_flatten.deep_flatten lam in
+  let lam = _d  "flatten0" lam in
+  let meta  : Lam_stats.t = 
+    Lam_stats.make 
+      ~export_idents
+      ~export_ident_sets in 
+  let () = Lam_pass_collect.collect_info meta lam in 
+  let lam = 
+    let lam =  
+      lam
+      |> _d "flattern1"
+      |>  Lam_pass_exits.simplify_exits
+      |> _d "simplyf_exits"
+      |> (fun lam -> Lam_pass_collect.collect_info meta lam; 
+      
+      lam)
+      |>  Lam_pass_remove_alias.simplify_alias  meta
+      |> _d "simplify_alias"
+      |> Lam_pass_deep_flatten.deep_flatten
+      |> _d  "flatten2"
+    in  (* Inling happens*)
 
-and type_extension ctxt f x =
-  let extension_constructor f x =
-    pp f "@\n|@;%a" (extension_constructor ctxt) x
-  in
-  pp f "@[<2>type %a%a += %a@ %a@]%a"
-    (fun f -> function
-       | [] -> ()
-       | l ->
-           pp f "%a@;" (list (type_param ctxt) ~first:"(" ~last:")" ~sep:",") l)
-    x.ptyext_params
-    longident_loc x.ptyext_path
-    private_flag x.ptyext_private (* Cf: #7200 *)
-    (list ~sep:"" extension_constructor)
-    x.ptyext_constructors
-    (item_attributes ctxt) x.ptyext_attributes
+    let ()  = Lam_pass_collect.collect_info meta lam in
+    let lam = Lam_pass_remove_alias.simplify_alias meta lam  in
+    let lam = Lam_pass_deep_flatten.deep_flatten lam in
+    let ()  = Lam_pass_collect.collect_info meta lam in
+    let lam = 
+      lam
+      |> _d "alpha_before"
+      |> Lam_pass_alpha_conversion.alpha_conversion meta
+      |> _d "alpha_after"
+      |> Lam_pass_exits.simplify_exits in    
+    let () = Lam_pass_collect.collect_info meta lam in
 
-and constructor_declaration ctxt f (name, args, res, attrs) =
-  let name =
-    match name with
-    | "::" -> "(::)"
-    | s -> s in
-  match res with
-  | None ->
-      pp f "%s%a@;%a" name
-        (fun f -> function
-           | Pcstr_tuple [] -> ()
-           | Pcstr_tuple l ->
-             pp f "@;of@;%a" (list (core_type1 ctxt) ~sep:"@;*@;") l
-           | Pcstr_record l -> pp f "@;of@;%a" (record_declaration ctxt) l
-        ) args
-        (attributes ctxt) attrs
-  | Some r ->
-      pp f "%s:@;%a@;%a" name
-        (fun f -> function
-           | Pcstr_tuple [] -> core_type1 ctxt f r
-           | Pcstr_tuple l -> pp f "%a@;->@;%a"
-                                (list (core_type1 ctxt) ~sep:"@;*@;") l
-                                (core_type1 ctxt) r
-           | Pcstr_record l ->
-               pp f "%a@;->@;%a" (record_declaration ctxt) l (core_type1 ctxt) r
-        )
-        args
-        (attributes ctxt) attrs
 
-and extension_constructor ctxt f x =
-  (* Cf: #7200 *)
-  match x.pext_kind with
-  | Pext_decl(l, r) ->
-      constructor_declaration ctxt f (x.pext_name.txt, l, r, x.pext_attributes)
-  | Pext_rebind li ->
-      pp f "%s%a@;=@;%a" x.pext_name.txt
-        (attributes ctxt) x.pext_attributes
-        longident_loc li
+    lam
+    |> _d "simplify_alias_before"
+    |>  Lam_pass_remove_alias.simplify_alias meta 
+    |> _d "alpha_conversion"
+    |>  Lam_pass_alpha_conversion.alpha_conversion meta
+    |> _d  "before-simplify_lets"
+    (* we should investigate a better way to put different passes : )*)
+    |> Lam_pass_lets_dce.simplify_lets 
 
-and case_list ctxt f l : unit =
-  let aux f {pc_lhs; pc_guard; pc_rhs} =
-    pp f "@;| @[<2>%a%a@;->@;%a@]"
-      (pattern ctxt) pc_lhs (option (expression ctxt) ~first:"@;when@;")
-      pc_guard (expression (under_pipe ctxt)) pc_rhs
+    |> _d "before-simplify-exits"
+    (* |> (fun lam -> Lam_pass_collect.collect_info meta lam 
+       ; Lam_pass_remove_alias.simplify_alias meta lam) *)
+    (* |> Lam_group_pass.scc_pass
+       |> _d "scc" *)
+    |> Lam_pass_exits.simplify_exits
+    |> _d "simplify_lets"
+    
   in
-  list aux f l ~sep:""
 
-and label_x_expression_param ctxt f (l,e) =
-  let simple_name = match e with
-    | {pexp_desc=Pexp_ident {txt=Lident l;_};
-       pexp_attributes=[]} -> Some l
-    | _ -> None
-  in match l with
-  | Nolabel  -> expression2 ctxt f e (* level 2*)
-  | Optional str ->
-      if Some str = simple_name then
-        pp f "?%s" str
-      else
-        pp f "?%s:%a" str (simple_expr ctxt) e
-  | Labelled lbl ->
-      if Some lbl = simple_name then
-        pp f "~%s" lbl
-      else
-        pp f "~%s:%a" lbl (simple_expr ctxt) e
+  let ({Lam_coercion.groups = groups } as coerced_input , meta) = 
+    Lam_coercion.coerce_and_group_big_lambda  meta lam
+  in 
 
+  
+let maybe_pure = no_side_effects groups in
+  
+let body  =     
+  Ext_list.map groups (fun group -> compile_group meta group)
+  |> Js_output.concat
+  |> Js_output.output_as_block
+in
+    
+(* The file is not big at all compared with [cmo] *)
+(* Ext_marshal.to_file (Ext_path.chop_extension filename ^ ".mj")  js; *)
+let meta_exports = meta.exports in 
+let export_set = Set_ident.of_list meta_exports in 
+let js : J.program = 
+  { 
+    exports = meta_exports ; 
+    export_set; 
+    block = body}
+in
+js 
+|> _j "initial"
+|> Js_pass_flatten.program
+|> _j "flattern"
+|> Js_pass_tailcall_inline.tailcall_inline
+|> _j "inline_and_shake"
+|> Js_pass_flatten_and_mark_dead.program
+|> _j "flatten_and_mark_dead"
+(* |> Js_inline_and_eliminate.inline_and_shake *)
+(* |> _j "inline_and_shake" *)
+|> (fun js -> ignore @@ Js_pass_scope.program  js ; js )
+|> Js_shake.shake_program
+|> _j "shake"
+|> ( fun (program:  J.program) -> 
+    let external_module_ids : Lam_module_ident.t list = 
+      if !Js_config.all_module_aliases then []
+      else
+        let hard_deps = 
+          Js_fold_basic.calculate_hard_dependencies program.block in  
+        Lam_compile_env.populate_required_modules  
+          may_required_modules hard_deps ;        
+        Ext_list.sort_via_array (Lam_module_ident.Hash_set.to_list hard_deps)
+          (fun id1 id2 ->
+             Ext_string.compare (Lam_module_ident.name id1) (Lam_module_ident.name id2)
+          ) 
+    in
+    Warnings.check_fatal();
+    let effect = 
+      Lam_stats_export.get_dependent_module_effect
+        maybe_pure external_module_ids in 
+    let v : Js_cmj_format.t = 
+      Lam_stats_export.export_to_cmj 
+        meta  
+        effect 
+        coerced_input.export_map          
+        (if Ext_char.is_lower_case (Filename.basename output_prefix).[0] then Little else Upper)
+    in
+    (if not !Clflags.dont_write_files then
+       Js_cmj_format.to_file 
+         ~check_exists:(not !Js_config.force_cmj)
+         (output_prefix ^ Literals.suffix_cmj) v);
+    {J.program = program ; side_effect = effect ; modules = external_module_ids }      
+  )
+;;
 
+let (//) = Filename.concat  
 
-let expression f x =
-  pp f "@[%a@]" (expression reset_ctxt) x
+let lambda_as_module 
+    (lambda_output : J.deps_program)
+    (output_prefix : string)
+  : unit = 
+  let package_info = Js_packages_state.get_packages_info () in 
+  if Js_packages_info.is_empty package_info && !Js_config.js_stdout then begin    
+    Js_dump_program.dump_deps_program ~output_prefix NodeJS lambda_output stdout
+  end else
+    Js_packages_info.iter package_info (fun {module_system; path; suffix} -> 
+        let output_chan chan  = 
+          Js_dump_program.dump_deps_program ~output_prefix
+            module_system 
+            lambda_output
+            chan in
+        let basename =  
+          Ext_namespace.change_ext_ns_suffix 
+            (Filename.basename
+               output_prefix) 
+            (Ext_js_suffix.to_string  suffix) 
+        in
+        let target_file = 
+          (Lazy.force Ext_path.package_dir //
+           path //
+           basename
+           (* #913 only generate little-case js file *)
+          ) in     
+        (if not !Clflags.dont_write_files then 
+           Ext_pervasives.with_file_as_chan
+             target_file output_chan );
+        if !Warnings.has_warnings  then begin 
+          Warnings.has_warnings := false ;
+          (* 5206: When there were warnings found during the compilation, we want the file
+             to be rebuilt on the next "rescript build" so that the warnings keep being shown.
+             Set the timestamp of the ast file to 1970-01-01 to make this rebuild happen.
+             (Do *not* set the timestamp of the JS output file instead
+             as that does not play well with every bundler.) *)
+          let ast_file = output_prefix ^ Literals.suffix_ast in
+          if Sys.file_exists ast_file then begin 
+            Bs_hash_stubs.set_as_old_file ast_file
+          end          
+          
+        end             
+      )
 
-let string_of_expression x =
-  ignore (flush_str_formatter ()) ;
-  let f = str_formatter in
-  expression f x;
-  flush_str_formatter ()
 
-let string_of_structure x =
-  ignore (flush_str_formatter ());
-  let f = str_formatter in
-  structure reset_ctxt f x;
-  flush_str_formatter ()
 
+(* We can use {!Env.current_unit = "Pervasives"} to tell if it is some specific module, 
+    We need handle some definitions in standard libraries in a special way, most are io specific, 
+    includes {!Pervasives.stdin, Pervasives.stdout, Pervasives.stderr}
 
-let core_type = core_type reset_ctxt
-let pattern = pattern reset_ctxt
-let signature = signature reset_ctxt
-let structure = structure reset_ctxt
+    However, use filename instead of {!Env.current_unit} is more honest, since node-js module system is coupled with the file name 
+*)
 
 end
 module Ast_async
@@ -286728,7 +286799,7 @@ let fmt_char_option f = function
 let fmt_constant f x =
   match x with
   | Pconst_integer (i,m) -> fprintf f "PConst_int (%s,%a)" i fmt_char_option m;
-  | Pconst_char (c) -> fprintf f "PConst_char %02x" (Char.code c);
+  | Pconst_char (c) -> fprintf f "PConst_char %02x" c;
   | Pconst_string (s, None) -> fprintf f "PConst_string(%S,None)" s;
   | Pconst_string (s, Some delim) ->
       fprintf f "PConst_string (%S,Some %S)" s delim;
@@ -287596,7 +287667,7 @@ let fmt_path f x = fprintf f "\"%a\"" fmt_path_aux x;;
 let fmt_constant f x =
   match x with
   | Const_int (i) -> fprintf f "Const_int %d" i;
-  | Const_char (c) -> fprintf f "Const_char %02x" (Char.code c);
+  | Const_char (c) -> fprintf f "Const_char %02x" c;
   | Const_string (s, None) -> fprintf f "Const_string(%S,None)" s;
   | Const_string (s, Some delim) ->
       fprintf f "Const_string (%S,Some %S)" s delim;
@@ -295914,24 +295985,23 @@ let scanEscape scanner =
       next scanner
     done;
     let c = !x in
-    if Res_utf8.isValidCodePoint c then Char.unsafe_chr c
-    else Char.unsafe_chr Res_utf8.repl
+    if Res_utf8.isValidCodePoint c then c else Res_utf8.repl
   in
   let codepoint =
     match scanner.ch with
     | '0' .. '9' -> convertNumber scanner ~n:3 ~base:10
     | 'b' ->
       next scanner;
-      '\008'
+      8
     | 'n' ->
       next scanner;
-      '\010'
+      10
     | 'r' ->
       next scanner;
-      '\013'
+      13
     | 't' ->
       next scanner;
-      '\009'
+      009
     | 'x' ->
       next scanner;
       convertNumber scanner ~n:2 ~base:16
@@ -295958,14 +296028,13 @@ let scanEscape scanner =
         | '}' -> next scanner
         | _ -> ());
         let c = !x in
-        if Res_utf8.isValidCodePoint c then Char.unsafe_chr c
-        else Char.unsafe_chr Res_utf8.repl
+        if Res_utf8.isValidCodePoint c then c else Res_utf8.repl
       | _ ->
         (* unicode escape sequence: '\u007A', exactly 4 hex digits *)
         convertNumber scanner ~n:4 ~base:16)
     | ch ->
       next scanner;
-      ch
+      Char.code ch
   in
   let contents =
     (String.sub [@doesNotRaise]) scanner.src offset (scanner.offset - offset)
@@ -296299,7 +296368,10 @@ let rec scan scanner =
         let offset = scanner.offset + 1 in
         next3 scanner;
         Token.Codepoint
-          {c = ch; original = (String.sub [@doesNotRaise]) scanner.src offset 1}
+          {
+            c = Char.code ch;
+            original = (String.sub [@doesNotRaise]) scanner.src offset 1;
+          }
       | ch, _ ->
         next scanner;
         let offset = scanner.offset in
@@ -296315,7 +296387,7 @@ let rec scan scanner =
             (String.sub [@doesNotRaise]) scanner.src offset length
           in
           next scanner;
-          Token.Codepoint {c = Obj.magic codepoint; original = contents})
+          Token.Codepoint {c = codepoint; original = contents})
         else (
           scanner.ch <- ch;
           scanner.offset <- offset;
diff --git a/syntax b/syntax
index 180e25256f..c6807e87c1 160000
--- a/syntax
+++ b/syntax
@@ -1 +1 @@
-Subproject commit 180e25256fb28c00f8542ade5b0e4609593c1b31
+Subproject commit c6807e87c112a22657c21f43f26e012ad4ba1ce2