Change char payload (#709)

butterunderflow · web-flow · commit c6807e87c112 · 2022-10-31T12:57:15.000+08:00
* change Pconst_char payload(WIP)

* tweak &amp; tweak

* remove Char.chr

* tweak

* bugfix: correct escapes printer

* valid code point verification

* tweak

* take Res_utf8.repl back

* remove wrong simplification

* remove unneeded if-else

* format

* safe int to char to string

* remove Obj.magic in scanner

* remove string_of_int_as_char from stl to Pprintast

* refactor

* changelog
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -59,6 +59,7 @@
 #### :nail_care Polish
 
 - Change the internal representation of props for the lowercase components to record. https://github.com/rescript-lang/syntax/pull/665
+- Change the payload of Pconst_char for type safety. https://github.com/rescript-lang/rescript-compiler/pull/5759
 
 ## ReScript 10.0
 
diff --git a/compiler-libs-406/ast_helper.mli b/compiler-libs-406/ast_helper.mli
@@ -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
diff --git a/compiler-libs-406/asttypes.mli b/compiler-libs-406/asttypes.mli
@@ -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
diff --git a/compiler-libs-406/char.mli b/compiler-libs-406/char.mli
@@ -70,3 +70,4 @@ val equal: t -> t -> bool
 (* The following is for system use only. Do not call directly. *)
 
 external unsafe_chr : int -> char = "%identity"
+
diff --git a/compiler-libs-406/parmatch.ml b/compiler-libs-406/parmatch.ml
@@ -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 "%s" (Pprintast.string_of_int_as_char i)
 | Const_string (s, _) -> Printf.sprintf "%S" s
 | Const_float f -> Printf.sprintf "%s" f
 | Const_int32 i -> Printf.sprintf "%ldl" i
@@ -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
diff --git a/compiler-libs-406/parser.ml b/compiler-libs-406/parser.ml
diff --git a/compiler-libs-406/parsetree.mli b/compiler-libs-406/parsetree.mli
@@ -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"
diff --git a/compiler-libs-406/pprintast.ml b/compiler-libs-406/pprintast.ml
@@ -191,8 +191,24 @@ let rec longident f = function
 
 let longident_loc f x = pp f "%a" longident x.txt
 
+let string_of_int_as_char i =
+  let str = match Char.unsafe_chr i 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
+    | _ ->  Printf.sprintf "\\%d" i
+  in
+  Printf.sprintf "\'%s\'" str
+
 let constant f = function
-  | Pconst_char i -> pp f "%C"  i
+  | Pconst_char i -> pp f "%s" (string_of_int_as_char i)
   | Pconst_string (i, None) -> pp f "%S" i
   | 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
diff --git a/compiler-libs-406/pprintast.mli b/compiler-libs-406/pprintast.mli
@@ -24,3 +24,4 @@ val pattern: Format.formatter -> Parsetree.pattern -> unit
 val signature: Format.formatter -> Parsetree.signature -> unit
 val structure: Format.formatter -> Parsetree.structure -> unit
 val string_of_structure: Parsetree.structure -> string
+val string_of_int_as_char: int -> string
diff --git a/compiler-libs-406/printast.ml b/compiler-libs-406/printast.ml
@@ -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;
diff --git a/compiler-libs-406/typecore.ml b/compiler-libs-406/typecore.ml
@@ -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
@@ -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
@@ -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 ]
diff --git a/src/res_printer.ml b/src/res_printer.ml
@@ -553,7 +553,7 @@ let printConstant ?(templateLiteral = false) c =
   | Pconst_float (s, _) -> Doc.text s
   | Pconst_char c ->
     let str =
-      match c with
+      match Char.unsafe_chr c with
       | '\'' -> "\\'"
       | '\\' -> "\\\\"
       | '\n' -> "\\n"
@@ -564,7 +564,7 @@ let printConstant ?(templateLiteral = false) 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)
+      | _ -> Res_utf8.encodeCodePoint c
     in
     Doc.text ("'" ^ str ^ "'")
 
diff --git a/src/res_scanner.ml b/src/res_scanner.ml
@@ -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
@@ -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
+        if Res_utf8.isValidCodePoint c then c else Res_utf8.repl
       | _ ->
         (* 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)
@@ -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
@@ -865,7 +866,7 @@ let rec scan scanner =
             (String.sub [@doesNotRaise]) scanner.src offset length
           in
           next scanner;
-          Token.Codepoint {c = Obj.magic codepoint; original = contents})
+          Token.Codepoint {c = codepoint; original = contents})
         else (
           scanner.ch <- ch;
           scanner.offset <- offset;
diff --git a/src/res_token.ml b/src/res_token.ml
@@ -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

Original file line number	Diff line number	Diff line change
`@@ -70,3 +70,4 @@ val equal: t -> t -> bool`
`70`	`70`	`(* The following is for system use only. Do not call directly. *)`
`71`	`71`
`72`	`72`	`external unsafe_chr : int -> char = "%identity"`
	`73`	`+`