resolve aliases in untagged variants types (#6394)

* resolve aliases in untagged variants types

* changelog

Author: zth

CHANGELOG.md

@@ -17,6 +17,7 @@
 - Support renaming fields in inline records with `@as` attribute. [#6391](https://github.com/rescript-lang/rescript-compiler/pull/6391)
 - Add builtin abstract types for File and Blob APIs. https://github.com/rescript-lang/rescript-compiler/pull/6383
 - Untagged variants: Support `promise`, RegExes, Dates, File and Blob. https://github.com/rescript-lang/rescript-compiler/pull/6383
+- Support aliased types as payloads to untagged variants. https://github.com/rescript-lang/rescript-compiler/pull/6394
 
 # 11.0.0-rc.3
 

jscomp/core/matching_polyfill.ml

@@ -23,6 +23,7 @@
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
 let () = Ast_untagged_variants.extract_concrete_typedecl := Ctype.extract_concrete_typedecl
+let () = Ast_untagged_variants.expand_head := Ctype.expand_head
 
 let names_from_construct_pattern (pat : Typedtree.pattern) =
   let rec resolve_path n (path : Path.t) =

jscomp/ml/ast_untagged_variants.ml

@@ -98,6 +98,8 @@ let extract_concrete_typedecl: (Env.t ->
   Types.type_expr ->
   Path.t * Path.t * Types.type_declaration) ref = ref (Obj.magic ())
 
+let expand_head: (Env.t -> Types.type_expr -> Types.type_expr) ref = ref (Obj.magic ())
+
 let process_tag_type (attrs : Parsetree.attributes) =
   let st : tag_type option ref = ref None in
   Ext_list.iter attrs (fun ({txt; loc}, payload) ->
@@ -158,34 +160,33 @@ let type_to_instanceof_backed_obj (t : Types.type_expr) =
     | _ -> None)
   | _ -> None
 
-let get_block_type ~env (cstr : Types.constructor_declaration) :
-    block_type option =
-  match (process_untagged cstr.cd_attributes, cstr.cd_args) with
-  | false, _ -> None
-  | true, Cstr_tuple [{desc = Tconstr (path, _, _)}]
-    when Path.same path Predef.path_string ->
+let get_block_type_from_typ ~env (t: Types.type_expr) : block_type option = 
+  let t = !expand_head env t in
+  match t with
+  | {desc = Tconstr (path, _, _)} when Path.same path Predef.path_string ->
     Some StringType
-  | true, Cstr_tuple [{desc = Tconstr (path, _, _)}]
-    when Path.same path Predef.path_int ->
+  | {desc = Tconstr (path, _, _)} when Path.same path Predef.path_int ->
     Some IntType
-  | true, Cstr_tuple [{desc = Tconstr (path, _, _)}]
-    when Path.same path Predef.path_float ->
+  | {desc = Tconstr (path, _, _)} when Path.same path Predef.path_float ->
     Some FloatType
-  | true, Cstr_tuple [({desc = Tconstr _} as t)]
-    when Ast_uncurried_utils.typeIsUncurriedFun t ->
+  | ({desc = Tconstr _} as t) when Ast_uncurried_utils.typeIsUncurriedFun t ->
     Some FunctionType
-  | true, Cstr_tuple [{desc = Tarrow _}] -> Some FunctionType
-  | true, Cstr_tuple [{desc = Tconstr (path, _, _)}]
-    when Path.same path Predef.path_string ->
+  | {desc = Tarrow _} -> Some FunctionType
+  | {desc = Tconstr (path, _, _)} when Path.same path Predef.path_string ->
     Some StringType
-  | true, Cstr_tuple [({desc = Tconstr _} as t)] when type_is_builtin_object t
-    ->
+  | ({desc = Tconstr _} as t) when type_is_builtin_object t ->
     Some ObjectType
-  | true, Cstr_tuple [({desc = Tconstr _} as t)] when type_to_instanceof_backed_obj t |> Option.is_some
-    ->
+  | ({desc = Tconstr _} as t) when type_to_instanceof_backed_obj t |> Option.is_some ->
     (match type_to_instanceof_backed_obj t with 
     | None -> None 
     | Some instanceType -> Some (InstanceType instanceType))
+  | _ -> None
+
+let get_block_type ~env (cstr : Types.constructor_declaration) :
+    block_type option =
+  match (process_untagged cstr.cd_attributes, cstr.cd_args) with
+  | false, _ -> None
+  | 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
   | true, Cstr_tuple [ty] -> (
     let default = Some UnknownType in
     match !extract_concrete_typedecl env ty with

jscomp/test/UntaggedVariants.js

@@ -413,3 +413,17 @@ module AllInstanceofTypes = {
     | Blob(blob) => Js.log(blob->blobSize)
     }
 }
+
+module Aliased = {
+  type dict = Js.Dict.t<string>
+  type fn = (. unit) => option<string>
+  @unboxed type t = Object(dict) | String(string) | Function(fn)
+
+  let test = (t: t) => {
+    switch t {
+    | Object(d) => d->Js.Dict.get("Hello")
+    | String(s) => Some(s)
+    | Function(fn) => fn(.)
+    }
+  }
+}