## Unicode support

This PR adds support for Unicode codepoints at the syntax level: ReScript source code is now unicode text encoded in UTF-8.

Fixes #397

### Codepoint literals

A codepoint literal represents an integer value identifying a unicode code point. It is expressed as one or more characters enclosed in single quotes. Examples are `’x’`, `’\n’` or `\u{00A9}`. Multiple UTF-8-encoded bytes may represent a single integer value.

### String literals

String literals are (possibly multi-byte) UTF-8 encoded character sequences between double quotes, as in `"fox"`.

### New escape sequences

Both codepoint and string literals accept the following new escape sequences:

1) Unicode escape sequences
Any character with a character code lower than 65536 can be escaped using the hexadecimal value of its character code, prefixed with `\u`. Unicode escapes are six characters long. They require exactly four characters following `\u` . If the hexadecimal character code is only one, two or three characters long, you’ll need to pad it with leading zeroes.
Example: `'\u2665'` (Represents ♥)

2) Unicode codepoint escape sequences
Any code point or character can be escaped using the hexadecimal value of its character code, prefixed with `\u{` and suffixed with `}` . This allows for code points up to 0x10FFFF, which is the highest code point defined by Unicode. Unicode code point escapes consist of at least five characters. At least one hexadecimal character can be wrapped in `\u{…}` . There is no upper limit on the number of hex digits in use (for example '\u{000000000061}' == 'a')
Example: `'\u{2318}'` (Represents ⌘)

Author: Iwan

.depend

@@ -12,9 +12,10 @@ src/res_comment.cmx : src/res_comment.cmi
 src/res_comment.cmi :
 src/res_comments_table.cmx : src/res_parsetree_viewer.cmx src/res_doc.cmx \
     src/res_comment.cmx
-src/res_core.cmx : src/res_token.cmx src/res_scanner.cmx src/res_printer.cmx \
-    src/res_parser.cmx src/res_js_ffi.cmx src/res_grammar.cmx src/res_doc.cmx \
-    src/res_diagnostics.cmx src/res_comments_table.cmx src/res_core.cmi
+src/res_core.cmx : src/res_utf8.cmx src/res_token.cmx src/res_scanner.cmx \
+    src/res_printer.cmx src/res_parser.cmx src/res_js_ffi.cmx \
+    src/res_grammar.cmx src/res_doc.cmx src/res_diagnostics.cmx \
+    src/res_comments_table.cmx src/res_core.cmi
 src/res_core.cmi : src/res_parser.cmi
 src/res_diagnostics.cmx : src/res_token.cmx src/res_grammar.cmx \
     src/res_diagnostics_printing_utils.cmx src/res_diagnostics.cmi
@@ -60,16 +61,19 @@ src/res_parser.cmi : src/res_token.cmx src/res_scanner.cmi \
     src/res_comment.cmi
 src/res_parsetree_viewer.cmx : src/res_parsetree_viewer.cmi
 src/res_parsetree_viewer.cmi :
-src/res_printer.cmx : src/res_token.cmx src/res_parsetree_viewer.cmx \
-    src/res_parens.cmx src/res_doc.cmx src/res_comments_table.cmx \
-    src/res_comment.cmx src/res_printer.cmi
+src/res_printer.cmx : src/res_utf8.cmx src/res_token.cmx \
+    src/res_parsetree_viewer.cmx src/res_parens.cmx src/res_doc.cmx \
+    src/res_comments_table.cmx src/res_comment.cmx src/res_printer.cmi
 src/res_printer.cmi : src/res_doc.cmi src/res_comments_table.cmx \
     src/res_comment.cmi
 src/res_reporting.cmx : src/res_token.cmx src/res_grammar.cmx
-src/res_scanner.cmx : src/res_token.cmx src/res_diagnostics.cmx \
-    src/res_comment.cmx src/res_scanner.cmi
+src/res_scanner.cmx : src/res_utf8.cmx src/res_token.cmx \
+    src/res_diagnostics.cmx src/res_comment.cmx src/res_scanner.cmi
 src/res_scanner.cmi : src/res_token.cmx src/res_diagnostics.cmi
 src/res_token.cmx : src/res_comment.cmx
-tests/res_test.cmx : src/res_token.cmx src/res_parser.cmx \
-    src/res_outcome_printer.cmx src/res_multi_printer.cmx src/res_io.cmx \
-    src/res_driver.cmx src/res_core.cmx
+src/res_utf8.cmx : src/res_utf8.cmi
+src/res_utf8.cmi :
+tests/res_test.cmx : tests/res_utf8_test.cmx src/res_token.cmx \
+    src/res_parser.cmx src/res_outcome_printer.cmx src/res_multi_printer.cmx \
+    src/res_io.cmx src/res_driver.cmx src/res_core.cmx
+tests/res_utf8_test.cmx : src/res_utf8.cmx

Makefile

@@ -24,6 +24,7 @@ API_FILES = \
 	src/res_parsetree_viewer.cmx\
 	src/res_parens.cmx\
 	src/res_comments_table.cmx\
+	src/res_utf8.cmx\
 	src/res_printer.cmx\
 	src/res_scanner.cmx\
 	src/res_js_ffi.cmx\
@@ -40,7 +41,7 @@ API_FILES = \
 
 CLI_FILES = $(API_FILES) src/res_cli.cmx
 
-TEST_FILES = $(API_FILES) tests/res_test.cmx
+TEST_FILES = $(API_FILES) tests/res_utf8_test.cmx tests/res_test.cmx
 
 .DEFAULT_GOAL := build-native
 

benchmarks/Benchmark.ml

@@ -6,7 +6,6 @@ module Printer = Res_printer
 
 module IO: sig
   val readFile: string -> string
-  val readStdin: unit -> string
 end = struct
   (* random chunk size: 2^15, TODO: why do we guess randomly? *)
   let chunkSize = 32768
@@ -26,21 +25,6 @@ end = struct
       )
     in
     loop ()
-
-  let readStdin () =
-    let buffer = Buffer.create chunkSize in
-    let chunk = (Bytes.create [@doesNotRaise]) chunkSize in
-    let rec loop () =
-      let len = try input stdin chunk 0 chunkSize with Invalid_argument _ -> 0 in
-      if len == 0 then (
-        close_in_noerr stdin;
-        Buffer.contents buffer
-      ) else (
-        Buffer.add_subbytes buffer chunk 0 len;
-        loop ()
-      )
-    in
-    loop ()
 end
 
 module Time: sig
@@ -188,29 +172,6 @@ end = struct
     done
 end
 
-module Profile: sig
-  val record : name:string -> (unit -> 'a) -> 'a
-  val print: unit -> unit
-end = struct
-  let state = Hashtbl.create 2
-
-  let record ~name f =
-    let startTime = Time.now() in
-    let result = f() in
-    let endTime = Time.now() in
-
-    Hashtbl.add state name (Time.diff startTime endTime);
-    result
-
-  let print () =
-    let report = Hashtbl.fold (fun k v acc ->
-      let line = Printf.sprintf "%s: %fms\n" k (Time.print v) in
-      acc ^ line
-    ) state "\n\n"
-    in
-    print_endline report
-end
-
 module Benchmarks: sig
   val run: unit -> unit
 end = struct

src/res_ast_debugger.ml

@@ -143,10 +143,13 @@ module SexpAst = struct
         string txt;
         optChar tag;
       ]
-    | Pconst_char c ->
+    | Pconst_char _ ->
+      Sexp.list [
+        Sexp.atom "Pconst_char";
+      ]
+    | Pconst_string(_, Some "INTERNAL_RES_CHAR_CONTENTS") ->
       Sexp.list [
         Sexp.atom "Pconst_char";
-        Sexp.atom (Char.escaped c);
       ]
     | Pconst_string (txt, tag) ->
       Sexp.list [

src/res_cli.ml

@@ -165,6 +165,7 @@ module ResClflags: sig
   val file: string ref
   val interface: bool ref
   val ppx: string ref
+  val typechecker: bool ref
 
   val parse: unit -> unit
 end = struct
@@ -176,6 +177,7 @@ end = struct
   let interface = ref false
   let ppx = ref ""
   let file = ref ""
+  let typechecker = ref false
 
   let usage = "\n**This command line is for the repo developer's testing purpose only. DO NOT use it in production**!\n\n" ^
   "Usage:\n  rescript <options> <file>\n\n" ^
@@ -192,6 +194,7 @@ end = struct
     ("-width", Arg.Int (fun w -> width := w), "Specify the line length for the printer (formatter)");
     ("-interface", Arg.Unit (fun () -> interface := true), "Parse as interface");
     ("-ppx", Arg.String (fun txt -> ppx := txt), "Apply a specific built-in ppx before parsing, none or jsx. Default: none");
+    ("-typechecker", Arg.Unit (fun () -> typechecker := true), "Parses the ast as it would be passed to the typechecker and not the printer")
   ]
 
   let parse () = Arg.parse spec (fun f -> file := f) usage
@@ -200,7 +203,7 @@ end
 module CliArgProcessor = struct
   type backend = Parser: ('diagnostics) Res_driver.parsingEngine -> backend [@@unboxed]
 
-  let processFile ~isInterface ~width ~recover ~origin ~target ~ppx filename =
+  let processFile ~isInterface ~width ~recover ~origin ~target ~ppx ~typechecker filename =
     let len = String.length filename in
     let processInterface =
       isInterface || len > 0 && (String.get [@doesNotRaise]) filename (len - 1) = 'i'
@@ -233,7 +236,7 @@ module CliArgProcessor = struct
     in
 
     let forPrinter = match target with
-    | "res" | "sexp" -> true
+    | "res" | "sexp" when not typechecker -> true
     | _ -> false
     in
 
@@ -292,5 +295,6 @@ let [@raises Invalid_argument, Failure, exit] () =
       ~target:!ResClflags.print
       ~origin:!ResClflags.origin
       ~ppx:!ResClflags.ppx
+      ~typechecker:!ResClflags.typechecker
       !ResClflags.file
 end

src/res_core.ml

@@ -143,6 +143,9 @@ type stringLiteralState =
   | HexEscape
   | DecimalEscape
   | OctalEscape
+  | UnicodeEscape
+  | UnicodeCodePointEscape
+  | UnicodeEscapeStart
   | EscapedLineBreak
 
 type typDefOrExt =
@@ -482,15 +485,12 @@ let processUnderscoreApplication args =
   in
   (args, wrap)
 
-let hexValue x =
-  match x with
-  | '0' .. '9' ->
-    (Char.code x) - 48
-  | 'A' .. 'Z' ->
-    (Char.code x) - 55
-  | 'a' .. 'z' ->
-    (Char.code x) - 97
-  | _ -> 16
+let hexValue ch =
+  match ch with
+  | '0'..'9' -> (Char.code ch) - 48
+  | 'a'..'f' -> (Char.code ch) - (Char.code 'a') + 10
+  | 'A'..'F' -> (Char.code ch) + 32 - (Char.code 'a') + 10
+  | _ -> 16 (* larger than any legal value *)
 
 let parseStringLiteral s =
   let len = String.length s in
@@ -499,7 +499,7 @@ let parseStringLiteral s =
   let rec parse state i d =
     if i = len then
       (match state with
-      | HexEscape | DecimalEscape | OctalEscape -> false
+      | HexEscape | DecimalEscape | OctalEscape | UnicodeEscape | UnicodeCodePointEscape -> false
       | _ -> true)
     else
       let c = String.unsafe_get s i in
@@ -517,6 +517,7 @@ let parseStringLiteral s =
         | ('\\' | ' ' | '\'' | '"') as c -> Buffer.add_char b c; parse Start (i + 1) d
         | 'x' -> parse HexEscape (i + 1) 0
         | 'o' -> parse OctalEscape (i + 1) 0
+        | 'u' -> parse UnicodeEscapeStart (i + 1) 0
         | '0' .. '9' -> parse DecimalEscape i 0
         | '\010' | '\013' -> parse EscapedLineBreak (i + 1) d
         | c -> Buffer.add_char b '\\'; Buffer.add_char b c; parse Start (i + 1) d)
@@ -558,6 +559,45 @@ let parseStringLiteral s =
           )
         else
           parse OctalEscape (i + 1) (d + 1)
+      | UnicodeEscapeStart ->
+        (match c with
+        | '{' -> parse UnicodeCodePointEscape (i + 1) 0
+        | _ -> parse UnicodeEscape (i + 1) 1)
+      | UnicodeEscape ->
+        if d == 3 then
+          let c0 = String.unsafe_get s (i - 3) in
+          let c1 = String.unsafe_get s (i - 2) in
+          let c2 = String.unsafe_get s (i - 1) in
+          let c3 = String.unsafe_get s i in
+          let c = (4096 * (hexValue c0)) + (256 * (hexValue c1)) + (16 * (hexValue c2)) + (hexValue c3) in
+          if Res_utf8.isValidCodePoint c then (
+            let codePoint = Res_utf8.encodeCodePoint c in
+            Buffer.add_string b codePoint;
+            parse Start (i + 1) 0
+          ) else (
+            false
+          )
+        else
+          parse UnicodeEscape (i + 1) (d + 1)
+      | UnicodeCodePointEscape ->
+        (match c with
+        | '0'..'9' | 'a'..'f' | 'A'.. 'F' ->
+          parse UnicodeCodePointEscape (i + 1) (d + 1)
+        | '}' ->
+          let x = ref 0 in
+          for remaining = d downto 1 do
+            let ix = i - remaining in
+            x := (!x * 16) + (hexValue (String.unsafe_get s ix));
+          done;
+          let c = !x in
+          if Res_utf8.isValidCodePoint c then (
+            let codePoint = Res_utf8.encodeCodePoint !x in
+            Buffer.add_string b codePoint;
+            parse Start (i + 1) 0
+          ) else (
+            false
+          )
+        | _ -> false)
       | EscapedLineBreak ->
         (match c with
         | ' ' | '\t' -> parse EscapedLineBreak (i + 1) d
@@ -877,7 +917,11 @@ let parseConstant p =
       s
     in
     Pconst_string(txt, None)
-  | Character c -> Pconst_char c
+  | Character {c; original} ->
+    if p.mode = ParseForTypeChecker then
+      Pconst_char c
+    else
+      Pconst_string (original, Some "INTERNAL_RES_CHAR_CONTENTS")
   | token ->
     Parser.err p (Diagnostics.unexpected token p.breadcrumbs);
     Pconst_string("", None)

src/res_outcome_printer.ml

@@ -348,7 +348,7 @@ let printPolyVarIdent txt =
       | [], [] -> Doc.nil
       | labels, types ->
         let i = ref 0 in
-        let package = Doc.join ~sep:Doc.line (List.map2 (fun lbl typ ->
+        let package = Doc.join ~sep:Doc.line ((List.map2 [@doesNotRaise]) (fun lbl typ ->
           Doc.concat [
             Doc.text (if i.contents > 0 then "and " else "with ");
             Doc.text lbl;

src/res_printer.ml

@@ -508,14 +508,32 @@ let printConstant c = match c with
       Doc.text "\"";
     ]
   | Pconst_string (txt, Some prefix) ->
-    Doc.concat [
-      if prefix = "js" then Doc.nil else Doc.text prefix;
-      Doc.text "`";
-      printStringContents txt;
-      Doc.text "`";
-    ]
+    if prefix = "INTERNAL_RES_CHAR_CONTENTS" then
+      Doc.concat [Doc.text "'"; Doc.text txt; Doc.text "'"]
+    else
+      Doc.concat [
+        if prefix = "js" then Doc.nil else Doc.text prefix;
+        Doc.text "`";
+        printStringContents txt;
+        Doc.text "`";
+      ]
   | Pconst_float (s, _) -> Doc.text s
-  | Pconst_char c -> Doc.text ("'" ^ (Char.escaped c) ^ "'")
+  | 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)
+    in
+    Doc.text ("'" ^ str ^ "'")
 
 let rec printStructure (s : Parsetree.structure) t =
   match s with