summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--camlp4/Camlp4Filters/Camlp4MetaGenerator.ml4
-rw-r--r--camlp4/boot/Camlp4.ml30
-rw-r--r--camlp4/boot/Camlp4Ast.ml8
-rw-r--r--camlp4/boot/camlp4boot.ml20
4 files changed, 35 insertions, 27 deletions
diff --git a/camlp4/Camlp4Filters/Camlp4MetaGenerator.ml b/camlp4/Camlp4Filters/Camlp4MetaGenerator.ml
index b716d5afd..af338a2a1 100644
--- a/camlp4/Camlp4Filters/Camlp4MetaGenerator.ml
+++ b/camlp4/Camlp4Filters/Camlp4MetaGenerator.ml
@@ -161,10 +161,10 @@ value filter st =
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"$
diff --git a/camlp4/boot/Camlp4.ml b/camlp4/boot/Camlp4.ml
index 4030702ae..4d79a5390 100644
--- a/camlp4/boot/Camlp4.ml
+++ b/camlp4/boot/Camlp4.ml
@@ -3531,7 +3531,7 @@ module Struct =
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 =
@@ -3541,8 +3541,8 @@ module Struct =
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')
@@ -3581,8 +3581,8 @@ module Struct =
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))
| _ ->
@@ -7418,13 +7418,15 @@ module Struct =
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
@@ -9747,13 +9749,15 @@ module Struct =
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
@@ -18955,7 +18959,7 @@ module Printers =
"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
@@ -19484,7 +19488,7 @@ module Printers =
| 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
@@ -19629,7 +19633,7 @@ module Printers =
| 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
@@ -20487,6 +20491,8 @@ module Printers =
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 ->
diff --git a/camlp4/boot/Camlp4Ast.ml b/camlp4/boot/Camlp4Ast.ml
index a8d43cd4e..0b9a3de0a 100644
--- a/camlp4/boot/Camlp4Ast.ml
+++ b/camlp4/boot/Camlp4Ast.ml
@@ -471,7 +471,8 @@ module Make (Loc : Sig.Loc) : Sig.Camlp4Ast with module Loc = Loc =
value meta_loc = meta_loc_expr;
module Expr =
struct
- value meta_string _loc s = Ast.ExStr _loc (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);
@@ -2577,10 +2578,11 @@ module Make (Loc : Sig.Loc) : Sig.Camlp4Ast with module Loc = Loc =
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")
diff --git a/camlp4/boot/camlp4boot.ml b/camlp4/boot/camlp4boot.ml
index a434eea4f..9f7a6d7b0 100644
--- a/camlp4/boot/camlp4boot.ml
+++ b/camlp4/boot/camlp4boot.ml
@@ -3033,8 +3033,16 @@ New syntax:\
[ (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)
@@ -3043,14 +3051,6 @@ New syntax:\
(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
generated by cgit v1.2.3-70-g09d2 (git 2.46.0) at 2025-03-25 02:26:33 +0000