Source

mutated_ocaml / camlp4 / boot / Camlp4.ml

Diff from to

camlp4/boot/Camlp4.ml

               
             let skip_opt_linefeed (__strm : _ Stream.t) =
               match Stream.peek __strm with
-              | Some '\010' -> (Stream.junk __strm; ())
+              | Some '\n' -> (Stream.junk __strm; ())
               | _ -> ()
               
             let chr c =
               
             let rec backslash (__strm : _ Stream.t) =
               match Stream.peek __strm with
-              | Some '\010' -> (Stream.junk __strm; '\010')
-              | Some '\013' -> (Stream.junk __strm; '\013')
+              | Some '\n' -> (Stream.junk __strm; '\n')
+              | Some '\r' -> (Stream.junk __strm; '\r')
               | Some 'n' -> (Stream.junk __strm; '\n')
               | Some 'r' -> (Stream.junk __strm; '\r')
               | Some 't' -> (Stream.junk __strm; '\t')
               
             let rec backslash_in_string strict store (__strm : _ Stream.t) =
               match Stream.peek __strm with
-              | Some '\010' -> (Stream.junk __strm; skip_indent __strm)
-              | Some '\013' ->
+              | Some '\n' -> (Stream.junk __strm; skip_indent __strm)
+              | Some '\r' ->
                   (Stream.junk __strm;
                    let s = __strm in (skip_opt_linefeed s; skip_indent s))
               | _ ->
                       
                     module Expr =
                       struct
-                        let meta_string _loc s = Ast.ExStr (_loc, s)
+                        let meta_string _loc s =
+                          Ast.ExStr (_loc, (safe_string_escaped s))
                           
                         let meta_int _loc s = Ast.ExInt (_loc, s)
                           
                         let meta_float _loc s = Ast.ExFlo (_loc, s)
                           
-                        let meta_char _loc s = Ast.ExChr (_loc, s)
+                        let meta_char _loc s =
+                          Ast.ExChr (_loc, (String.escaped s))
                           
                         let meta_bool _loc =
                           function
                       
                     module Patt =
                       struct
-                        let meta_string _loc s = Ast.PaStr (_loc, s)
+                        let meta_string _loc s =
+                          Ast.PaStr (_loc, (safe_string_escaped s))
                           
                         let meta_int _loc s = Ast.PaInt (_loc, s)
                           
                         let meta_float _loc s = Ast.PaFlo (_loc, s)
                           
-                        let meta_char _loc s = Ast.PaChr (_loc, s)
+                        let meta_char _loc s =
+                          Ast.PaChr (_loc, (String.escaped s))
                           
                         let meta_bool _loc =
                           function
                 let drop_prev_loc = Tools.drop_prev_loc
                   
                 let add_loc bp parse_fun strm =
-                  let count1 = Stream.count strm in
                   let x = parse_fun strm in
-                  let count2 = Stream.count strm in
+                  let ep = loc_ep strm in
                   let loc =
-                    if count1 < count2
-                    then (let ep = loc_ep strm in Loc.merge bp ep)
-                    else Loc.join bp
+                    if (Loc.start_off bp) > (Loc.stop_off ep)
+                    then Loc.join bp
+                    else Loc.merge bp ep
                   in (x, loc)
                   
                 let stream_peek_nth strm n =
                        "Cannot print %S this identifier does not respect OCaml lexing rules (%s)"
                        str (Lexer.Error.to_string exn))
               
-            let ocaml_char x = match x with | "'" -> "\\'" | c -> c
+            let ocaml_char x = Char.escaped (Struct.Token.Eval.char x)
               
             let rec get_expr_args a al =
               match a with
                       | Ast.BiAnd (_, b1, b2) ->
                           (o#binding f b1; pp f o#andsep; o#binding f b2)
                       | Ast.BiEq (_, p, e) ->
-                          let (pl, e) =
+                          let (pl, e') =
                             (match p with
                              | Ast.PaTyc (_, _, _) -> ([], e)
                              | _ -> expr_fun_args e)
                           in
-                            (match (p, e) with
+                            (match (p, e') with
                              | (Ast.PaId (_, (Ast.IdLid (_, _))),
-                                Ast.ExTyc (_, e, t)) ->
+                                Ast.ExTyc (_, e', t)) ->
                                  pp f "%a :@ %a =@ %a"
                                    (list o#fun_binding "@ ")
-                                   ((`patt p) :: pl) o#ctyp t o#expr e
-                             | _ ->
+                                   ((`patt p) :: pl) o#ctyp t o#expr e'
+                             | (Ast.PaId (_, (Ast.IdLid (_, _))), _) ->
                                  pp f "%a @[<0>%a=@]@ %a" o#simple_patt p
-                                   (list' o#fun_binding "" "@ ") pl o#expr e)
+                                   (list' o#fun_binding "" "@ ") pl o#expr e'
+                             | _ -> pp f "%a =@ %a" o#simple_patt p o#expr e)
                       | Ast.BiAnt (_, s) -> o#anti f s
                 method record_binding =
                   fun f bi ->
                       | Ast.ExInt64 (_, s) -> o#numeric f s "L"
                       | Ast.ExInt32 (_, s) -> o#numeric f s "l"
                       | Ast.ExFlo (_, s) -> o#numeric f s ""
-                      | Ast.ExChr (_, s) -> pp f "'%s'" s
+                      | Ast.ExChr (_, s) -> pp f "'%s'" (ocaml_char s)
                       | Ast.ExId (_, i) -> o#var_ident f i
                       | Ast.ExRec (_, b, (Ast.ExNil _)) ->
                           pp f "@[<hv0>@[<hv2>{%a@]@ }@]" o#record_binding b
                       | Ast.PaInt32 (_, s) -> o#numeric f s "l"
                       | Ast.PaInt (_, s) -> o#numeric f s ""
                       | Ast.PaFlo (_, s) -> o#numeric f s ""
-                      | Ast.PaChr (_, s) -> pp f "'%s'" s
+                      | Ast.PaChr (_, s) -> pp f "'%s'" (ocaml_char s)
                       | Ast.PaLab (_, s, (Ast.PaNil _)) -> pp f "~%s" s
                       | Ast.PaVrn (_, s) -> pp f "`%a" o#var s
                       | Ast.PaTyp (_, i) -> pp f "@[<2>#%a@]" o#ident i
                            else ())
                       | Ast.TyCol (_, t1, (Ast.TyMut (_, t2))) ->
                           pp f "@[%a :@ mutable %a@]" o#ctyp t1 o#ctyp t2
+                      | Ast.TyMan (_, t1, t2) ->
+                          pp f "@[<2>%a ==@ %a@]" o#simple_ctyp t1 o#ctyp t2
                       | t -> super#ctyp f t
                 method simple_ctyp =
                   fun f t ->