Ekdohibs
/
ocaml
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Annotate constant literals with the location of their content.

master
Drup 2019-07-22 18:04:09 +02:00
parent 5050cc7ed1
commit abc53d1a6e
20 changed files with 99 additions and 89 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
boot/menhir/parser.ml
View File

@ -29,7 +29,7 @@ module MenhirBasics = struct
| STRUCT
| STRING of (
# 685 "parsing/parser.mly"
(string * string option)
(string * Location.t * string option)
# 34 "parsing/parser.ml"
)
| STAR
@ -196,12 +196,12 @@ module MenhirBasics = struct
)
| BRACEPERCENTPERCENTBRACE of (
# 687 "parsing/parser.mly"
(string * string * string option)
(string * string * Location.t * string option)
# 201 "parsing/parser.ml"
)
| BRACEPERCENTBRACE of (
# 686 "parsing/parser.mly"
(string * string * string option)
(string * string * Location.t * string option)
# 206 "parsing/parser.ml"
)
| BEGIN
@ -632,9 +632,9 @@ let wrap_sig_ext ~loc body ext =
let wrap_mksig_ext ~loc (item, ext) =
wrap_sig_ext ~loc (mksig ~loc item) ext
let mk_quotedext ~loc (id, content, delim) =
let mk_quotedext ~loc (id, content, strloc, delim) =
let exp_id = mkloc id (make_loc loc) in
let e = ghexp ~loc (Pexp_constant (Pconst_string (content, delim))) in
let e = ghexp ~loc (Pexp_constant (Pconst_string (content, strloc, delim))) in
(exp_id, PStr [mkstrexp e []])
let text_str pos = Str.text (rhs_text pos)
@ -6700,7 +6700,7 @@ module Tables = struct
} = _menhir_stack in
let _1 : (
# 685 "parsing/parser.mly"
(string * string option)
(string * Location.t * string option)
# 6705 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
@ -6708,7 +6708,7 @@ module Tables = struct
let _endpos = _endpos__1_ in
let _v : (Parsetree.constant) =
# 3358 "parsing/parser.mly"
( let (s, d) = _1 in Pconst_string (s, d) )
( let (s, strloc, d) = _1 in Pconst_string (s, strloc, d) )
# 6713 "parsing/parser.ml"
in
{
@ -12351,7 +12351,7 @@ module Tables = struct
} = _menhir_stack in
let _1 : (
# 686 "parsing/parser.mly"
(string * string * string option)
(string * string * Location.t * string option)
# 12356 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
@ -14416,7 +14416,7 @@ module Tables = struct
} = _menhir_stack in
let _1 : (
# 687 "parsing/parser.mly"
(string * string * string option)
(string * string * Location.t * string option)
# 14421 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
@ -22453,7 +22453,7 @@ module Tables = struct
} = _menhir_stack in
let s : (
# 685 "parsing/parser.mly"
(string * string option)
(string * Location.t * string option)
# 22458 "parsing/parser.ml"
) = Obj.magic s in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
@ -22461,7 +22461,7 @@ module Tables = struct
let _endpos = _endpos_s_ in
let _v : (string list) = let x =
# 3504 "parsing/parser.mly"
( fst s )
( let body, _, _ = s in body )
# 22466 "parsing/parser.ml"
in
@ -22494,7 +22494,7 @@ module Tables = struct
let xs : (string list) = Obj.magic xs in
let s : (
# 685 "parsing/parser.mly"
(string * string option)
(string * Location.t * string option)
# 22499 "parsing/parser.ml"
) = Obj.magic s in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
@ -22502,7 +22502,7 @@ module Tables = struct
let _endpos = _endpos_xs_ in
let _v : (string list) = let x =
# 3504 "parsing/parser.mly"
( fst s )
( let body, _, _ = s in body )
# 22507 "parsing/parser.ml"
in
@ -43028,7 +43028,7 @@ module Tables = struct
} = _menhir_stack in
let _1_inlined2 : (
# 685 "parsing/parser.mly"
(string * string option)
(string * Location.t * string option)
# 43033 "parsing/parser.ml"
) = Obj.magic _1_inlined2 in
let _1_inlined1 : (Asttypes.label) = Obj.magic _1_inlined1 in
@ -43041,7 +43041,7 @@ module Tables = struct
let x =
let _1 =
# 3486 "parsing/parser.mly"
( let (s, _) = _1 in Pdir_string s )
( let (s, _, _) = _1 in Pdir_string s )
# 43046 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in

6
boot/menhir/parser.mli
View File

@ -16,7 +16,7 @@ type token =
| TILDE
| THEN
| STRUCT
| STRING of (string * string option)
| STRING of (string * Location.t * string option)
| STAR
| SIG
| SEMISEMI
@ -111,8 +111,8 @@ type token =
| COLON
| CLASS
| CHAR of (char)
| BRACEPERCENTPERCENTBRACE of (string * string * string option)
| BRACEPERCENTBRACE of (string * string * string option)
| BRACEPERCENTPERCENTBRACE of (string * string * Location.t * string option)
| BRACEPERCENTBRACE of (string * string * Location.t * string option)
| BEGIN
| BARRBRACKET
| BARBAR

BIN
boot/ocamlc
View File

Binary file not shown.

BIN
boot/ocamllex
View File

Binary file not shown.

2
manual/tests/cross_reference_checker.ml
View File

@ -141,7 +141,7 @@ module OCaml_refs = struct
then None
else begin match attr.attr_payload with
| PStr [{pstr_desc= Pstr_eval
({ pexp_desc = Pexp_constant Pconst_string (s,_) },_) } ] ->
({ pexp_desc = Pexp_constant Pconst_string (s,_,_) },_) } ] ->
Some s
| _ -> print_error (Wrong_attribute_payload attr.attr_loc);
Some "" (* triggers an error *)

3
parsing/ast_helper.ml
View File

@ -40,7 +40,8 @@ module Const = struct
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 string ?quotation_delimiter s = Pconst_string (s, quotation_delimiter)
let string ?quotation_delimiter ?(loc= !default_loc) s =
Pconst_string (s, loc, quotation_delimiter)
end
module Attr = struct

3
parsing/ast_helper.mli
View File

@ -45,7 +45,8 @@ val with_default_loc: loc -> (unit -> 'a) -> 'a
module Const : sig
val char : char -> constant
val string : ?quotation_delimiter:string -> string -> constant
val string :
?quotation_delimiter:string -> ?loc:Location.t -> string -> constant
val integer : ?suffix:char -> string -> constant
val int : ?suffix:char -> int -> constant
val int32 : ?suffix:char -> int32 -> constant

12
parsing/ast_mapper.ml
View File

@ -731,16 +731,18 @@ let extension_of_error {kind; main; sub} =
let str_of_pp pp_msg = Format.asprintf "%t" pp_msg in
let extension_of_sub sub =
{ loc = sub.loc; txt = "ocaml.error" },
PStr ([Str.eval (Exp.constant (Pconst_string (str_of_pp sub.txt, None)))])
PStr ([Str.eval (Exp.constant
(Pconst_string (str_of_pp sub.txt, sub.loc, None)))])
in
{ loc = main.loc; txt = "ocaml.error" },
PStr (Str.eval (Exp.constant (Pconst_string (str_of_pp main.txt, None))) ::
PStr (Str.eval (Exp.constant
(Pconst_string (str_of_pp main.txt, main.loc, None))) ::
List.map (fun msg -> Str.extension (extension_of_sub msg)) sub)
let attribute_of_warning loc s =
Attr.mk
{loc; txt = "ocaml.ppwarning" }
(PStr ([Str.eval ~loc (Exp.constant (Pconst_string (s, None)))]))
(PStr ([Str.eval ~loc (Exp.constant (Pconst_string (s, loc, None)))]))
let cookies = ref String.Map.empty
@ -763,7 +765,7 @@ module PpxContext = struct
let lid name = { txt = Lident name; loc = Location.none }
let make_string x = Exp.constant (Pconst_string (x, None))
let make_string s = Exp.constant (Const.string s)
let make_bool x =
if x
@ -828,7 +830,7 @@ module PpxContext = struct
let restore fields =
let field name payload =
let rec get_string = function
| { pexp_desc = Pexp_constant (Pconst_string (str, None)) } -> str
| { pexp_desc = Pexp_constant (Pconst_string (str, _, None)) } -> str
| _ -> raise_errorf "Internal error: invalid [@@@ocaml.ppx.context \
{ %s }] string syntax" name
and get_bool pexp =

13
parsing/builtin_attributes.ml
View File

@ -17,7 +17,7 @@ open Asttypes
open Parsetree
let string_of_cst = function
| Pconst_string(s, _) -> Some s
| Pconst_string(s, _, _) -> Some s
| _ -> None
let string_of_payload = function
@ -36,7 +36,8 @@ let error_of_extension ext =
(({txt = ("ocaml.error"|"error"); loc}, p), _)} ->
begin match p with
| PStr([{pstr_desc=Pstr_eval
({pexp_desc=Pexp_constant(Pconst_string(msg,_))}, _)}]) ->
({pexp_desc=Pexp_constant(Pconst_string(msg,_,_))}, _)}
]) ->
{ Location.loc; txt = fun ppf -> Format.pp_print_text ppf msg }
| _ ->
{ Location.loc; txt = fun ppf ->
@ -56,7 +57,7 @@ let error_of_extension ext =
begin match p with
| PStr [] -> raise Location.Already_displayed_error
| PStr({pstr_desc=Pstr_eval
({pexp_desc=Pexp_constant(Pconst_string(msg,_))}, _)}::
({pexp_desc=Pexp_constant(Pconst_string(msg,_,_))}, _)}::
inner) ->
let sub = List.map (submessage_from loc txt) inner in
Location.error_of_printer ~loc ~sub Format.pp_print_text msg
@ -72,7 +73,7 @@ let kind_and_message = function
Pstr_eval
({pexp_desc=Pexp_apply
({pexp_desc=Pexp_ident{txt=Longident.Lident id}},
[Nolabel,{pexp_desc=Pexp_constant (Pconst_string(s,_))}])
[Nolabel,{pexp_desc=Pexp_constant (Pconst_string(s,_,_))}])
},_)}] ->
Some (id, s)
| PStr[
@ -187,7 +188,7 @@ let warning_attribute ?(ppwarning = true) =
let process_alert loc txt = function
| PStr[{pstr_desc=
Pstr_eval(
{pexp_desc=Pexp_constant(Pconst_string(s,_))},
{pexp_desc=Pexp_constant(Pconst_string(s,_,_))},
_)
}] ->
begin try Warnings.parse_alert_option s
@ -216,7 +217,7 @@ let warning_attribute ?(ppwarning = true) =
attr_payload =
PStr [
{ pstr_desc=
Pstr_eval({pexp_desc=Pexp_constant (Pconst_string (s, _))},_);
Pstr_eval({pexp_desc=Pexp_constant (Pconst_string (s, _, _))},_);
pstr_loc }
];
} when ppwarning ->

4
parsing/docstrings.ml
View File

@ -90,7 +90,7 @@ let doc_loc = {txt = "ocaml.doc"; loc = Location.none}
let docs_attr ds =
let open Parsetree in
let exp =
{ pexp_desc = Pexp_constant (Pconst_string(ds.ds_body, None));
{ pexp_desc = Pexp_constant (Pconst_string(ds.ds_body, ds.ds_loc, None));
pexp_loc = ds.ds_loc;
pexp_loc_stack = [];
pexp_attributes = []; }
@ -140,7 +140,7 @@ let text_loc = {txt = "ocaml.text"; loc = Location.none}
let text_attr ds =
let open Parsetree in
let exp =
{ pexp_desc = Pexp_constant (Pconst_string(ds.ds_body, None));
{ pexp_desc = Pexp_constant (Pconst_string(ds.ds_body, ds.ds_loc, None));
pexp_loc = ds.ds_loc;
pexp_loc_stack = [];
pexp_attributes = []; }

50
parsing/lexer.mll
View File

@ -125,14 +125,16 @@ let store_escaped_uchar lexbuf u =
if in_comment () then store_lexeme lexbuf else store_string_utf_8_uchar u
let with_string f lexbuf =
let loc_start = lexbuf.lex_curr_p in
reset_string_buffer();
is_in_string := true;
let string_start = lexbuf.lex_start_p in
string_start_loc := Location.curr lexbuf;
f lexbuf;
let loc_end = f lexbuf in
is_in_string := false;
lexbuf.lex_start_p <- string_start;
get_stored_string ()
let loc = Location.{loc_ghost= false; loc_start; loc_end} in
get_stored_string (), loc
let with_comment_buffer comment lexbuf =
let start_loc = Location.curr lexbuf in
@ -141,8 +143,8 @@ let with_comment_buffer comment lexbuf =
let end_loc = comment lexbuf in
let s = get_stored_string () in
reset_string_buffer ();
let loc = { start_loc with Location.loc_end = end_loc.Location.loc_end } in
s, loc
s,
{ start_loc with Location.loc_end = end_loc.Location.loc_end }
let error lexbuf e = raise (Error(e, Location.curr lexbuf))
let error_loc loc e = raise (Error(e, loc))
@ -401,23 +403,23 @@ rule token = parse
| (float_literal | hex_float_literal | int_literal) identchar+ as invalid
{ error lexbuf (Invalid_literal invalid) }
| "\""
{ let s = with_string string lexbuf in
STRING (s, None) }
{ let s, loc = with_string string lexbuf in
STRING (s, loc, None) }
| "{" (lowercase* as delim) "|"
{ let s = with_string (quoted_string delim) lexbuf in
STRING (s, Some delim) }
{ let s, loc = with_string (quoted_string delim) lexbuf in
STRING (s, loc, Some delim) }
| "{%" (extattrident as id) "|"
{ let s = with_string (quoted_string "") lexbuf in
BRACEPERCENTBRACE (id, s, Some "") }
| "{%" (extattrident as id) blank* (lowercase* as delim) "|"
{ let s = with_string (quoted_string delim) lexbuf in
BRACEPERCENTBRACE (id, s, Some delim) }
{ let s, loc = with_string (quoted_string "") lexbuf in
BRACEPERCENTBRACE (id, s, loc, Some "") }
| "{%" (extattrident as id) blank+ (lowercase* as delim) "|"
{ let s, loc = with_string (quoted_string delim) lexbuf in
BRACEPERCENTBRACE (id, s, loc, Some delim) }
| "{%%" (extattrident as id) "|"
{ let s = with_string (quoted_string "") lexbuf in
BRACEPERCENTPERCENTBRACE (id, s, Some "") }
| "{%%" (extattrident as id) blank* (lowercase* as delim) "|"
{ let s = with_string (quoted_string delim) lexbuf in
BRACEPERCENTPERCENTBRACE (id, s, Some delim) }
{ let s, loc = with_string (quoted_string "") lexbuf in
BRACEPERCENTPERCENTBRACE (id, s, loc, Some "") }
| "{%%" (extattrident as id) blank+ (lowercase* as delim) "|"
{ let s, loc = with_string (quoted_string delim) lexbuf in
BRACEPERCENTPERCENTBRACE (id, s, loc, Some delim) }
| "\'" newline "\'"
{ update_loc lexbuf None 1 false 1;
(* newline is ('\013'* '\010') *)
@ -587,7 +589,7 @@ and comment = parse
string_start_loc := Location.curr lexbuf;
store_string_char '\"';
is_in_string := true;
begin try string lexbuf
let _loc = try string lexbuf
with Error (Unterminated_string, str_start) ->
match !comment_start_loc with
| [] -> assert false
@ -595,7 +597,7 @@ and comment = parse
let start = List.hd (List.rev !comment_start_loc) in
comment_start_loc := [];
error_loc loc (Unterminated_string_in_comment (start, str_start))
end;
in
is_in_string := false;
store_string_char '\"';
comment lexbuf }
@ -604,7 +606,7 @@ and comment = parse
string_start_loc := Location.curr lexbuf;
store_lexeme lexbuf;
is_in_string := true;
begin try quoted_string delim lexbuf
let _loc = try quoted_string delim lexbuf
with Error (Unterminated_string, str_start) ->
match !comment_start_loc with
| [] -> assert false
@ -612,7 +614,7 @@ and comment = parse
let start = List.hd (List.rev !comment_start_loc) in
comment_start_loc := [];
error_loc loc (Unterminated_string_in_comment (start, str_start))
end;
in
is_in_string := false;
store_string_char '|';
store_string delim;
@ -656,7 +658,7 @@ and comment = parse
and string = parse
'\"'
{ () }
{ lexbuf.lex_start_p }
| '\\' newline ([' ' '\t'] * as space)
{ update_loc lexbuf None 1 false (String.length space);
if in_comment () then store_lexeme lexbuf;
@ -713,7 +715,7 @@ and quoted_string delim = parse
error_loc !string_start_loc Unterminated_string }
| "|" (lowercase* as edelim) "}"
{
if delim = edelim then ()
if delim = edelim then lexbuf.lex_start_p
else (store_lexeme lexbuf; quoted_string delim lexbuf)
}
| (_ as c)

16
parsing/parser.mly
View File

@ -418,9 +418,9 @@ let wrap_sig_ext ~loc body ext =
let wrap_mksig_ext ~loc (item, ext) =
wrap_sig_ext ~loc (mksig ~loc item) ext
let mk_quotedext ~loc (id, content, delim) =
let mk_quotedext ~loc (id, content, strloc, delim) =
let exp_id = mkloc id (make_loc loc) in
let e = ghexp ~loc (Pexp_constant (Pconst_string (content, delim))) in
let e = ghexp ~loc (Pexp_constant (Pconst_string (content, strloc, delim))) in
(exp_id, PStr [mkstrexp e []])
let text_str pos = Str.text (rhs_text pos)
@ -682,9 +682,9 @@ let mk_directive ~loc name arg =
%token <string> HASHOP
%token SIG
%token STAR
%token <string * string option> STRING
%token <string * string * string option> BRACEPERCENTBRACE
%token <string * string * string option> BRACEPERCENTPERCENTBRACE
%token <string * Location.t * string option> STRING
%token <string * string * Location.t * string option> BRACEPERCENTBRACE
%token <string * string * Location.t * string option> BRACEPERCENTPERCENTBRACE
%token STRUCT
%token THEN
%token TILDE
@ -3355,7 +3355,7 @@ meth_list:
constant:
| INT { let (n, m) = $1 in Pconst_integer (n, m) }
| CHAR { Pconst_char $1 }
| STRING { let (s, d) = $1 in Pconst_string (s, d) }
| STRING { let (s, strloc, d) = $1 in Pconst_string (s, strloc, d) }
| FLOAT { let (f, m) = $1 in Pconst_float (f, m) }
;
signed_constant:
@ -3483,7 +3483,7 @@ toplevel_directive:
;
%inline toplevel_directive_argument:
| STRING { let (s, _) = $1 in Pdir_string s }
| STRING { let (s, _, _) = $1 in Pdir_string s }
| INT { let (n, m) = $1 in Pdir_int (n ,m) }
| val_longident { Pdir_ident $1 }
| mod_longident { Pdir_ident $1 }
@ -3501,7 +3501,7 @@ toplevel_directive:
%inline raw_string:
s = STRING
{ fst s }
{ let body, _, _ = s in body }
;
name_tag:

4
parsing/parsetree.mli
View File

@ -31,9 +31,11 @@ type constant =
*)
| Pconst_char of char
(* 'c' *)
| Pconst_string of string * string option
| Pconst_string of string * Location.t * string option
(* "constant"
{delim|other constant|delim}
The location span the content of the string, without the delimiters.
*)
| Pconst_float of string * char option
(* 3.4 2e5 1.4e-4

4
parsing/pprintast.ml
View File

@ -221,9 +221,9 @@ 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) ->
| Pconst_string (i, _, None) ->
pp f "%S" i
| Pconst_string (i, Some delim) ->
| Pconst_string (i, _, Some delim) ->
pp f "{%s|%s|%s}" delim i delim
| Pconst_integer (i, None) ->
paren (first_is '-' i) (fun f -> pp f "%s") f i

7
parsing/printast.ml
View File

@ -64,9 +64,10 @@ 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_string (s, None) -> fprintf f "PConst_string(%S,None)" s;
| Pconst_string (s, Some delim) ->
fprintf f "PConst_string (%S,Some %S)" s delim;
| Pconst_string (s, strloc, None) ->
fprintf f "PConst_string(%S,%a,None)" s fmt_location strloc ;
| Pconst_string (s, strloc, Some delim) ->
fprintf f "PConst_string (%S,%a,Some %S)" s fmt_location strloc delim;
| Pconst_float (s,m) -> fprintf f "PConst_float (%s,%a)" s fmt_char_option m;
;;

2
testsuite/tests/parsing/extensions.compilers.reference
View File

@ -59,7 +59,7 @@
structure_item (extensions.ml[10,176+40]..[10,176+45])
Pstr_eval
expression (extensions.ml[10,176+40]..[10,176+45])
Pexp_constant PConst_string("foo",None)
Pexp_constant PConst_string("foo",(extensions.ml[10,176+41]..[10,176+44]),None)
]
]
structure_item (extensions.ml[12,224+0]..[12,224+26])

22
testsuite/tests/parsing/quotedextensions.compilers.reference
View File

@ -5,7 +5,7 @@
structure_item (quotedextensions.ml[10,170+0]..[10,170+23]) ghost
Pstr_eval
expression (quotedextensions.ml[10,170+0]..[10,170+23]) ghost
Pexp_constant PConst_string (" <hello>{x} ",Some "")
Pexp_constant PConst_string (" <hello>{x} ",(quotedextensions.ml[10,170+9]..[10,170+21]),Some "")
]
structure_item (quotedextensions.ml[11,194+0]..[11,194+32])
Pstr_extension "M.foo"
@ -13,7 +13,7 @@
structure_item (quotedextensions.ml[11,194+0]..[11,194+32]) ghost
Pstr_eval
expression (quotedextensions.ml[11,194+0]..[11,194+32]) ghost
Pexp_constant PConst_string (" <hello>{|x|} ",Some "bar")
Pexp_constant PConst_string (" <hello>{|x|} ",(quotedextensions.ml[11,194+13]..[11,194+27]),Some "bar")
]
structure_item (quotedextensions.ml[14,245+0]..[17,326+3])
Pstr_modtype "S" (quotedextensions.ml[14,245+12]..[14,245+13])
@ -26,7 +26,7 @@
structure_item (quotedextensions.ml[15,265+2]..[15,265+25]) ghost
Pstr_eval
expression (quotedextensions.ml[15,265+2]..[15,265+25]) ghost
Pexp_constant PConst_string (" <hello>{x} ",Some "")
Pexp_constant PConst_string (" <hello>{x} ",(quotedextensions.ml[15,265+11]..[15,265+23]),Some "")
]
signature_item (quotedextensions.ml[16,291+2]..[16,291+34])
Psig_extension "M.foo"
@ -34,7 +34,7 @@
structure_item (quotedextensions.ml[16,291+2]..[16,291+34]) ghost
Pstr_eval
expression (quotedextensions.ml[16,291+2]..[16,291+34]) ghost
Pexp_constant PConst_string (" <hello>{|x|} ",Some "bar")
Pexp_constant PConst_string (" <hello>{|x|} ",(quotedextensions.ml[16,291+15]..[16,291+29]),Some "bar")
]
]
structure_item (quotedextensions.ml[20,363+0]..[22,417+26])
@ -49,7 +49,7 @@
structure_item (quotedextensions.ml[20,363+4]..[20,363+26]) ghost
Pstr_eval
expression (quotedextensions.ml[20,363+4]..[20,363+26]) ghost
Pexp_constant PConst_string (" <hello>{x} ",Some "")
Pexp_constant PConst_string (" <hello>{x} ",(quotedextensions.ml[20,363+12]..[20,363+24]),Some "")
]
core_type (quotedextensions.ml[21,390+4]..[21,390+26])
Ptyp_extension "M.foo"
@ -57,7 +57,7 @@
structure_item (quotedextensions.ml[21,390+4]..[21,390+26]) ghost
Pstr_eval
expression (quotedextensions.ml[21,390+4]..[21,390+26]) ghost
Pexp_constant PConst_string (" <hello>{x} ",Some "")
Pexp_constant PConst_string (" <hello>{x} ",(quotedextensions.ml[21,390+12]..[21,390+24]),Some "")
]
expression (quotedextensions.ml[22,417+4]..[22,417+26])
Pexp_extension "M.foo"
@ -65,7 +65,7 @@
structure_item (quotedextensions.ml[22,417+4]..[22,417+26]) ghost
Pstr_eval
expression (quotedextensions.ml[22,417+4]..[22,417+26]) ghost
Pexp_constant PConst_string (" <hello>{x} ",Some "")
Pexp_constant PConst_string (" <hello>{x} ",(quotedextensions.ml[22,417+12]..[22,417+24]),Some "")
]
]
structure_item (quotedextensions.ml[23,444+0]..[25,516+35])
@ -80,7 +80,7 @@
structure_item (quotedextensions.ml[23,444+4]..[23,444+35]) ghost
Pstr_eval
expression (quotedextensions.ml[23,444+4]..[23,444+35]) ghost
Pexp_constant PConst_string (" <hello>{|x|} ",Some "bar")
Pexp_constant PConst_string (" <hello>{|x|} ",(quotedextensions.ml[23,444+16]..[23,444+30]),Some "bar")
]
core_type (quotedextensions.ml[24,480+4]..[24,480+35])
Ptyp_extension "M.foo"
@ -88,7 +88,7 @@
structure_item (quotedextensions.ml[24,480+4]..[24,480+35]) ghost
Pstr_eval
expression (quotedextensions.ml[24,480+4]..[24,480+35]) ghost
Pexp_constant PConst_string (" <hello>{|x|} ",Some "bar")
Pexp_constant PConst_string (" <hello>{|x|} ",(quotedextensions.ml[24,480+16]..[24,480+30]),Some "bar")
]
expression (quotedextensions.ml[25,516+4]..[25,516+35])
Pexp_extension "M.foo"
@ -96,7 +96,7 @@
structure_item (quotedextensions.ml[25,516+4]..[25,516+35]) ghost
Pstr_eval
expression (quotedextensions.ml[25,516+4]..[25,516+35]) ghost
Pexp_constant PConst_string (" <hello>{|x|} ",Some "bar")
Pexp_constant PConst_string (" <hello>{|x|} ",(quotedextensions.ml[25,516+16]..[25,516+30]),Some "bar")
]
]
structure_item (quotedextensions.ml[28,569+0]..[32,605+2])
@ -105,7 +105,7 @@
structure_item (quotedextensions.ml[28,569+0]..[32,605+2]) ghost
Pstr_eval
expression (quotedextensions.ml[28,569+0]..[32,605+2]) ghost
Pexp_constant PConst_string ("\n <hello>\n {x}\n </hello>\n",Some "")
Pexp_constant PConst_string ("\n <hello>\n {x}\n </hello>\n",(quotedextensions.ml[28,569+9]..[32,605+0]),Some "")
]
]

2
testsuite/tests/tool-ocamlc-stop-after/stop_after_parsing_impl.compilers.reference
View File

@ -24,7 +24,7 @@
<arg>
Nolabel
expression (stop_after_parsing_impl.ml[12,306+13]..[12,306+19])
Pexp_constant PConst_string("true",None)
Pexp_constant PConst_string("true",(stop_after_parsing_impl.ml[12,306+14]..[12,306+18]),None)
]
<arg>
Nolabel

6
typing/typecore.ml
View File

@ -216,7 +216,7 @@ let constant : Parsetree.constant -> (Asttypes.constant, error) result =
end
| Pconst_integer (i,Some c) -> Error (Unknown_literal (i, c))
| Pconst_char c -> Ok (Const_char c)
| Pconst_string (s,d) -> Ok (Const_string (s,d))
| Pconst_string (s,_,d) -> Ok (Const_string (s,d))
| Pconst_float (f,None)-> Ok (Const_float f)
| Pconst_float (f,Some c) -> Error (Unknown_literal (f, c))
@ -2470,7 +2470,7 @@ and type_expect_
exp_type = instance desc.val_type;
exp_attributes = sexp.pexp_attributes;
exp_env = env }
| Pexp_constant(Pconst_string (str, _) as cst) -> (
| Pexp_constant(Pconst_string (str, _, _) as cst) -> (
let cst = constant_or_raise env loc cst in
(* Terrible hack for format strings *)
let ty_exp = expand_head env ty_expected in
@ -3689,7 +3689,7 @@ and type_format loc str env =
mk_exp_loc (Pexp_construct (mk_lid_loc lid, arg)) in
let mk_cst cst = mk_exp_loc (Pexp_constant cst) in
let mk_int n = mk_cst (Pconst_integer (Int.to_string n, None))
and mk_string str = mk_cst (Pconst_string (str, None))
and mk_string str = mk_cst (Pconst_string (str, loc, None))
and mk_char chr = mk_cst (Pconst_char chr) in
let rec mk_formatting_lit fmting = match fmting with
| Close_box ->

2
typing/untypeast.ml
View File

@ -132,7 +132,7 @@ let rec extract_letop_patterns n pat =
let constant = function
| Const_char c -> Pconst_char c
| Const_string (s,d) -> Pconst_string (s,d)
| Const_string (s,d) -> Pconst_string (s,Location.none,d)
| Const_int i -> Pconst_integer (Int.to_string i, None)
| Const_int32 i -> Pconst_integer (Int32.to_string i, Some 'l')
| Const_int64 i -> Pconst_integer (Int64.to_string i, Some 'L')