GenType: fix issue with @as("0") and other numbers.

There is some special code in the type emitter to take care of poly variants of the form e.g. `#0`, which is represented internally as the string "0".
This conflicts with normal variants annotated with `@as("0")` and such.

This PR resolves the case of numeric poly variants early on, and removes the special casing in the code emitter.

Fixes #6486

Author: cristianoc

CHANGELOG.md

@@ -21,6 +21,7 @@
 - Fix issue with GenType and `result` introduced in rc.5. https://github.com/rescript-lang/rescript-compiler/pull/6464
 - Fix compiler crash when inlining complex constants in pattern matching. https://github.com/rescript-lang/rescript-compiler/pull/6471
 - Fix issue with generating async functions inside loops. https://github.com/rescript-lang/rescript-compiler/pull/6479
+- Fix issue with Gentype and string annotations with numbers such as `@as("0")`. https://github.com/rescript-lang/rescript-compiler/pull/6487
 
 
 # 11.0.0-rc.5

jscomp/gentype/GenTypeCommon.ml

@@ -38,30 +38,29 @@ let isJSSafePropertyName name =
              | 'A' .. 'z' | '0' .. '9' -> true
              | _ -> false)
 
+let isNumber s =
+  let len = String.length s in
+  len > 0
+  && (match len > 1 with
+     | true -> (s.[0] [@doesNotRaise]) > '0'
+     | false -> true)
+  &&
+  let res = ref true in
+  for i = 0 to len - 1 do
+    match s.[i] [@doesNotRaise] with
+    | '0' .. '9' -> ()
+    | _ -> res := false
+  done;
+  res.contents
+
 let labelJSToString case =
-  let isNumber s =
-    let len = String.length s in
-    len > 0
-    && (match len > 1 with
-       | true -> (s.[0] [@doesNotRaise]) > '0'
-       | false -> true)
-    &&
-    let res = ref true in
-    for i = 0 to len - 1 do
-      match s.[i] [@doesNotRaise] with
-      | '0' .. '9' -> ()
-      | _ -> res := false
-    done;
-    res.contents
-  in
   match case.labelJS with
   | NullLabel -> "null"
   | UndefinedLabel -> "undefined"
   | BoolLabel b -> b |> string_of_bool
   | FloatLabel s -> s
   | IntLabel i -> i
-  | StringLabel s ->
-    if s = case.label && isNumber s then s else s |> EmitText.quotes
+  | StringLabel s -> s |> EmitText.quotes
 
 type closedFlag = Open | Closed
 

jscomp/gentype/TranslateCoreType.ml

@@ -178,7 +178,9 @@ and translateCoreType_ ~config ~typeVarsGen
                  if asString then
                    match attributes |> Annotation.getAsString with
                    | Some labelRenamed -> StringLabel labelRenamed
-                   | None -> StringLabel label
+                   | None ->
+                     if isNumber label then IntLabel label
+                     else StringLabel label
                  else if asInt then (
                    match attributes |> Annotation.getAsInt with
                    | Some n ->
@@ -187,6 +189,7 @@ and translateCoreType_ ~config ~typeVarsGen
                    | None ->
                      lastBsInt := !lastBsInt + 1;
                      IntLabel (string_of_int !lastBsInt))
+                 else if isNumber label then IntLabel label
                  else StringLabel label
                in
                {label; labelJS})
@@ -202,7 +205,13 @@ and translateCoreType_ ~config ~typeVarsGen
         payloadsTranslations
         |> List.map (fun (label, _attributes, translation) ->
                {
-                 case = {label; labelJS = StringLabel label};
+                 case =
+                   {
+                     label;
+                     labelJS =
+                       (if isNumber label then IntLabel label
+                       else StringLabel label);
+                   };
                  t = translation.type_;
                })
       in

jscomp/gentype/TranslateTypeDeclarations.ml

@@ -21,7 +21,7 @@ let createExportTypeFromTypeDeclaration ~annotation ~loc ~nameAs ~opaque ~type_
     annotation;
   }
 
-let createCase (label, attributes) =
+let createCase (label, attributes) ~poly =
   {
     label;
     labelJS =
@@ -34,7 +34,8 @@ let createCase (label, attributes) =
       | Some (_, FloatPayload s) -> FloatLabel s
       | Some (_, IntPayload i) -> IntLabel i
       | Some (_, StringPayload asLabel) -> StringLabel asLabel
-      | _ -> StringLabel label);
+      | _ ->
+        if poly && isNumber label then IntLabel label else StringLabel label);
   }
 
 (**
@@ -190,7 +191,9 @@ let traslateDeclarationKind ~config ~loc ~outputFileRelative ~resolver
       match (coreType, translation.type_) with
       | {ctyp_desc = Ttyp_variant (rowFields, _, _)}, Variant variant ->
         let rowFieldsVariants = rowFields |> TranslateCoreType.processVariant in
-        let noPayloads = rowFieldsVariants.noPayloads |> List.map createCase in
+        let noPayloads =
+          rowFieldsVariants.noPayloads |> List.map (createCase ~poly:true)
+        in
         let payloads =
           if
             variant.payloads |> List.length
@@ -199,7 +202,7 @@ let traslateDeclarationKind ~config ~loc ~outputFileRelative ~resolver
             (List.combine variant.payloads rowFieldsVariants.payloads
              [@doesNotRaise])
             |> List.map (fun (payload, (label, attributes, _)) ->
-                   let case = (label, attributes) |> createCase in
+                   let case = (label, attributes) |> createCase ~poly:true in
                    {payload with case})
           else variant.payloads
         in
@@ -277,7 +280,10 @@ let traslateDeclarationKind ~config ~loc ~outputFileRelative ~resolver
       variantsNoPayload
       |> List.map
            (fun (name, attributes, _argTypes, _importTypes, recordValue) ->
-             {((name, attributes) |> createCase) with label = recordValue})
+             {
+               ((name, attributes) |> createCase ~poly:false) with
+               label = recordValue;
+             })
     in
     let payloads =
       variantsWithPayload
@@ -290,7 +296,10 @@ let traslateDeclarationKind ~config ~loc ~outputFileRelative ~resolver
              in
              {
                case =
-                 {((name, attributes) |> createCase) with label = recordValue};
+                 {
+                   ((name, attributes) |> createCase ~poly:false) with
+                   label = recordValue;
+                 };
                t = type_;
              })
     in

jscomp/gentype/TranslateTypeExprFromTypes.ml

@@ -382,7 +382,13 @@ and translateTypeExprFromTypes_ ~config ~typeVarsGen ~typeEnv
     | {noPayloads; payloads = []; unknowns = []} ->
       let noPayloads =
         noPayloads
-        |> List.map (fun label -> {label; labelJS = StringLabel label})
+        |> List.map (fun label ->
+               {
+                 label;
+                 labelJS =
+                   (if isNumber label then IntLabel label
+                   else StringLabel label);
+               })
       in
       let type_ =
         createVariant ~inherits:[] ~noPayloads ~payloads:[] ~polymorphic:true

jscomp/gentype_tests/typescript-react-example/package-lock.json

@@ -16,6 +16,14 @@ export type r2 = string;
 
 export type t = number[] | number | ((_1:number) => number);
 
+export type tabIndex = "0" | "1";
+
 export const testV1: (x:v1) => v1 = UnboxedBS.testV1;
 
 export const r2Test: (x:r2) => r2 = UnboxedBS.r2Test;
+
+export const a: tabIndex = UnboxedBS.a;
+
+export const b: tabIndex = UnboxedBS.b;
+
+export const zero: 0 = UnboxedBS.zero;

jscomp/gentype_tests/typescript-react-example/src/Unboxed.bs.js

@@ -15,4 +15,16 @@ type r2 = B({g: string})
 @genType let r2Test = (x: r2) => x
 
 @genType @unboxed
-type t = Array(array<int>) | Record({x:int}) | Function((. int) => int)
+type t = Array(array<int>) | Record({x: int}) | Function((. int) => int)
+
+@genType
+type tabIndex = | @as("0") Activity | @as("1") UserKeyword
+
+@genType
+let a = Activity
+
+@genType
+let b = UserKeyword
+
+@genType
+let zero = #0