Skip to content

Commit 77b6a3b

Browse files
cristianoccristianoc
committed
GenType: handle @as(_) in variant declarations.
This needs to be in sync with the compiler's runtime representation annotations.
1 parent b47de85 commit 77b6a3b

17 files changed

+109
-70
lines changed

‎CHANGELOG.md

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -47,7 +47,7 @@ These are only breaking changes for unformatted code.
4747
- Remove deprecated module `Printexc`
4848
- `@deriving(jsConverter)` not supported anymore for variant types https://github.com/rescript-lang/rescript-compiler/pull/6088
4949
- New representation for variants, where the tag is a string instead of a number. https://github.com/rescript-lang/rescript-compiler/pull/6088
50-
- 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.
50+
- 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
5151

5252
#### :bug: Bug Fix
5353

‎jscomp/core/js_exp_make.ml

Lines changed: 9 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -320,9 +320,18 @@ let true_ : t = { comment = None; expression_desc = Bool true }
320320
let false_ : t = { comment = None; expression_desc = Bool false }
321321
let bool v = if v then true_ else false_
322322

323+
let float ?comment f : t = { expression_desc = Number (Float { f }); comment }
324+
325+
let zero_float_lit : t =
326+
{ expression_desc = Number (Float { f = "0." }); comment = None }
327+
328+
let float_mod ?comment e1 e2 : J.expression =
329+
{ comment; expression_desc = Bin (Mod, e1, e2) }
330+
323331
let as_value = function
324332
| Lambda.AsString s -> str s ~delim:DStarJ
325333
| AsInt i -> small_int i
334+
| AsFloat f -> float f
326335
| AsBool b -> bool b
327336
| AsNull -> nil
328337
| AsUndefined -> undefined
@@ -550,21 +559,6 @@ let rec string_append ?comment (e : t) (el : t) : t =
550559
let obj ?comment properties : t =
551560
{ expression_desc = Object properties; comment }
552561

553-
(* currently only in method call, no dependency introduced
554-
*)
555-
556-
(** Arith operators *)
557-
(* Static_index .....................**)
558-
559-
let float ?comment f : t = { expression_desc = Number (Float { f }); comment }
560-
561-
let zero_float_lit : t =
562-
{ expression_desc = Number (Float { f = "0." }); comment = None }
563-
564-
let float_mod ?comment e1 e2 : J.expression =
565-
{ comment; expression_desc = Bin (Mod, e1, e2) }
566-
567-
568562
let str_equal (txt0:string) (delim0:External_arg_spec.delim) txt1 delim1 =
569563
if delim0 = delim1 then
570564
if Ext_string.equal txt0 txt1 then Some true

‎jscomp/core/js_stmt_make.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -138,7 +138,7 @@ let string_switch ?(comment : string option)
138138
match switch_case with
139139
| AsString s ->
140140
if s = txt then Some x.switch_body else None
141-
| AsInt _ | AsBool _ | AsNull | AsUnboxed | AsUndefined -> None)
141+
| AsInt _ | AsFloat _| AsBool _ | AsNull | AsUnboxed | AsUndefined -> None)
142142
with
143143
| Some case -> case
144144
| None -> ( match default with Some x -> x | None -> assert false)

‎jscomp/frontend/ast_attributes.ml

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -350,6 +350,11 @@ let process_as_value (attrs : t) =
350350
| Some i ->
351351
Bs_ast_invariant.mark_used_bs_attribute attr;
352352
st := Some (AsInt i));
353+
(match Ast_payload.is_single_float payload with
354+
| None -> ()
355+
| Some f ->
356+
Bs_ast_invariant.mark_used_bs_attribute attr;
357+
st := Some (AsFloat f));
353358
(match Ast_payload.is_single_bool payload with
354359
| None -> ()
355360
| Some b ->

‎jscomp/frontend/ast_payload.ml

Lines changed: 14 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -54,7 +54,6 @@ let is_single_string_as_ast (x : t) : Parsetree.expression option =
5454
Some e
5555
| _ -> None
5656

57-
(** TODO also need detect empty phrase case *)
5857
let is_single_int (x : t) : int option =
5958
match x with
6059
| PStr
@@ -69,6 +68,20 @@ let is_single_int (x : t) : int option =
6968
Some (int_of_string name)
7069
| _ -> None
7170

71+
let is_single_float (x : t) : string option =
72+
match x with
73+
| PStr
74+
[
75+
{
76+
pstr_desc =
77+
Pstr_eval
78+
({ pexp_desc = Pexp_constant (Pconst_float (name, _)); _ }, _);
79+
_;
80+
};
81+
] ->
82+
Some name
83+
| _ -> None
84+
7285
let is_single_bool (x : t) : bool option =
7386
match x with
7487
| PStr

‎jscomp/frontend/ast_payload.mli

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -39,6 +39,8 @@ val is_single_string_as_ast : t -> Parsetree.expression option
3939

4040
val is_single_int : t -> int option
4141

42+
val is_single_float : t -> string option
43+
4244
val is_single_bool : t -> bool option
4345

4446
val is_single_ident : t -> Longident.t option

‎jscomp/gentype/Annotation.ml

Lines changed: 9 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -19,9 +19,9 @@ let toString annotation =
1919

2020
let tagIsGenType s = s = "genType" || s = "gentype"
2121
let tagIsGenTypeAs s = s = "genType.as" || s = "gentype.as"
22-
let tagIsBsAs s = s = "bs.as" || s = "as"
23-
let tagIsBsInt s = s = "bs.int" || s = "int"
24-
let tagIsBsString s = s = "bs.string" || s = "string"
22+
let tagIsAs s = s = "bs.as" || s = "as"
23+
let tagIsInt s = s = "bs.int" || s = "int"
24+
let tagIsString s = s = "bs.string" || s = "string"
2525
let tagIsUnboxed s = s = "unboxed" || s = "ocaml.unboxed"
2626
let tagIsGenTypeImport s = s = "genType.import" || s = "gentype.import"
2727
let tagIsGenTypeOpaque s = s = "genType.opaque" || s = "gentype.opaque"
@@ -118,13 +118,15 @@ let checkUnsupportedGenTypeAsRenaming attributes =
118118
| Some (loc, _) -> error ~loc
119119
| None -> ())
120120

121-
let getBsAsRenaming attributes =
122-
match attributes |> getAttributePayload tagIsBsAs with
121+
let getAs attributes = attributes |> getAttributePayload tagIsAs
122+
123+
let getAsString attributes =
124+
match attributes |> getAttributePayload tagIsAs with
123125
| Some (_, StringPayload s) -> Some s
124126
| _ -> None
125127

126-
let getBsAsInt attributes =
127-
match attributes |> getAttributePayload tagIsBsAs with
128+
let getAsInt attributes =
129+
match attributes |> getAttributePayload tagIsAs with
128130
| Some (_, IntPayload s) -> (
129131
try Some (int_of_string s) with Failure _ -> None)
130132
| _ -> None

‎jscomp/gentype/GenTypeCommon.ml

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -9,6 +9,8 @@ type optional = Mandatory | Optional
99
type mutable_ = Immutable | Mutable
1010

1111
type labelJS =
12+
| NullLabel
13+
| UndefinedLabel
1214
| BoolLabel of bool
1315
| FloatLabel of string
1416
| IntLabel of string
@@ -43,6 +45,8 @@ let labelJSToString case =
4345
res.contents
4446
in
4547
match case.labelJS with
48+
| NullLabel -> "null"
49+
| UndefinedLabel -> "undefined"
4650
| BoolLabel b -> b |> string_of_bool
4751
| FloatLabel s -> s
4852
| IntLabel i -> i

‎jscomp/gentype/TranslateCoreType.ml

Lines changed: 9 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -173,25 +173,25 @@ and translateCoreType_ ~config ~typeVarsGen
173173
| Ttyp_variant (rowFields, _, _) -> (
174174
match rowFields |> processVariant with
175175
| {noPayloads; payloads; inherits} ->
176-
let bsString =
176+
let asString =
177177
coreType.ctyp_attributes
178-
|> Annotation.hasAttribute Annotation.tagIsBsString
178+
|> Annotation.hasAttribute Annotation.tagIsString
179179
in
180-
let bsInt =
180+
let asInt =
181181
coreType.ctyp_attributes
182-
|> Annotation.hasAttribute Annotation.tagIsBsInt
182+
|> Annotation.hasAttribute Annotation.tagIsInt
183183
in
184184
let lastBsInt = ref (-1) in
185185
let noPayloads =
186186
noPayloads
187187
|> List.map (fun (label, attributes) ->
188188
let labelJS =
189-
if bsString then
190-
match attributes |> Annotation.getBsAsRenaming with
189+
if asString then
190+
match attributes |> Annotation.getAsString with
191191
| Some labelRenamed -> StringLabel labelRenamed
192192
| None -> StringLabel label
193-
else if bsInt then (
194-
match attributes |> Annotation.getBsAsInt with
193+
else if asInt then (
194+
match attributes |> Annotation.getAsInt with
195195
| Some n ->
196196
lastBsInt := n;
197197
IntLabel (string_of_int n)
@@ -224,7 +224,7 @@ and translateCoreType_ ~config ~typeVarsGen
224224
in
225225
let inherits = inheritsTranslations |> List.map (fun {type_} -> type_) in
226226
let type_ =
227-
createVariant ~bsStringOrInt:(bsString || bsInt) ~noPayloads ~payloads
227+
createVariant ~bsStringOrInt:(asString || asInt) ~noPayloads ~payloads
228228
~inherits ~polymorphic:true
229229
in
230230
let dependencies =

‎jscomp/gentype/TranslateTypeDeclarations.ml

Lines changed: 18 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -20,14 +20,20 @@ let createExportTypeFromTypeDeclaration ~annotation ~loc ~nameAs ~opaque ~type_
2020
}
2121

2222
let createCase (label, attributes) =
23-
match
24-
attributes |> Annotation.getAttributePayload Annotation.tagIsGenTypeAs
25-
with
26-
| Some (_, BoolPayload b) -> {label; labelJS = BoolLabel b}
27-
| Some (_, FloatPayload s) -> {label; labelJS = FloatLabel s}
28-
| Some (_, IntPayload i) -> {label; labelJS = IntLabel i}
29-
| Some (_, StringPayload asLabel) -> {label; labelJS = StringLabel asLabel}
30-
| _ -> {label; labelJS = StringLabel label}
23+
{
24+
label;
25+
labelJS =
26+
(match
27+
attributes |> Annotation.getAttributePayload Annotation.tagIsAs
28+
with
29+
| Some (_, IdentPayload (Lident "null")) -> NullLabel
30+
| Some (_, IdentPayload (Lident "undefined")) -> UndefinedLabel
31+
| Some (_, BoolPayload b) -> BoolLabel b
32+
| Some (_, FloatPayload s) -> FloatLabel s
33+
| Some (_, IntPayload i) -> IntLabel i
34+
| Some (_, StringPayload asLabel) -> StringLabel asLabel
35+
| _ -> StringLabel label);
36+
}
3137

3238
(**
3339
* Rename record fields.
@@ -37,10 +43,8 @@ let createCase (label, attributes) =
3743
*)
3844
let renameRecordField ~attributes ~name =
3945
attributes |> Annotation.checkUnsupportedGenTypeAsRenaming;
40-
match attributes |> Annotation.getBsAsRenaming with
41-
| Some nameBS ->
42-
let escapedName = nameBS |> String.escaped in
43-
escapedName
46+
match attributes |> Annotation.getAsString with
47+
| Some s -> s |> String.escaped
4448
| None -> name
4549

4650
let traslateDeclarationKind ~config ~loc ~outputFileRelative ~resolver
@@ -221,8 +225,8 @@ let traslateDeclarationKind ~config ~loc ~outputFileRelative ~resolver
221225
constructorDeclarations
222226
|> List.map (fun constructorDeclaration ->
223227
let constructorArgs = constructorDeclaration.Types.cd_args in
224-
let name = constructorDeclaration.Types.cd_id |> Ident.name in
225-
let attributes = constructorDeclaration.Types.cd_attributes in
228+
let attributes = constructorDeclaration.cd_attributes in
229+
let name = constructorDeclaration.cd_id |> Ident.name in
226230
let argsTranslation =
227231
match constructorArgs with
228232
| Cstr_tuple typeExprs ->

0 commit comments

Comments
 (0)