GenType: handle @as(_) in variant declarations.

CHANGELOG.md

@@ -47,7 +47,7 @@ These are only breaking changes for unformatted code.
 - Remove deprecated module `Printexc`
 - `@deriving(jsConverter)` not supported anymore for variant types https://github.com/rescript-lang/rescript-compiler/pull/6088
 - New representation for variants, where the tag is a string instead of a number. https://github.com/rescript-lang/rescript-compiler/pull/6088
-- GenType: removed support for `@genType.as` for records and variants which has become unnecessary. Use the language's `@as` instead to channge the runtime representation without requiring any runtime conversion during FFI.
+- GenType: removed support for `@genType.as` for records and variants which has become unnecessary. Use the language's `@as` instead to channge the runtime representation without requiring any runtime conversion during FFI. https://github.com/rescript-lang/rescript-compiler/pull/6099 https://github.com/rescript-lang/rescript-compiler/pull/6101
 
 #### :bug: Bug Fix
 

jscomp/core/js_exp_make.ml

@@ -320,9 +320,18 @@ let true_ : t = { comment = None; expression_desc = Bool true }
 let false_ : t = { comment = None; expression_desc = Bool false }
 let bool v = if v then true_ else false_
 
+let float ?comment f : t = { expression_desc = Number (Float { f }); comment }
+
+let zero_float_lit : t =
+  { expression_desc = Number (Float { f = "0." }); comment = None }
+
+let float_mod ?comment e1 e2 : J.expression =
+  { comment; expression_desc = Bin (Mod, e1, e2) }
+
 let as_value = function
   | Lambda.AsString s -> str s ~delim:DStarJ
   | AsInt i -> small_int i
+  | AsFloat f -> float f
   | AsBool b -> bool b
   | AsNull -> nil
   | AsUndefined -> undefined
@@ -550,21 +559,6 @@ let rec string_append ?comment (e : t) (el : t) : t =
 let obj ?comment properties : t =
   { expression_desc = Object properties; comment }
 
-(* currently only in method call, no dependency introduced
-*)
-
-(** Arith operators *)
-(* Static_index .....................**)
-
-let float ?comment f : t = { expression_desc = Number (Float { f }); comment }
-
-let zero_float_lit : t =
-  { expression_desc = Number (Float { f = "0." }); comment = None }
-
-let float_mod ?comment e1 e2 : J.expression =
-  { comment; expression_desc = Bin (Mod, e1, e2) }
-
-
 let str_equal (txt0:string) (delim0:External_arg_spec.delim) txt1 delim1 =
   if delim0 = delim1 then
     if Ext_string.equal txt0 txt1 then Some true

jscomp/core/js_stmt_make.ml

@@ -138,7 +138,7 @@ let string_switch ?(comment : string option)
             match switch_case with
             | AsString s ->
               if s = txt then Some x.switch_body else None
-            | AsInt _ | AsBool _ | AsNull | AsUnboxed | AsUndefined -> None)
+            | AsInt _  | AsFloat _| AsBool _ | AsNull | AsUnboxed | AsUndefined -> None)
         with
         | Some case -> case
         | None -> ( match default with Some x -> x | None -> assert false)

jscomp/frontend/ast_attributes.ml

@@ -350,6 +350,11 @@ let process_as_value (attrs : t) =
             | Some i ->
                 Bs_ast_invariant.mark_used_bs_attribute attr;
                 st := Some (AsInt i));
+            (match Ast_payload.is_single_float payload with
+            | None -> ()
+            | Some f ->
+                Bs_ast_invariant.mark_used_bs_attribute attr;
+                st := Some (AsFloat f));
             (match Ast_payload.is_single_bool payload with
             | None -> ()
             | Some b ->

jscomp/frontend/ast_payload.ml

@@ -54,7 +54,6 @@ let is_single_string_as_ast (x : t) : Parsetree.expression option =
       Some e
   | _ -> None
 
-(** TODO also need detect empty phrase case *)
 let is_single_int (x : t) : int option =
   match x with
   | PStr
@@ -69,6 +68,20 @@ let is_single_int (x : t) : int option =
       Some (int_of_string name)
   | _ -> None
 
+let is_single_float (x : t) : string option =
+  match x with
+  | PStr
+      [
+        {
+          pstr_desc =
+            Pstr_eval
+              ({ pexp_desc = Pexp_constant (Pconst_float (name, _)); _ }, _);
+          _;
+        };
+      ] ->
+      Some name
+  | _ -> None
+
 let is_single_bool (x : t) : bool option =
   match x with
   | PStr

jscomp/frontend/ast_payload.mli

@@ -39,6 +39,8 @@ val is_single_string_as_ast : t -> Parsetree.expression option
 
 val is_single_int : t -> int option
 
+val is_single_float : t -> string option
+
 val is_single_bool : t -> bool option
 
 val is_single_ident : t -> Longident.t option

jscomp/gentype/Annotation.ml

@@ -19,9 +19,9 @@ let toString annotation =
 
 let tagIsGenType s = s = "genType" || s = "gentype"
 let tagIsGenTypeAs s = s = "genType.as" || s = "gentype.as"
-let tagIsBsAs s = s = "bs.as" || s = "as"
-let tagIsBsInt s = s = "bs.int" || s = "int"
-let tagIsBsString s = s = "bs.string" || s = "string"
+let tagIsAs s = s = "bs.as" || s = "as"
+let tagIsInt s = s = "bs.int" || s = "int"
+let tagIsString s = s = "bs.string" || s = "string"
 let tagIsUnboxed s = s = "unboxed" || s = "ocaml.unboxed"
 let tagIsGenTypeImport s = s = "genType.import" || s = "gentype.import"
 let tagIsGenTypeOpaque s = s = "genType.opaque" || s = "gentype.opaque"
@@ -118,13 +118,15 @@ let checkUnsupportedGenTypeAsRenaming attributes =
     | Some (loc, _) -> error ~loc
     | None -> ())
 
-let getBsAsRenaming attributes =
-  match attributes |> getAttributePayload tagIsBsAs with
+let getAs attributes = attributes |> getAttributePayload tagIsAs
+
+let getAsString attributes =
+  match attributes |> getAttributePayload tagIsAs with
   | Some (_, StringPayload s) -> Some s
   | _ -> None
 
-let getBsAsInt attributes =
-  match attributes |> getAttributePayload tagIsBsAs with
+let getAsInt attributes =
+  match attributes |> getAttributePayload tagIsAs with
   | Some (_, IntPayload s) -> (
     try Some (int_of_string s) with Failure _ -> None)
   | _ -> None

jscomp/gentype/GenTypeCommon.ml

@@ -9,6 +9,8 @@ type optional = Mandatory | Optional
 type mutable_ = Immutable | Mutable
 
 type labelJS =
+  | NullLabel
+  | UndefinedLabel
   | BoolLabel of bool
   | FloatLabel of string
   | IntLabel of string
@@ -43,6 +45,8 @@ let labelJSToString case =
     res.contents
   in
   match case.labelJS with
+  | NullLabel -> "null"
+  | UndefinedLabel -> "undefined"
   | BoolLabel b -> b |> string_of_bool
   | FloatLabel s -> s
   | IntLabel i -> i

jscomp/gentype/TranslateCoreType.ml

@@ -173,25 +173,25 @@ and translateCoreType_ ~config ~typeVarsGen
   | Ttyp_variant (rowFields, _, _) -> (
     match rowFields |> processVariant with
     | {noPayloads; payloads; inherits} ->
-      let bsString =
+      let asString =
         coreType.ctyp_attributes
-        |> Annotation.hasAttribute Annotation.tagIsBsString
+        |> Annotation.hasAttribute Annotation.tagIsString
       in
-      let bsInt =
+      let asInt =
         coreType.ctyp_attributes
-        |> Annotation.hasAttribute Annotation.tagIsBsInt
+        |> Annotation.hasAttribute Annotation.tagIsInt
       in
       let lastBsInt = ref (-1) in
       let noPayloads =
         noPayloads
         |> List.map (fun (label, attributes) ->
                let labelJS =
-                 if bsString then
-                   match attributes |> Annotation.getBsAsRenaming with
+                 if asString then
+                   match attributes |> Annotation.getAsString with
                    | Some labelRenamed -> StringLabel labelRenamed
                    | None -> StringLabel label
-                 else if bsInt then (
-                   match attributes |> Annotation.getBsAsInt with
+                 else if asInt then (
+                   match attributes |> Annotation.getAsInt with
                    | Some n ->
                      lastBsInt := n;
                      IntLabel (string_of_int n)
@@ -224,7 +224,7 @@ and translateCoreType_ ~config ~typeVarsGen
       in
       let inherits = inheritsTranslations |> List.map (fun {type_} -> type_) in
       let type_ =
-        createVariant ~bsStringOrInt:(bsString || bsInt) ~noPayloads ~payloads
+        createVariant ~bsStringOrInt:(asString || asInt) ~noPayloads ~payloads
           ~inherits ~polymorphic:true
       in
       let dependencies =

jscomp/gentype/TranslateTypeDeclarations.ml

@@ -20,14 +20,20 @@ let createExportTypeFromTypeDeclaration ~annotation ~loc ~nameAs ~opaque ~type_
   }
 
 let createCase (label, attributes) =
-  match
-    attributes |> Annotation.getAttributePayload Annotation.tagIsGenTypeAs
-  with
-  | Some (_, BoolPayload b) -> {label; labelJS = BoolLabel b}
-  | Some (_, FloatPayload s) -> {label; labelJS = FloatLabel s}
-  | Some (_, IntPayload i) -> {label; labelJS = IntLabel i}
-  | Some (_, StringPayload asLabel) -> {label; labelJS = StringLabel asLabel}
-  | _ -> {label; labelJS = StringLabel label}
+  {
+    label;
+    labelJS =
+      (match
+         attributes |> Annotation.getAttributePayload Annotation.tagIsAs
+       with
+       | Some (_, IdentPayload (Lident "null")) -> NullLabel
+       | Some (_, IdentPayload (Lident "undefined")) -> UndefinedLabel
+       | Some (_, BoolPayload b) -> BoolLabel b
+      | Some (_, FloatPayload s) -> FloatLabel s
+      | Some (_, IntPayload i) -> IntLabel i
+      | Some (_, StringPayload asLabel) -> StringLabel asLabel
+      | _ -> StringLabel label);
+  }
 
 (**
  * Rename record fields.
@@ -37,10 +43,8 @@ let createCase (label, attributes) =
 *)
 let renameRecordField ~attributes ~name =
   attributes |> Annotation.checkUnsupportedGenTypeAsRenaming;
-  match attributes |> Annotation.getBsAsRenaming with
-  | Some nameBS ->
-    let escapedName = nameBS |> String.escaped in
-    escapedName
+  match attributes |> Annotation.getAsString with
+  | Some s -> s |> String.escaped
   | None -> name
 
 let traslateDeclarationKind ~config ~loc ~outputFileRelative ~resolver
@@ -221,8 +225,8 @@ let traslateDeclarationKind ~config ~loc ~outputFileRelative ~resolver
       constructorDeclarations
       |> List.map (fun constructorDeclaration ->
              let constructorArgs = constructorDeclaration.Types.cd_args in
-             let name = constructorDeclaration.Types.cd_id |> Ident.name in
-             let attributes = constructorDeclaration.Types.cd_attributes in
+             let attributes = constructorDeclaration.cd_attributes in
+             let name = constructorDeclaration.cd_id |> Ident.name in
              let argsTranslation =
                match constructorArgs with
                | Cstr_tuple typeExprs ->

jscomp/gentype_tests/typescript-react-example/src/MoreVariants.gen.tsx

@@ -7,7 +7,7 @@ import * as MoreVariantsBS__Es6Import from './MoreVariants.bs';
 const MoreVariantsBS: any = MoreVariantsBS__Es6Import;
 
 // tslint:disable-next-line:interface-over-type-literal
-export type withRenaming = "type" | "b";
+export type withRenaming = "type_" | "b";
 
 // tslint:disable-next-line:interface-over-type-literal
 export type withoutRenaming = "type_" | "b";

jscomp/gentype_tests/typescript-react-example/src/Variants.gen.tsx

@@ -28,13 +28,13 @@ export type testGenTypeAs2 = "type_" | "module" | 42;
 export type testGenTypeAs3 = "type_" | "module" | 42;
 
 // tslint:disable-next-line:interface-over-type-literal
-export type x1 = "x" | "same";
+export type x1 = "x" | "x1";
 
 // tslint:disable-next-line:interface-over-type-literal
-export type x2 = "x" | "same";
+export type x2 = "x" | "x2";
 
 // tslint:disable-next-line:interface-over-type-literal
-export type type_ = "type";
+export type type_ = "Type";
 export type type = type_;
 
 // tslint:disable-next-line:interface-over-type-literal

jscomp/ml/lambda.ml

@@ -38,7 +38,7 @@ type record_repr =
   | Record_regular
   | Record_optional
 
-type as_value = AsString of string | AsInt of int | AsBool of bool | AsNull | AsUndefined | AsUnboxed
+type as_value = AsString of string | AsInt of int | AsFloat of string | AsBool of bool | AsNull | AsUndefined | AsUnboxed
 type cstr_name = {name: string; as_value: as_value option}
 
 type tag_info = 

jscomp/ml/lambda.mli

@@ -38,7 +38,7 @@ type record_repr =
   | Record_regular 
   | Record_optional
 
-type as_value = AsString of string | AsInt of int | AsBool of bool | AsNull | AsUndefined | AsUnboxed
+type as_value = AsString of string | AsInt of int | AsFloat of string | AsBool of bool | AsNull | AsUndefined | AsUnboxed
 type cstr_name = {name:string; as_value: as_value option}
 
 type tag_info = 

jscomp/test/variantsMatching.gen.tsx

@@ -0,0 +1,9 @@
+/* TypeScript file generated from variantsMatching.res by genType. */
+/* eslint-disable import/first */
+
+
+// tslint:disable-next-line:interface-over-type-literal
+export type t = "thisIsA" | 42 | null | "D" | 3.14;
+
+// tslint:disable-next-line:interface-over-type-literal
+export type tNU = null | undefined;

jscomp/test/variantsMatching.js

@@ -3,40 +3,40 @@
 
 function toEnum(x) {
   switch (x) {
-    case "A" :
+    case "thisIsA" :
         return 0;
-    case "B" :
+    case 42 :
         return 1;
-    case "C" :
+    case null :
         return 2;
     case "D" :
         return 3;
-    case "E" :
-        return 4;
+    case 3.14 :
+        return 5;
 
   }
 }
 
 function toString(x) {
   switch (x) {
-    case "A" :
+    case "thisIsA" :
         return "A";
-    case "B" :
+    case 42 :
         return "B";
-    case "C" :
+    case null :
         return "C";
     case "D" :
         return "D";
-    case "E" :
-        return "E";
+    case 3.14 :
+        return "Pi";
 
   }
 }
 
 function bar(x) {
   switch (x) {
-    case "A" :
-    case "E" :
+    case "thisIsA" :
+    case 3.14 :
         return 10;
     default:
       return 0;