1. HongboZhang
  2. ocaml

Commits

garrigue  committed 0098a3c

bootstrap camlp4 to fix PR#5633 (slow parsing)

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

  • Participants
  • Parent commits fb5f767
  • Branches master

Comments (0)

Files changed (4)

File camlp4/Camlp4Filters/Camlp4MetaGenerator.ml

View file
  • Ignore whitespace
        let bi = mk_meta m in
        <:module_expr<
         struct
-          value meta_string _loc s = $m.str$ _loc s;
+          value meta_string _loc s = $m.str$ _loc (safe_string_escaped s);
           value meta_int _loc s = $m.int$ _loc s;
           value meta_float _loc s = $m.flo$ _loc s;
-          value meta_char _loc s = $m.chr$ _loc s;
+          value meta_char _loc s = $m.chr$ _loc (String.escaped s);
           value meta_bool _loc =
             fun
             [ False -> $m_uid m "False"$

File camlp4/boot/Camlp4.ml

View file
  • Ignore whitespace
               
             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
                        "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.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 ->

File camlp4/boot/Camlp4Ast.ml

View file
  • Ignore whitespace
             value meta_loc = meta_loc_expr;
             module Expr =
               struct
-                value meta_string _loc s = Ast.ExStr _loc (safe_string_escaped s);
+                value meta_string _loc s =
+                  Ast.ExStr _loc (safe_string_escaped s);
                 value meta_int _loc s = Ast.ExInt _loc s;
                 value meta_float _loc s = Ast.ExFlo _loc s;
                 value meta_char _loc s = Ast.ExChr _loc (String.escaped s);
             value meta_loc = meta_loc_patt;
             module Patt =
               struct
-                value meta_string _loc s = Ast.PaStr _loc s;
+                value meta_string _loc s =
+                  Ast.PaStr _loc (safe_string_escaped s);
                 value meta_int _loc s = Ast.PaInt _loc s;
                 value meta_float _loc s = Ast.PaFlo _loc s;
-                value meta_char _loc s = Ast.PaChr _loc s;
+                value meta_char _loc s = Ast.PaChr _loc (String.escaped s);
                 value meta_bool _loc =
                   fun
                   [ False -> Ast.PaId _loc (Ast.IdUid _loc "False")

File camlp4/boot/camlp4boot.ml

View file
  • Ignore whitespace
                     [ (None, (Some Camlp4.Sig.Grammar.RightA),
                        [ ([ Gram.Snterm
                               (Gram.Entry.obj
-                                 (labeled_ipatt :
-                                   'labeled_ipatt Gram.Entry.t));
+                                 (cvalue_binding :
+                                   'cvalue_binding Gram.Entry.t)) ],
+                          (Gram.Action.mk
+                             (fun (bi : 'cvalue_binding) (_loc : Gram.Loc.t)
+                                -> (bi : 'fun_binding))));
+                         ([ Gram.Stry
+                              (Gram.Snterm
+                                 (Gram.Entry.obj
+                                    (labeled_ipatt :
+                                      'labeled_ipatt Gram.Entry.t)));
                             Gram.Sself ],
                           (Gram.Action.mk
                              (fun (e : 'fun_binding) (p : 'labeled_ipatt)
                                    (Ast.McArr (_loc, p, (Ast.ExNil _loc), e))) :
                                   'fun_binding))));
                          ([ Gram.Stry
-                              (Gram.Snterm
-                                 (Gram.Entry.obj
-                                    (cvalue_binding :
-                                      'cvalue_binding Gram.Entry.t))) ],
-                          (Gram.Action.mk
-                             (fun (bi : 'cvalue_binding) (_loc : Gram.Loc.t)
-                                -> (bi : 'fun_binding))));
-                         ([ Gram.Stry
                               (Gram.srules fun_binding
                                  [ ([ Gram.Skeyword "("; Gram.Skeyword "type" ],
                                     (Gram.Action.mk