Fix unhandled cases for exotic idents

CHANGELOG.md

@@ -23,6 +23,10 @@
 - Remove obsolete `@bs.open` feature. https://github.com/rescript-lang/rescript-compiler/pull/6629
 - Drop Node.js version <18 support, due to it reaching End-of-Life. https://github.com/rescript-lang/rescript-compiler/pull/6429
 
+#### :bug: Bug Fix
+
+- Allow to use exotic ParscalCased identifiers for types. https://github.com/rescript-lang/rescript-compiler/pull/6777
+
 #### :house: Internal
 
 - Build with OCaml 5.1.1. https://github.com/rescript-lang/rescript-compiler/pull/6641

jscomp/ext/ext_ident.ml

@@ -132,6 +132,27 @@ let [@inline] no_escape (c : char) =
   | '0' .. '9' | '_' | '$' -> true 
   | _ -> false
 
+let is_uident name =
+  let len = String.length name in
+  if len > 0 then
+    match name.[0] with
+    | 'A' .. 'Z' -> true
+    | _ -> false
+  else false
+
+let is_uppercase_exotic name =
+  let len = String.length name in
+  len >= 3
+  && name.[0] = '\\'
+  && name.[1] = '\"'
+  && name.[len - 1] = '\"'
+
+let unwrap_uppercase_exotic name =
+  if is_uppercase_exotic name then
+   let len = String.length name in
+   String.sub name 2 (len - 3)
+  else name
+
 exception Not_normal_letter of int
 let name_mangle name =
   let len = String.length name  in

jscomp/ext/ext_ident.mli

@@ -48,7 +48,11 @@ val create_tmp :  ?name:string -> unit -> Ident.t
 
 val make_unused : unit -> Ident.t 
 
+val is_uident : string -> bool
 
+val is_uppercase_exotic : string -> bool
+
+val unwrap_uppercase_exotic : string -> string
 
 (**
    Invariant: if name is not converted, the reference should be equal

jscomp/syntax/src/res_ast_debugger.ml

@@ -54,7 +54,8 @@ module SexpAst = struct
     | [] -> [Sexp.list []]
     | items -> List.map f items
 
-  let string txt = Sexp.atom ("\"" ^ txt ^ "\"")
+  let string txt =
+    Sexp.atom ("\"" ^ Ext_ident.unwrap_uppercase_exotic txt ^ "\"")
 
   let char c = Sexp.atom ("'" ^ Char.escaped c ^ "'")
 

jscomp/syntax/src/res_outcome_printer.ml

@@ -8,70 +8,7 @@
  * In general it represent messages to show results or errors to the user. *)
 
 module Doc = Res_doc
-module Token = Res_token
-
-let rec unsafe_for_all_range s ~start ~finish p =
-  start > finish
-  || p (String.unsafe_get s start)
-     && unsafe_for_all_range s ~start:(start + 1) ~finish p
-
-let for_all_from s start p =
-  let len = String.length s in
-  unsafe_for_all_range s ~start ~finish:(len - 1) p
-
-(* See https://github.com/rescript-lang/rescript-compiler/blob/726cfa534314b586e5b5734471bc2023ad99ebd9/jscomp/ext/ext_string.ml#L510 *)
-let isValidNumericPolyvarNumber (x : string) =
-  let len = String.length x in
-  len > 0
-  &&
-  let a = Char.code (String.unsafe_get x 0) in
-  a <= 57
-  &&
-  if len > 1 then
-    a > 48
-    && for_all_from x 1 (function
-         | '0' .. '9' -> true
-         | _ -> false)
-  else a >= 48
-
-type identifierStyle = ExoticIdent | NormalIdent
-
-let classifyIdentContent ~allowUident txt =
-  let len = String.length txt in
-  let rec go i =
-    if i == len then NormalIdent
-    else
-      let c = String.unsafe_get txt i in
-      if
-        i == 0
-        && not
-             ((allowUident && c >= 'A' && c <= 'Z')
-             || (c >= 'a' && c <= 'z')
-             || c = '_')
-      then ExoticIdent
-      else if
-        not
-          ((c >= 'a' && c <= 'z')
-          || (c >= 'A' && c <= 'Z')
-          || c = '\'' || c = '_'
-          || (c >= '0' && c <= '9'))
-      then ExoticIdent
-      else go (i + 1)
-  in
-  if Token.isKeywordTxt txt then ExoticIdent else go 0
-
-let printIdentLike ~allowUident txt =
-  match classifyIdentContent ~allowUident txt with
-  | ExoticIdent -> Doc.concat [Doc.text "\\\""; Doc.text txt; Doc.text "\""]
-  | NormalIdent -> Doc.text txt
-
-let printPolyVarIdent txt =
-  (* numeric poly-vars don't need quotes: #644 *)
-  if isValidNumericPolyvarNumber txt then Doc.text txt
-  else
-    match classifyIdentContent ~allowUident:true txt with
-    | ExoticIdent -> Doc.concat [Doc.text "\""; Doc.text txt; Doc.text "\""]
-    | NormalIdent -> Doc.text txt
+module Printer = Res_printer
 
 (* ReScript doesn't have parenthesized identifiers.
  * We don't support custom operators. *)
@@ -119,7 +56,7 @@ let escapeStringContents s =
 
 let rec printOutIdentDoc ?(allowUident = true) (ident : Outcometree.out_ident) =
   match ident with
-  | Oide_ident s -> printIdentLike ~allowUident s
+  | Oide_ident s -> Printer.printIdentLike ~allowUident s
   | Oide_dot (ident, s) ->
     Doc.concat [printOutIdentDoc ident; Doc.dot; Doc.text s]
   | Oide_apply (call, arg) ->
@@ -189,7 +126,8 @@ let rec printOutTypeDoc (outType : Outcometree.out_type) =
                     Doc.space;
                     Doc.join ~sep:Doc.space
                       (List.map
-                         (fun lbl -> printIdentLike ~allowUident:true lbl)
+                         (fun lbl ->
+                           Printer.printIdentLike ~allowUident:true lbl)
                          tags);
                   ]));
            Doc.softLine;
@@ -400,7 +338,7 @@ and printOutVariant variant =
                  (Doc.concat
                     [
                       Doc.text "#";
-                      printPolyVarIdent name;
+                      Printer.printPolyVarIdent name;
                       (match types with
                       | [] -> Doc.nil
                       | types ->
@@ -530,7 +468,7 @@ and printRecordDeclRowDoc (name, mut, opt, arg) =
     (Doc.concat
        [
          (if mut then Doc.text "mutable " else Doc.nil);
-         printIdentLike ~allowUident:false name;
+         Printer.printIdentLike ~allowUident:false name;
          (if opt then Doc.text "?" else Doc.nil);
          Doc.text ": ";
          printOutTypeDoc arg;
@@ -733,7 +671,9 @@ let rec printOutSigItemDoc ?(printNameAsIs = false)
                   attrs;
                   kw;
                   (if printNameAsIs then Doc.text outTypeDecl.otype_name
-                   else printIdentLike ~allowUident:false outTypeDecl.otype_name);
+                   else
+                     Printer.printIdentLike ~allowUident:false
+                       outTypeDecl.otype_name);
                   typeParams;
                   kind;
                 ]);
@@ -865,7 +805,7 @@ and printOutExtensionConstructorDoc
     (Doc.concat
        [
          Doc.text "type ";
-         printIdentLike ~allowUident:false outExt.oext_type_name;
+         Printer.printIdentLike ~allowUident:false outExt.oext_type_name;
          typeParams;
          Doc.text " += ";
          Doc.line;
@@ -904,7 +844,7 @@ and printOutTypeExtensionDoc (typeExtension : Outcometree.out_type_extension) =
     (Doc.concat
        [
          Doc.text "type ";
-         printIdentLike ~allowUident:false typeExtension.otyext_name;
+         Printer.printIdentLike ~allowUident:false typeExtension.otyext_name;
          typeParams;
          Doc.text " += ";
          (if typeExtension.otyext_private = Asttypes.Private then

jscomp/syntax/src/res_printer.ml

@@ -399,6 +399,7 @@ let classifyIdentContent ?(allowUident = false) ?(allowHyphen = false) txt =
     loop 0
 
 let printIdentLike ?allowUident ?allowHyphen txt =
+  let txt = Ext_ident.unwrap_uppercase_exotic txt in
   match classifyIdentContent ?allowUident ?allowHyphen txt with
   | ExoticIdent -> Doc.concat [Doc.text "\\\""; Doc.text txt; Doc.text "\""]
   | NormalIdent -> Doc.text txt
@@ -432,6 +433,7 @@ let printPolyVarIdent txt =
   (* numeric poly-vars don't need quotes: #644 *)
   if isValidNumericPolyvarNumber txt then Doc.text txt
   else
+    let txt = Ext_ident.unwrap_uppercase_exotic txt in
     match classifyIdentContent ~allowUident:true txt with
     | ExoticIdent -> Doc.concat [Doc.text "\""; Doc.text txt; Doc.text "\""]
     | NormalIdent -> (

jscomp/syntax/src/res_printer.mli

@@ -22,4 +22,9 @@ val printImplementation :
 val printInterface :
   width:int -> Parsetree.signature -> comments:Res_comment.t list -> string
 
+val printIdentLike :
+  ?allowUident:bool -> ?allowHyphen:bool -> string -> Res_doc.t
+
+val printPolyVarIdent : string -> Res_doc.t
+
 val polyVarIdentToString : string -> string [@@live]

jscomp/syntax/src/res_scanner.ml

@@ -283,10 +283,10 @@ let scanNumber scanner =
   else Token.Int {i = literal; suffix}
 
 let scanExoticIdentifier scanner =
-  (* TODO: are we disregarding the current char...? Should be a quote *)
-  next scanner;
-  let buffer = Buffer.create 20 in
   let startPos = position scanner in
+  let startOff = scanner.offset in
+
+  next2 scanner;
 
   let rec scan () =
     match scanner.ch with
@@ -301,14 +301,24 @@ let scanExoticIdentifier scanner =
       let endPos = position scanner in
       scanner.err ~startPos ~endPos
         (Diagnostics.message "Did you forget a \" here?")
-    | ch ->
-      Buffer.add_char buffer ch;
+    | _ ->
       next scanner;
       scan ()
   in
   scan ();
-  (* TODO: do we really need to create a new buffer instead of substring once? *)
-  Token.Lident (Buffer.contents buffer)
+
+  let ident =
+    (String.sub [@doesNotRaise]) scanner.src startOff (scanner.offset - startOff)
+  in
+  let name = Ext_ident.unwrap_uppercase_exotic ident in
+  if name = String.empty then (
+    let endPos = position scanner in
+    scanner.err ~startPos ~endPos
+      (Diagnostics.message "A quoted identifier can't be empty string.");
+    Token.Lident ident)
+  else if Ext_ident.is_uident name then Token.Lident ident
+    (* Exotic ident with uppercase letter should be encoded to avoid confusing in OCaml parsetree *)
+  else Token.Lident name
 
 let scanStringEscapeSequence ~startPos scanner =
   let scan ~n ~base ~max =
@@ -746,9 +756,7 @@ let rec scan scanner =
       | _ ->
         next scanner;
         Token.Colon)
-    | '\\' ->
-      next scanner;
-      scanExoticIdentifier scanner
+    | '\\' -> scanExoticIdentifier scanner
     | '/' -> (
       match peek scanner with
       | '/' ->

jscomp/syntax/tests/parsing/errors/scanner/exoticIdent.res

@@ -1,3 +1,9 @@
+type \""
+
+type \"" = int
+
+let \""
+
 let \"a
 b
 c" = 1