Skip to content
This repository was archived by the owner on Jun 15, 2023. It is now read-only.

Change char payload #709

Merged
merged 16 commits into from
Oct 31, 2022
Merged
Show file tree
Hide file tree
Changes from 8 commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion compiler-libs-406/ast_helper.mli
Original file line number Diff line number Diff line change
Expand Up @@ -36,7 +36,7 @@ val with_default_loc: loc -> (unit -> 'a) -> 'a
(** {1 Constants} *)

module Const : sig
val char : char -> constant
val char : int -> constant
val string : ?quotation_delimiter:string -> string -> constant
val integer : ?suffix:char -> string -> constant
val int : ?suffix:char -> int -> constant
Expand Down
2 changes: 1 addition & 1 deletion compiler-libs-406/asttypes.mli
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
4 changes: 2 additions & 2 deletions compiler-libs-406/parmatch.ml
Original file line number Diff line number Diff line change
Expand Up @@ -376,7 +376,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 "%C" (Char.unsafe_chr i)
| Const_string (s, _) -> Printf.sprintf "%S" s
| Const_float f -> Printf.sprintf "%s" f
| Const_int32 i -> Printf.sprintf "%ldl" i
Expand Down Expand Up @@ -1093,7 +1093,7 @@ let build_other ext env = match env with
let rec find_other i imax =
if i > imax then raise Not_found
else
let ci = Char.chr i in
let ci = i in
if List.mem ci all_chars then
find_other (i+1) imax
else
Expand Down
13,672 changes: 6,234 additions & 7,438 deletions compiler-libs-406/parser.ml

Large diffs are not rendered by default.

2 changes: 1 addition & 1 deletion compiler-libs-406/parsetree.mli
Original file line number Diff line number Diff line change
Expand Up @@ -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"
Expand Down
2 changes: 1 addition & 1 deletion compiler-libs-406/pprintast.ml
Original file line number Diff line number Diff line change
Expand Up @@ -192,7 +192,7 @@ let rec longident f = function
let longident_loc f x = pp f "%a" longident x.txt

let constant f = function
| Pconst_char i -> pp f "%C" i
| Pconst_char i -> pp f "%C" (Char.unsafe_chr i) (* todo: consider safety *)
| Pconst_string (i, None) -> pp f "%S" i
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

same as above

| 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
Expand Down
2 changes: 1 addition & 1 deletion compiler-libs-406/printast.ml
Original file line number Diff line number Diff line change
Expand Up @@ -59,7 +59,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 (i) -> fprintf f "PConst_char %02x" i;
| 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;
Expand Down
6 changes: 3 additions & 3 deletions compiler-libs-406/typecore.ml
Original file line number Diff line number Diff line change
Expand Up @@ -1097,7 +1097,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
Expand Down Expand Up @@ -3804,7 +3804,7 @@ and type_format loc str env =
| Escaped_percent ->
mk_constr "Escaped_percent" []
| Scan_indic c ->
mk_constr "Scan_indic" [ mk_char c ]
mk_constr "Scan_indic" [ mk_char (Char.code c) ]
and mk_formatting_gen : type a b c d e f .
(a, b, c, d, e, f) formatting_gen -> Parsetree.expression =
fun fmting -> match fmting with
Expand Down Expand Up @@ -3954,7 +3954,7 @@ and type_format loc str env =
| String_literal (s, rest) ->
mk_constr "String_literal" [ mk_string s; mk_fmt rest ]
| Char_literal (c, rest) ->
mk_constr "Char_literal" [ mk_char c; mk_fmt rest ]
mk_constr "Char_literal" [ mk_char (Char.code c); mk_fmt rest ]
| Format_arg (pad_opt, fmtty, rest) ->
mk_constr "Format_arg" [
mk_int_opt pad_opt; mk_fmtty fmtty; mk_fmt rest ]
Expand Down
26 changes: 14 additions & 12 deletions src/res_printer.ml
Original file line number Diff line number Diff line change
Expand Up @@ -553,18 +553,20 @@ let printConstant ?(templateLiteral = false) c =
| Pconst_float (s, _) -> Doc.text s
| Pconst_char c ->
let str =
match c 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
| c -> Res_utf8.encodeCodePoint (Obj.magic c)
if c <= 127 then
match Char.chr c 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
| _ -> Res_utf8.encodeCodePoint c
else Res_utf8.encodeCodePoint c
in
Doc.text ("'" ^ str ^ "'")

Expand Down
21 changes: 11 additions & 10 deletions src/res_scanner.ml
Original file line number Diff line number Diff line change
Expand Up @@ -464,24 +464,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
Expand All @@ -508,14 +507,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
c
| _ ->
(* 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)
Expand Down Expand Up @@ -849,7 +847,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
Expand Down
2 changes: 1 addition & 1 deletion src/res_token.ml
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,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
Expand Down