Skip to content

Commit e7d4868

Browse files
authored
resolve aliases in untagged variants types (#6394)
* resolve aliases in untagged variants types * changelog
1 parent 8ee328b commit e7d4868

File tree

5 files changed

+54
-19
lines changed

5 files changed

+54
-19
lines changed

CHANGELOG.md

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -17,6 +17,7 @@
1717
- Support renaming fields in inline records with `@as` attribute. [#6391](https://github.com/rescript-lang/rescript-compiler/pull/6391)
1818
- Add builtin abstract types for File and Blob APIs. https://github.com/rescript-lang/rescript-compiler/pull/6383
1919
- Untagged variants: Support `promise`, RegExes, Dates, File and Blob. https://github.com/rescript-lang/rescript-compiler/pull/6383
20+
- Support aliased types as payloads to untagged variants. https://github.com/rescript-lang/rescript-compiler/pull/6394
2021

2122
# 11.0.0-rc.3
2223

jscomp/core/matching_polyfill.ml

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -23,6 +23,7 @@
2323
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
2424

2525
let () = Ast_untagged_variants.extract_concrete_typedecl := Ctype.extract_concrete_typedecl
26+
let () = Ast_untagged_variants.expand_head := Ctype.expand_head
2627

2728
let names_from_construct_pattern (pat : Typedtree.pattern) =
2829
let rec resolve_path n (path : Path.t) =

jscomp/ml/ast_untagged_variants.ml

Lines changed: 20 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -98,6 +98,8 @@ let extract_concrete_typedecl: (Env.t ->
9898
Types.type_expr ->
9999
Path.t * Path.t * Types.type_declaration) ref = ref (Obj.magic ())
100100

101+
let expand_head: (Env.t -> Types.type_expr -> Types.type_expr) ref = ref (Obj.magic ())
102+
101103
let process_tag_type (attrs : Parsetree.attributes) =
102104
let st : tag_type option ref = ref None in
103105
Ext_list.iter attrs (fun ({txt; loc}, payload) ->
@@ -158,34 +160,33 @@ let type_to_instanceof_backed_obj (t : Types.type_expr) =
158160
| _ -> None)
159161
| _ -> None
160162

161-
let get_block_type ~env (cstr : Types.constructor_declaration) :
162-
block_type option =
163-
match (process_untagged cstr.cd_attributes, cstr.cd_args) with
164-
| false, _ -> None
165-
| true, Cstr_tuple [{desc = Tconstr (path, _, _)}]
166-
when Path.same path Predef.path_string ->
163+
let get_block_type_from_typ ~env (t: Types.type_expr) : block_type option =
164+
let t = !expand_head env t in
165+
match t with
166+
| {desc = Tconstr (path, _, _)} when Path.same path Predef.path_string ->
167167
Some StringType
168-
| true, Cstr_tuple [{desc = Tconstr (path, _, _)}]
169-
when Path.same path Predef.path_int ->
168+
| {desc = Tconstr (path, _, _)} when Path.same path Predef.path_int ->
170169
Some IntType
171-
| true, Cstr_tuple [{desc = Tconstr (path, _, _)}]
172-
when Path.same path Predef.path_float ->
170+
| {desc = Tconstr (path, _, _)} when Path.same path Predef.path_float ->
173171
Some FloatType
174-
| true, Cstr_tuple [({desc = Tconstr _} as t)]
175-
when Ast_uncurried_utils.typeIsUncurriedFun t ->
172+
| ({desc = Tconstr _} as t) when Ast_uncurried_utils.typeIsUncurriedFun t ->
176173
Some FunctionType
177-
| true, Cstr_tuple [{desc = Tarrow _}] -> Some FunctionType
178-
| true, Cstr_tuple [{desc = Tconstr (path, _, _)}]
179-
when Path.same path Predef.path_string ->
174+
| {desc = Tarrow _} -> Some FunctionType
175+
| {desc = Tconstr (path, _, _)} when Path.same path Predef.path_string ->
180176
Some StringType
181-
| true, Cstr_tuple [({desc = Tconstr _} as t)] when type_is_builtin_object t
182-
->
177+
| ({desc = Tconstr _} as t) when type_is_builtin_object t ->
183178
Some ObjectType
184-
| true, Cstr_tuple [({desc = Tconstr _} as t)] when type_to_instanceof_backed_obj t |> Option.is_some
185-
->
179+
| ({desc = Tconstr _} as t) when type_to_instanceof_backed_obj t |> Option.is_some ->
186180
(match type_to_instanceof_backed_obj t with
187181
| None -> None
188182
| Some instanceType -> Some (InstanceType instanceType))
183+
| _ -> None
184+
185+
let get_block_type ~env (cstr : Types.constructor_declaration) :
186+
block_type option =
187+
match (process_untagged cstr.cd_attributes, cstr.cd_args) with
188+
| false, _ -> None
189+
| true, Cstr_tuple [{desc = Tconstr _} as t] when get_block_type_from_typ ~env t |> Option.is_some -> get_block_type_from_typ ~env t
189190
| true, Cstr_tuple [ty] -> (
190191
let default = Some UnknownType in
191192
match !extract_concrete_typedecl env ty with

jscomp/test/UntaggedVariants.js

Lines changed: 18 additions & 0 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

jscomp/test/UntaggedVariants.res

Lines changed: 14 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -413,3 +413,17 @@ module AllInstanceofTypes = {
413413
| Blob(blob) => Js.log(blob->blobSize)
414414
}
415415
}
416+
417+
module Aliased = {
418+
type dict = Js.Dict.t<string>
419+
type fn = (. unit) => option<string>
420+
@unboxed type t = Object(dict) | String(string) | Function(fn)
421+
422+
let test = (t: t) => {
423+
switch t {
424+
| Object(d) => d->Js.Dict.get("Hello")
425+
| String(s) => Some(s)
426+
| Function(fn) => fn(.)
427+
}
428+
}
429+
}

0 commit comments

Comments
 (0)