Fix #315

Author: cannorin

CHANGELOG.md

@@ -5,6 +5,7 @@ The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),
 and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html).
 
 ## [Unreleased]
+- Fix a bug which generated unnecessarily duplicated option type (#315).
 
 ## [1.4.5] - 2023-07-13
 - Fix a bug which caused optional properties not to be recognized as optional (#312).

lib/Typer.fs

@@ -539,20 +539,35 @@ module Type =
         boundTyprms |> List.map (fun x -> TypeVar x.name),
         MultipleLocation (funcs |> List.map (fun f -> f.loc))
       )
+  let normalizeUnion (u: UnionType) : UnionType =
+    let rec go ts =
+      ts |> List.collect (function
+        | Union u -> go u.types
+        | t -> [t]
+      )
+    { u with types = go u.types |> List.distinct }
+
+  let normalizeIntersection (i: IntersectionType) : IntersectionType =
+    let rec go ts =
+      ts |> List.collect (function
+        | Intersection i -> go i.types
+        | t -> [t]
+      )
+    { i with types = go i.types |> List.distinct }
 
   // TODO: more optimization
-  let createUnion (_ctx: TyperContext<_, _>) (types: Type list) =
+  let createUnion (types: Type list) =
     match types with
     | [] -> Prim Never
     | [x] -> x
-    | _ -> Union { types = types }
+    | _ -> Union (normalizeUnion { types = types })
 
   // TODO: more optimization
-  let createIntersection (_ctx: TyperContext<_, _>) (types: Type list) =
+  let createIntersection (types: Type list) =
     match types with
     | [] -> Prim Any
     | [x] -> x
-    | _ -> Intersection { types = types }
+    | _ -> Intersection (normalizeIntersection { types = types })
 
   let substTypeVarInInheritingType subst ctx = function
     | InheritingType.KnownIdent x ->
@@ -694,7 +709,7 @@ module Type =
           let members = c.members |> List.map snd
           let intersection = function
             | [] -> None
-            | ts -> createIntersection ctx ts |> Some
+            | ts -> createIntersection ts |> Some
           let rec go = function
             | TypeLiteral (LString name) ->
               let funcs, others =
@@ -815,7 +830,7 @@ module Type =
               | _ -> None)
           match types with
           | [] -> onFail ()
-          | _ -> createIntersection ctx types
+          | _ -> createIntersection types
 
       | Keyof t ->
         let t = resolveErasedTypeImpl typeQueries ctx t

src/Targets/JsOfOCaml/Writer.fs

@@ -704,7 +704,7 @@ let rec emitMembers flags overrideFunc ctx (selfTy: Type) (ma: MemberAttribute)
         if ma.isStatic then [Choice2Of2 (Prim Void)]
         else [Choice2Of2 PolymorphicThis]
       let ret =
-        if fl.isOptional then Union { types = [fl.value; Prim Undefined] }
+        if fl.isOptional then createUnion [fl.value; Prim Undefined]
         else fl.value
       func { isVariadic = false; args = args; returnType = ret; loc = ma.loc } |> emitType_ ctx
     yield! comments ()