diff --git a/CHANGELOG.md b/CHANGELOG.md index 346df05115..e8dd113c65 100644 --- a/CHANGELOG.md +++ b/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 diff --git a/jscomp/core/js_exp_make.ml b/jscomp/core/js_exp_make.ml index 51305a64cf..e71db5c86a 100644 --- a/jscomp/core/js_exp_make.ml +++ b/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 diff --git a/jscomp/core/js_stmt_make.ml b/jscomp/core/js_stmt_make.ml index 7af2c46912..4ce4a8ddab 100644 --- a/jscomp/core/js_stmt_make.ml +++ b/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) diff --git a/jscomp/frontend/ast_attributes.ml b/jscomp/frontend/ast_attributes.ml index b9ffe51bff..1204d90ac7 100644 --- a/jscomp/frontend/ast_attributes.ml +++ b/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 -> diff --git a/jscomp/frontend/ast_payload.ml b/jscomp/frontend/ast_payload.ml index afb5d333e9..118035db62 100644 --- a/jscomp/frontend/ast_payload.ml +++ 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 diff --git a/jscomp/frontend/ast_payload.mli b/jscomp/frontend/ast_payload.mli index 96c3d9e1d7..a5f1516431 100644 --- a/jscomp/frontend/ast_payload.mli +++ b/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 diff --git a/jscomp/gentype/Annotation.ml b/jscomp/gentype/Annotation.ml index 632d406851..6cce32d4f4 100644 --- a/jscomp/gentype/Annotation.ml +++ b/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 diff --git a/jscomp/gentype/GenTypeCommon.ml b/jscomp/gentype/GenTypeCommon.ml index a77371c4c3..ec3431c1a8 100644 --- a/jscomp/gentype/GenTypeCommon.ml +++ b/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 diff --git a/jscomp/gentype/TranslateCoreType.ml b/jscomp/gentype/TranslateCoreType.ml index 6af7576b62..8563745d3d 100644 --- a/jscomp/gentype/TranslateCoreType.ml +++ b/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 = diff --git a/jscomp/gentype/TranslateTypeDeclarations.ml b/jscomp/gentype/TranslateTypeDeclarations.ml index e5155f8c19..3d662766cf 100644 --- a/jscomp/gentype/TranslateTypeDeclarations.ml +++ b/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 -> diff --git a/jscomp/gentype_tests/typescript-react-example/src/MoreVariants.gen.tsx b/jscomp/gentype_tests/typescript-react-example/src/MoreVariants.gen.tsx index 5d11efc9ee..8095a4b284 100644 --- a/jscomp/gentype_tests/typescript-react-example/src/MoreVariants.gen.tsx +++ b/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"; diff --git a/jscomp/gentype_tests/typescript-react-example/src/Variants.gen.tsx b/jscomp/gentype_tests/typescript-react-example/src/Variants.gen.tsx index da51badee7..4adf4f1588 100644 --- a/jscomp/gentype_tests/typescript-react-example/src/Variants.gen.tsx +++ 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 diff --git a/jscomp/ml/lambda.ml b/jscomp/ml/lambda.ml index cacbf4af3f..bd5f6684f3 100644 --- a/jscomp/ml/lambda.ml +++ b/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 = diff --git a/jscomp/ml/lambda.mli b/jscomp/ml/lambda.mli index 2945e22095..5718493ecf 100644 --- a/jscomp/ml/lambda.mli +++ b/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 = diff --git a/jscomp/test/variantsMatching.gen.tsx b/jscomp/test/variantsMatching.gen.tsx new file mode 100644 index 0000000000..705fa23b40 --- /dev/null +++ b/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; diff --git a/jscomp/test/variantsMatching.js b/jscomp/test/variantsMatching.js index a3e4ba3132..4fd4b24d96 100644 --- a/jscomp/test/variantsMatching.js +++ b/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; diff --git a/jscomp/test/variantsMatching.res b/jscomp/test/variantsMatching.res index 4bec11859b..8aeb67961e 100644 --- a/jscomp/test/variantsMatching.res +++ b/jscomp/test/variantsMatching.res @@ -1,4 +1,10 @@ -type t = A | B | C | D | E +@@config({flags: ["-bs-gentype"]}) + +@genType +type t = | @as("thisIsA") A | @as(42) B | @as(null) C | D | @as(3.14) Pi + +@genType +type tNU = | @as(null) N | @as(undefined) U let toEnum = x => switch x { @@ -6,7 +12,7 @@ let toEnum = x => | B => 1 | C => 2 | D => 3 - | E => 4 + | Pi => 5 } let toString = x => @@ -15,14 +21,14 @@ let toString = x => | B => "B" | C => "C" | D => "D" - | E => "E" + | Pi => "Pi" } let bar = x => switch x { | A => 10 | B | C | D => 0 - | E => 10 + | Pi => 10 } type b = True | False