Skip to content

Commit a4f51f3

Browse files
cometkimcometkim
authored
Merge branch 'master' into drop-eol
2 parents 084a6e5 + 330b256 commit a4f51f3

File tree

19 files changed

+197
-49
lines changed

19 files changed

+197
-49
lines changed

‎CHANGELOG.md‎

Lines changed: 11 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -16,6 +16,17 @@
1616

1717
- Drop Node.js v16 support, due to it reaching End-of-Life. https://github.com/rescript-lang/rescript-compiler/pull/6429
1818

19+
#### :bug: Bug Fix
20+
21+
- Fix issue with dynamic import of module in nested expressions https://github.com/rescript-lang/rescript-compiler/pull/6431
22+
- Fix issue where GenType was not supporting `@tag` on ordinary variatns https://github.com/rescript-lang/rescript-compiler/pull/6437
23+
- Fix using dynamic import of module in block instead of async function https://github.com/rescript-lang/rescript-compiler/pull/6434
24+
- Fix issue with using dynamic import of module in uncurried mode https://github.com/rescript-lang/rescript-compiler/pull/6434
25+
26+
#### :nail_care: Polish
27+
28+
- Add [`Deno`](https://deno.land/api?s=Deno) to reserved names, so that modules named `Deno` don't clash with the globally exposed `Deno` object. https://github.com/rescript-lang/rescript-compiler/pull/6428
29+
1930
# 11.0.0-rc.4
2031

2132
#### :rocket: New Feature

‎jscomp/ext/js_reserved_map.ml‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -169,6 +169,7 @@ let sorted_keywords = [|
169169
"DecompressionStream";
170170
"DelayNode";
171171
"DelegatedInkTrailPresenter";
172+
"Deno";
172173
"Document";
173174
"DocumentFragment";
174175
"DocumentPictureInPictureEvent";

‎jscomp/frontend/bs_builtin_ppx.ml‎

Lines changed: 53 additions & 29 deletions
Original file line numberDiff line numberDiff line change
@@ -264,13 +264,29 @@ let expr_mapper ~async_context ~in_function_def (self : mapper)
264264
let async_saved = !async_context in
265265
let result = expr_mapper ~async_context ~in_function_def self e in
266266
async_context := async_saved;
267-
match Ast_attributes.has_await_payload e.pexp_attributes with
267+
let is_module, has_await =
268+
match e.pexp_desc with
269+
| Pexp_letmodule (_, {pmod_desc = Pmod_ident _; pmod_attributes}, _)
270+
| Pexp_letmodule
271+
( _,
272+
{
273+
pmod_desc =
274+
Pmod_constraint
275+
({pmod_desc = Pmod_ident _}, {pmty_desc = Pmty_ident _});
276+
pmod_attributes;
277+
},
278+
_ ) ->
279+
(true, Ast_attributes.has_await_payload pmod_attributes)
280+
| _ -> (false, Ast_attributes.has_await_payload e.pexp_attributes)
281+
in
282+
match has_await with
268283
| None -> result
269284
| Some _ ->
270285
if !async_context = false then
271286
Location.raise_errorf ~loc:e.pexp_loc
272287
"Await on expression not in an async context";
273-
Ast_await.create_await_expression result
288+
if is_module = false then Ast_await.create_await_expression result
289+
else result
274290

275291
let typ_mapper (self : mapper) (typ : Parsetree.core_type) =
276292
Ast_core_type_class_type.typ_mapper self typ
@@ -574,35 +590,43 @@ let rec structure_mapper ~await_context (self : mapper) (stru : Ast_structure.t)
574590
| Pstr_value (_, vbs) ->
575591
let item = self.structure_item self item in
576592
(* [ module __Belt_List__ = module type of Belt.List ] *)
577-
let module_type_decls =
578-
vbs
579-
|> List.filter_map (fun ({pvb_expr} : Parsetree.value_binding) ->
580-
match pvb_expr.pexp_desc with
581-
| Pexp_letmodule
582-
( _,
583-
({pmod_desc = Pmod_ident {txt; loc}; pmod_attributes} as
584-
me),
585-
_ )
586-
when Res_parsetree_viewer.hasAwaitAttribute pmod_attributes
587-
-> (
588-
let safe_module_type_name = local_module_type_name txt in
589-
let has_local_module_name =
590-
Hashtbl.find_opt !await_context safe_module_type_name
591-
in
593+
let rec spelunk_vbs acc vbs =
594+
match vbs with
595+
| [] -> acc
596+
| ({pvb_expr} : Parsetree.value_binding) :: tl ->
597+
let rec aux (expr : Parsetree.expression) =
598+
match expr.pexp_desc with
599+
| Pexp_letmodule
600+
( _,
601+
({pmod_desc = Pmod_ident {txt; loc}; pmod_attributes} as me),
602+
expr )
603+
when Res_parsetree_viewer.hasAwaitAttribute pmod_attributes -> (
604+
let safe_module_type_name = local_module_type_name txt in
605+
let has_local_module_name =
606+
Hashtbl.find_opt !await_context safe_module_type_name
607+
in
592608

593-
match has_local_module_name with
594-
| Some _ -> None
595-
| None ->
596-
Hashtbl.add !await_context safe_module_type_name
597-
safe_module_type_name;
598-
Some
599-
Ast_helper.(
600-
Str.modtype ~loc
601-
(Mtd.mk ~loc
602-
{txt = safe_module_type_name; loc}
603-
~typ:(Mty.typeof_ ~loc me))))
604-
| _ -> None)
609+
match has_local_module_name with
610+
| Some _ -> aux expr
611+
| None ->
612+
Hashtbl.add !await_context safe_module_type_name
613+
safe_module_type_name;
614+
Ast_helper.(
615+
Str.modtype ~loc
616+
(Mtd.mk ~loc
617+
{txt = safe_module_type_name; loc}
618+
~typ:(Mty.typeof_ ~loc me)))
619+
:: aux expr)
620+
| Pexp_let (_, vbs, expr) -> aux expr @ spelunk_vbs acc vbs
621+
| Pexp_ifthenelse (_, then_expr, Some else_expr) ->
622+
aux then_expr @ aux else_expr
623+
| Pexp_construct (_, Some expr) -> aux expr
624+
| Pexp_fun (_, _, _, expr) | Pexp_newtype (_, expr) -> aux expr
625+
| _ -> acc
626+
in
627+
aux pvb_expr @ spelunk_vbs acc tl
605628
in
629+
let module_type_decls = spelunk_vbs [] vbs in
606630

607631
module_type_decls @ (item :: structure_mapper ~await_context self rest)
608632
| _ ->

‎jscomp/gentype/Annotation.ml‎

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -22,6 +22,9 @@ let tagIsGenTypeAs s = s = "genType.as" || s = "gentype.as"
2222
let tagIsAs s = s = "bs.as" || s = "as"
2323
let tagIsInt s = s = "bs.int" || s = "int"
2424
let tagIsString s = s = "bs.string" || s = "string"
25+
26+
let tagIsTag s = s = "tag"
27+
2528
let tagIsUnboxed s = s = "unboxed" || s = "ocaml.unboxed"
2629
let tagIsGenTypeImport s = s = "genType.import" || s = "gentype.import"
2730
let tagIsGenTypeOpaque s = s = "genType.opaque" || s = "gentype.opaque"
@@ -146,6 +149,11 @@ let getAttributeImportRenaming attributes =
146149
(Some importString, Some renameString)
147150
| _ -> (None, genTypeAsRenaming)
148151

152+
let getTag attributes =
153+
match attributes |> getAttributePayload tagIsTag with
154+
| Some (_, StringPayload s) -> Some s
155+
| _ -> None
156+
149157
let getDocPayload attributes =
150158
let docPayload = attributes |> getAttributePayload tagIsDoc in
151159
match docPayload with

‎jscomp/gentype/EmitType.ml‎

Lines changed: 4 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -156,7 +156,7 @@ let rec renderType ~(config : Config.t) ?(indent = None) ~typeNameIsInterface
156156
|> String.concat ", ")
157157
^ "]"
158158
| TypeVar s -> s
159-
| Variant {inherits; noPayloads; payloads; polymorphic; unboxed} ->
159+
| Variant {inherits; noPayloads; payloads; polymorphic; tag; unboxed} ->
160160
let inheritsRendered =
161161
inherits
162162
|> List.map (fun type_ ->
@@ -183,7 +183,8 @@ let rec renderType ~(config : Config.t) ?(indent = None) ~typeNameIsInterface
183183
in
184184
let tagField =
185185
case |> labelJSToString
186-
|> field ~name:(Runtime.jsVariantTag ~polymorphic:false)
186+
|> field
187+
~name:(Runtime.jsVariantTag ~polymorphic:false ~tag)
187188
in
188189
match (unboxed, type_) with
189190
| true, type_ ->
@@ -198,7 +199,7 @@ let rec renderType ~(config : Config.t) ?(indent = None) ~typeNameIsInterface
198199
(* poly variant *)
199200
[
200201
case |> labelJSToString
201-
|> field ~name:(Runtime.jsVariantTag ~polymorphic);
202+
|> field ~name:(Runtime.jsVariantTag ~polymorphic ~tag);
202203
type_ |> render
203204
|> field ~name:(Runtime.jsVariantValue ~polymorphic);
204205
]

‎jscomp/gentype/GenTypeCommon.ml‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -99,6 +99,7 @@ and variant = {
9999
noPayloads: case list;
100100
payloads: payload list;
101101
polymorphic: bool; (* If true, this is a polymorphic variant *)
102+
tag: string option; (* The name of the tag field at runtime *)
102103
unboxed: bool;
103104
}
104105

@@ -168,8 +169,8 @@ let rec depToResolvedName (dep : dep) =
168169
| Internal resolvedName -> resolvedName
169170
| Dot (p, s) -> ResolvedName.dot s (p |> depToResolvedName)
170171

171-
let createVariant ~inherits ~noPayloads ~payloads ~polymorphic ~unboxed =
172-
Variant {inherits; noPayloads; payloads; polymorphic; unboxed}
172+
let createVariant ~inherits ~noPayloads ~payloads ~polymorphic ~tag ~unboxed =
173+
Variant {inherits; noPayloads; payloads; polymorphic; tag; unboxed}
173174

174175
let ident ?(builtin = true) ?(typeArgs = []) name =
175176
Ident {builtin; name; typeArgs}

‎jscomp/gentype/Runtime.ml‎

Lines changed: 5 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -24,10 +24,13 @@ let rec emitModuleAccessPath ~config moduleAccessPath =
2424
| Dot (p, moduleItem) ->
2525
p |> emitModuleAccessPath ~config |> EmitText.fieldAccess ~label:moduleItem
2626

27-
let jsVariantTag ~polymorphic =
27+
let jsVariantTag ~polymorphic ~tag =
2828
match polymorphic with
2929
| true -> "NAME"
30-
| false -> "TAG"
30+
| false -> (
31+
match tag with
32+
| Some tag -> tag
33+
| None -> "TAG")
3134

3235
let jsVariantPayloadTag ~n = "_" ^ string_of_int n
3336

‎jscomp/gentype/Runtime.mli‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -14,6 +14,6 @@ val newModuleItem : name:string -> moduleItem
1414
val newRecordValue : unboxed:bool -> recordGen -> recordValue
1515
val recordGen : unit -> recordGen
1616
val recordValueToString : recordValue -> string
17-
val jsVariantTag : polymorphic:bool -> string
17+
val jsVariantTag : polymorphic:bool -> tag:string option -> string
1818
val jsVariantPayloadTag : n:int -> string
1919
val jsVariantValue : polymorphic:bool -> string

‎jscomp/gentype/TranslateCoreType.ml‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -212,7 +212,7 @@ and translateCoreType_ ~config ~typeVarsGen
212212
let inherits = inheritsTranslations |> List.map (fun {type_} -> type_) in
213213
let type_ =
214214
createVariant ~noPayloads ~payloads ~inherits ~polymorphic:true
215-
~unboxed:false
215+
~tag:None ~unboxed:false
216216
in
217217
let dependencies =
218218
(inheritsTranslations

‎jscomp/gentype/TranslateTypeDeclarations.ml‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -66,6 +66,7 @@ let traslateDeclarationKind ~config ~loc ~outputFileRelative ~resolver
6666
let unboxedAnnotation =
6767
typeAttributes |> Annotation.hasAttribute Annotation.tagIsUnboxed
6868
in
69+
let tagAnnotation = typeAttributes |> Annotation.getTag in
6970
let returnTypeDeclaration (typeDeclaration : CodeItem.typeDeclaration) =
7071
match opaque = Some true with
7172
| true -> [{typeDeclaration with importTypes = []}]
@@ -203,7 +204,7 @@ let traslateDeclarationKind ~config ~loc ~outputFileRelative ~resolver
203204
else variant.payloads
204205
in
205206
createVariant ~inherits:variant.inherits ~noPayloads ~payloads
206-
~polymorphic:true ~unboxed:false
207+
~polymorphic:true ~tag:None ~unboxed:false
207208
| _ -> translation.type_
208209
in
209210
{translation with type_} |> handleGeneralDeclaration
@@ -295,7 +296,7 @@ let traslateDeclarationKind ~config ~loc ~outputFileRelative ~resolver
295296
in
296297
let variantTyp =
297298
createVariant ~inherits:[] ~noPayloads ~payloads ~polymorphic:false
298-
~unboxed:unboxedAnnotation
299+
~tag:tagAnnotation ~unboxed:unboxedAnnotation
299300
in
300301
let resolvedTypeName = typeName |> TypeEnv.addModulePath ~typeEnv in
301302
let exportFromTypeDeclaration =

0 commit comments

Comments
 (0)