Merge pull request #3396 from fable-compiler/ts-erased-union

Emit Fable erased unions as TS union types

src/Fable.Transforms/BabelPrinter.fs

@@ -259,7 +259,8 @@ module PrinterExtensions =
             | ArrayExpression _
             | ObjectExpression _
             | JsxTemplate _
-            | JsxElement _ -> printer.Print(expr)
+            | JsxElement _
+            | UnaryExpression _ -> printer.Print(expr)
             | _ -> printer.WithParens(expr)
 
         member printer.PrintOperation(left, operator, right, loc) =

src/Fable.Transforms/Dart/Fable2Dart.fs

@@ -1482,7 +1482,7 @@ module Util =
 
         | Fable.TypeCast(expr, t) ->
             match t with
-            | Fable.DeclaredType(EntFullName(Types.ienumerableGeneric | Types.ienumerable), [_]) ->
+            | Fable.DeclaredType(EntRefFullName(Types.ienumerableGeneric | Types.ienumerable), [_]) ->
                 match expr with
                 // Optimization for (numeric) array or list literals casted to seq
                 // Done at the very end of the compile pipeline to get more opportunities
@@ -1494,15 +1494,15 @@ module Util =
                 | ExprType(Fable.Array _ | Fable.List _) ->
                     transform com ctx returnStrategy expr
 
-                | ExprType(Fable.DeclaredType(EntFullName(Types.dictionary | Types.idictionary), _)) ->
+                | ExprType(Fable.DeclaredType(EntRefFullName(Types.dictionary | Types.idictionary), _)) ->
                     transformExprAndResolve com ctx returnStrategy expr (fun expr ->
                         let t = transformType com ctx t
                         get t expr "entries")
 
                 | ExprType(Fable.String) ->
                     Dart.Replacements.stringToCharSeq expr |> transform com ctx returnStrategy
 
-                | ExprType(Fable.DeclaredType(EntFullName "System.Text.RegularExpressions.Match", _)) ->
+                | ExprType(Fable.DeclaredType(EntRefFullName "System.Text.RegularExpressions.Match", _)) ->
                     Dart.Replacements.regexMatchToSeq com t expr |> transform com ctx returnStrategy
 
                 | _ -> transformCast com ctx t returnStrategy expr

src/Fable.Transforms/Dart/Replacements.fs

@@ -2254,7 +2254,7 @@ let regexMatchToSeq com t e =
 
 let regex com (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) =
     let isGroup = function
-        | ExprType (EntFullName "System.Text.RegularExpressions.Group") -> true
+        | ExprType(DeclaredTypeFullName "System.Text.RegularExpressions.Group") -> true
         | _ -> false
 
     let createRegex r t args =

src/Fable.Transforms/Fable2Babel.fs

@@ -294,9 +294,6 @@ module Reflection =
             ]
             |> libReflectionCall com ctx r "class"
 
-    let private ofString s = Expression.stringLiteral(s)
-    let private ofArray babelExprs = Expression.arrayExpression(List.toArray babelExprs)
-
     let transformTypeTest (com: IBabelCompiler) ctx range expr (typ: Fable.Type): Expression =
         let warnAndEvalToFalse msg =
             "Cannot type test (evals to false): " + msg
@@ -440,8 +437,7 @@ module Annotation =
         | Replacements.Util.Builtin kind ->
             makeBuiltinTypeAnnotation com ctx typ kind
         | Fable.DeclaredType(entRef, genArgs) ->
-            let ent = com.GetEntity(entRef)
-            makeEntityTypeAnnotation com ctx ent genArgs
+            com.GetEntity(entRef) |> makeEntityTypeAnnotation com ctx genArgs
 
     let makeTypeAnnotationIfTypeScript (com: IBabelCompiler) ctx typ expr =
         if com.IsTypeScript then
@@ -567,8 +563,9 @@ module Annotation =
         TypeAnnotation.functionTypeAnnotation(funcTypeParams, returnType)
 
     // Move this to Replacements.tryEntity?
-    let tryNativeOrFableLibraryInterface com ctx (ent: Fable.Entity) genArgs =
+    let tryNativeOrFableLibraryInterface com ctx genArgs (ent: Fable.Entity) =
         match ent.FullName with
+        | _ when not ent.IsInterface -> None
         | Types.icollection
             -> makeNativeTypeAnnotation com ctx genArgs "Iterable" |> Some
             // -> makeImportTypeAnnotation com ctx [Fable.Any] "Util" "ICollection"
@@ -607,31 +604,56 @@ module Annotation =
             -> makeImportTypeAnnotation com ctx genArgs "Observable" "IObserver" |> Some
         | Types.iobservableGeneric
             -> makeImportTypeAnnotation com ctx genArgs "Observable" "IObservable" |> Some
+        | "Microsoft.FSharp.Control.IEvent`1"
+            -> makeImportTypeAnnotation com ctx genArgs "Event" "IEvent" |> Some
+        | Types.ievent2
+            -> makeImportTypeAnnotation com ctx genArgs "Event" "IEvent$2" |> Some
         | _ -> None
 
-    let makeEntityTypeAnnotation com ctx (ent: Fable.Entity) genArgs =
-        match ent.FullName, genArgs with
-        | Types.nullable, [genArg] ->
+    let makeEntityTypeAnnotation com ctx genArgs (ent: Fable.Entity) =
+        match genArgs, ent with
+        | [genArg], EntFullName Types.nullable ->
             makeNullableTypeAnnotation com ctx genArg
-        | _ ->
-            if ent.IsInterface
-            then tryNativeOrFableLibraryInterface com ctx ent genArgs
-            else None
-            |> Option.defaultWith (fun () ->
-                match Lib.tryJsConstructorForAnnotation true com ctx ent with
-                | Some entRef ->
-                    match entRef with
-                    | Literal(Literal.StringLiteral(StringLiteral(str, _))) ->
-                        match str with
-                        | "number" -> NumberTypeAnnotation
-                        | "boolean" -> BooleanTypeAnnotation
-                        | "string" -> StringTypeAnnotation
-                        | _ -> AnyTypeAnnotation
-                    | Expression.Identifier(id) ->
-                        makeGenericTypeAnnotation com ctx genArgs id
-                    // TODO: Resolve references to types in nested modules
-                    | _ -> AnyTypeAnnotation
-                | None -> AnyTypeAnnotation)
+
+        | _, Patterns.Try (Util.tryFindAnyAttribute [Atts.erase; Atts.tsTaggedUnion]) (erasedAtt: Fable.Attribute) ->
+            if erasedAtt.Entity.FullName = Atts.erase && ent.IsFSharpUnion then
+                let genArgs =
+                    List.zip ent.GenericParameters genArgs
+                    |> List.map (fun (p, a) -> p.Name, a)
+                    |> Map
+
+                let transformSingleFieldType (uci: Fable.UnionCase) =
+                    List.tryHead uci.UnionCaseFields
+                    |> Option.map (fun fi -> fi.FieldType |> resolveInlineType genArgs |> makeTypeAnnotation com ctx)
+                    |> Option.defaultValue VoidTypeAnnotation
+
+                match ent.UnionCases with
+                | [uci] when List.isMultiple uci.UnionCaseFields ->
+                    uci.UnionCaseFields
+                    |> List.mapToArray (fun fi -> fi.FieldType |> resolveInlineType genArgs |> makeTypeAnnotation com ctx)
+                    |> TupleTypeAnnotation
+                | [uci] -> transformSingleFieldType uci
+                | ucis -> ucis |> List.mapToArray transformSingleFieldType |> UnionTypeAnnotation
+
+            // TODO: tsTaggedUnion
+            else AnyTypeAnnotation
+
+        | _, Patterns.Try (tryNativeOrFableLibraryInterface com ctx genArgs) ta -> ta
+
+        | _, Patterns.Try (Lib.tryJsConstructorForAnnotation true com ctx) entRef ->
+            match entRef with
+            | Literal(Literal.StringLiteral(StringLiteral(str, _))) ->
+                match str with
+                | "number" -> NumberTypeAnnotation
+                | "boolean" -> BooleanTypeAnnotation
+                | "string" -> StringTypeAnnotation
+                | _ -> AnyTypeAnnotation
+            | Expression.Identifier(id) ->
+                makeGenericTypeAnnotation com ctx genArgs id
+            // TODO: Resolve references to types in nested modules
+            | _ -> AnyTypeAnnotation
+
+        | _ -> AnyTypeAnnotation
 
     let makeAnonymousRecordTypeAnnotation com ctx fieldNames fieldTypes: TypeAnnotation =
         Seq.zip fieldNames fieldTypes
@@ -1377,9 +1399,17 @@ module Util =
 
         | Fable.Binary(op, left, right) ->
             match op, left, right with
-            | (BinaryEqual | BinaryUnequal), Fable.Value(Fable.Null _, _), e
-            | (BinaryEqual | BinaryUnequal), e,  Fable.Value(Fable.Null _, _) ->
-                com.TransformAsExpr(ctx, e) |> makeNullCheck range (op = BinaryEqual)
+            | (BinaryEqual | BinaryUnequal), e1, e2 ->
+                match e1, e2 with
+                | Fable.Value(Fable.Null _, _), e
+                | e,  Fable.Value(Fable.Null _, _) ->
+                    com.TransformAsExpr(ctx, e) |> makeNullCheck range (op = BinaryEqual)
+                | ExprType(Fable.MetaType), _ ->
+                    let e = Replacements.Util.Helper.LibCall(com, "Reflection", "equals", Fable.Boolean, [e1; e2], ?loc=range)
+                    let e = if op = BinaryEqual then e else makeUnOp None Fable.Boolean e UnaryNot
+                    transformAsExpr com ctx e
+                | TransformExpr com ctx left, TransformExpr com ctx right ->
+                    Expression.binaryExpression(op, left, right, ?loc=range)
 
             | _, TransformExpr com ctx left, TransformExpr com ctx right ->
                 Expression.binaryExpression(op, left, right, ?loc=range)
@@ -1655,6 +1685,18 @@ module Util =
             let kind = if var.IsMutable then Let else Const
             [| Statement.variableDeclaration(kind, var.Name, ?annotation=ta, typeParameters=tp, init=value) |]
 
+    let transformUnionCaseTag (com: IBabelCompiler) ctx typ tag =
+        if com.IsTypeScript then
+            match typ with
+            | Fable.DeclaredType(ent, _) ->
+                let ent = com.GetEntity(ent)
+                match tryJsConstructorWithSuffix com ctx ent "_Tag" with
+                | Some(Expression.Identifier(tagIdent)) -> EnumCaseLiteral(tagIdent, ent.UnionCases[tag].Name) |> Literal
+                | _ -> ofInt tag
+            | _ -> ofInt tag
+        else
+            ofInt tag
+
     let transformTest (com: IBabelCompiler) ctx range kind expr: Expression =
         match kind with
         | Fable.TypeTest t ->
@@ -1666,23 +1708,19 @@ module Util =
             let expr = libCall com ctx range "List" "isEmpty" [] [expr]
             if nonEmpty then Expression.unaryExpression(UnaryNot, expr, ?loc=range) else expr
         | Fable.UnionCaseTest tag ->
-            let expected =
-                if com.IsTypeScript then
-                    match expr.Type with
-                    | Fable.DeclaredType(ent, _) ->
-                        let ent = com.GetEntity(ent)
-                        match tryJsConstructorWithSuffix com ctx ent "_Tag" with
-                        | Some(Expression.Identifier(tagIdent)) -> EnumCaseLiteral(tagIdent, ent.UnionCases[tag].Name) |> Literal
-                        | _ -> ofInt tag
-                    | _ -> ofInt tag
-                else
-                    ofInt tag
+            let expected = transformUnionCaseTag com ctx expr.Type tag
             let actual = getUnionExprTag com ctx None expr
             Expression.binaryExpression(BinaryEqual, actual, expected, ?loc=range)
 
-    let transformSwitch (com: IBabelCompiler) ctx useBlocks returnStrategy evalExpr cases defaultCase: Statement =
+    let transformSwitch (com: IBabelCompiler) ctx useBlocks returnStrategy (evalExpr: Fable.Expr) cases defaultCase: Statement =
         let consequent caseBody =
             if useBlocks then [|Statement.blockStatement(caseBody)|] else caseBody
+
+        let transformGuard = function
+            | Fable.Test(expr, Fable.UnionCaseTest tag, _) ->
+                transformUnionCaseTag com ctx expr.Type tag
+            | TransformExpr com ctx e -> e
+
         let cases =
             cases |> List.collect (fun (guards, expr) ->
                 // Remove empty branches
@@ -1691,20 +1729,22 @@ module Util =
                 | _, _, [] -> []
                 | _, _, guards ->
                     let guards, lastGuard = List.splitLast guards
-                    let guards = guards |> List.map (fun e -> SwitchCase.switchCase([||], com.TransformAsExpr(ctx, e)))
+                    let guards = guards |> List.map (fun e -> SwitchCase.switchCase(transformGuard e))
                     let caseBody = com.TransformAsStatements(ctx, returnStrategy, expr)
                     let caseBody =
                         match returnStrategy with
                         | Some Return -> caseBody
                         | _ -> Array.append caseBody [|Statement.breakStatement()|]
-                    guards @ [SwitchCase.switchCase(consequent caseBody, com.TransformAsExpr(ctx, lastGuard))]
+                    guards @ [SwitchCase.switchCase(transformGuard lastGuard, consequent caseBody)]
                 )
+
         let cases =
             match defaultCase with
             | Some expr ->
                 let defaultCaseBody = com.TransformAsStatements(ctx, returnStrategy, expr)
-                cases @ [SwitchCase.switchCase(consequent defaultCaseBody)]
+                cases @ [SwitchCase.switchCase(body=consequent defaultCaseBody)]
             | None -> cases
+
         Statement.switchStatement(com.TransformAsExpr(ctx, evalExpr), List.toArray cases)
 
     let matchTargetIdentAndValues idents values =
@@ -1758,9 +1798,8 @@ module Util =
                 | _, Fable.Value((Fable.CharConstant _ | Fable.StringConstant _ | Fable.NumberConstant _), _) -> Some(left, right)
                 | Fable.Value((Fable.CharConstant _ | Fable.StringConstant _ | Fable.NumberConstant _), _), _ -> Some(right, left)
                 | _ -> None
-            | Fable.Test(expr, Fable.UnionCaseTest tag, _) ->
+            | Fable.Test(expr, Fable.UnionCaseTest _, _) as right ->
                 let evalExpr = Fable.Get(expr, Fable.UnionTag, Fable.Number(Int32, Fable.NumberInfo.Empty), None)
-                let right = makeIntConst tag
                 Some(evalExpr, right)
             | _ -> None
         let sameEvalExprs evalExpr1 evalExpr2 =
@@ -2297,6 +2336,10 @@ module Util =
     let hasAttribute fullName (atts: Fable.Attribute seq) =
         atts |> Seq.exists (fun att -> att.Entity.FullName = fullName)
 
+    let tryFindAnyAttribute fullNames (ent: Fable.Entity) =
+        let fullNames = set fullNames
+        ent.Attributes |> Seq.tryFind (fun att -> Set.contains att.Entity.FullName fullNames)
+
     let transformModuleFunction (com: IBabelCompiler) ctx (info: Fable.MemberFunctionOrValue) (membName: string) (args: Fable.Ident list) body =
         let isJsx = hasAttribute Atts.jsxComponent info.Attributes
         let args, body =
@@ -2547,9 +2590,7 @@ module Util =
 
         let extends =
             ent.DeclaredInterfaces
-            |> Seq.map (fun parent ->
-                let ent = com.GetEntity(parent.Entity)
-                makeEntityTypeAnnotation com ctx ent parent.GenericArgs)
+            |> Seq.map (fun parent -> com.GetEntity(parent.Entity) |> makeEntityTypeAnnotation com ctx parent.GenericArgs)
             |> Seq.toArray
 
         let typeParameters =
@@ -2618,7 +2659,10 @@ module Util =
         | Fable.ClassDeclaration decl ->
             let entRef = decl.Entity
             let ent = com.GetEntity(entRef)
-            if ent.IsInterface then
+            let isErased = tryFindAnyAttribute [Atts.erase; Atts.tsTaggedUnion] ent |> Option.isSome
+            if isErased then
+                []
+            elif ent.IsInterface then
                 if com.IsTypeScript
                 then [transformInterfaceDeclaration com ctx decl ent]
                 else []

src/Fable.Transforms/FableTransforms.fs

@@ -181,11 +181,15 @@ let noSideEffectBeforeIdent identName expr =
     findIdentOrSideEffect expr && not sideEffect
 
 let canInlineArg identName value body =
-    (canHaveSideEffects value |> not && countReferences 1 identName body <= 1)
-     || (noSideEffectBeforeIdent identName body
-         && isIdentCaptured identName body |> not
-         // Make sure is at least referenced once so the expression is not erased
-         && countReferences 1 identName body = 1)
+    match value with
+    | Value((Null _|UnitConstant|TypeInfo _|BoolConstant _|NumberConstant _|CharConstant _),_) -> true
+    | Value(StringConstant s,_) -> s.Length < 100
+    | _ ->
+        (canHaveSideEffects value |> not && countReferences 1 identName body <= 1)
+        || (noSideEffectBeforeIdent identName body
+            && isIdentCaptured identName body |> not
+            // Make sure is at least referenced once so the expression is not erased
+            && countReferences 1 identName body = 1)
 
 /// Returns arity of lambda (or lambda option) types
 let (|Arity|) typ =
@@ -327,6 +331,26 @@ module private Transforms =
             | None -> e
         | e -> e
 
+    let typeEqualsAtCompileTime t1 t2 =
+        let stripMeasure = function
+            | Number(kind, NumberInfo.IsMeasure _) -> Number(kind, NumberInfo.Empty)
+            | t -> t
+        typeEquals true (stripMeasure t1) (stripMeasure t2)
+
+    let rec tryEqualsAtCompileTime a b =
+        match a, b with
+        | Value(TypeInfo(a, []),_), Value(TypeInfo(b, []),_) ->
+            typeEqualsAtCompileTime a b |> Some
+        | Value(Null _,_), Value(Null _,_)
+        | Value(UnitConstant,_), Value(UnitConstant,_) -> Some true
+        | Value(BoolConstant a,_), Value(BoolConstant b,_) -> Some(a = b)
+        | Value(CharConstant a,_), Value(CharConstant b,_) -> Some(a = b)
+        | Value(StringConstant a,_), Value(StringConstant b,_) -> Some(a = b)
+        | Value(NumberConstant(a,_,_),_), Value(NumberConstant(b,_,_),_) -> Some(a = b)
+        | Value(NewOption(None,_,_)  ,_), Value(NewOption(None,_,_),_) -> Some true
+        | Value(NewOption(Some a,_,_),_), Value(NewOption(Some b,_,_),_) -> tryEqualsAtCompileTime a b
+        | _ -> None
+
     let operationReduction (_com: Compiler) e =
         match e with
         // TODO: Other binary operations and numeric types
@@ -339,10 +363,31 @@ module private Transforms =
                 Value(NumberConstant(v1 + v2, AST.Int32, NumberInfo.Empty), addRanges [r1; r2])
             | _ -> e
 
-        | Operation(Logical(AST.LogicalAnd, (Value(BoolConstant b, _) as v1), v2), _, _, _) -> if b then v2 else v1
-        | Operation(Logical(AST.LogicalAnd, v1, (Value(BoolConstant b, _) as v2)), _, _, _) -> if b then v1 else v2
-        | Operation(Logical(AST.LogicalOr, (Value(BoolConstant b, _) as v1), v2), _, _, _) -> if b then v1 else v2
-        | Operation(Logical(AST.LogicalOr, v1, (Value(BoolConstant b, _) as v2)), _, _, _) -> if b then v2 else v1
+        | Operation(Logical(AST.LogicalAnd, (Value(BoolConstant b, _) as v1), v2), [], _, _) -> if b then v2 else v1
+        | Operation(Logical(AST.LogicalAnd, v1, (Value(BoolConstant b, _) as v2)), [], _, _) -> if b then v1 else v2
+        | Operation(Logical(AST.LogicalOr, (Value(BoolConstant b, _) as v1), v2), [], _, _) -> if b then v1 else v2
+        | Operation(Logical(AST.LogicalOr, v1, (Value(BoolConstant b, _) as v2)), [], _, _) -> if b then v2 else v1
+
+        | Operation(Unary(AST.UnaryNot, Value(BoolConstant b, r)), [], _, _) -> Value(BoolConstant(not b), r)
+
+        | Operation(Binary((AST.BinaryEqual | AST.BinaryUnequal as op), v1, v2), [], _, _) ->
+            let isNot = op = AST.BinaryUnequal
+            tryEqualsAtCompileTime v1 v2
+            |> Option.map (fun b -> (if isNot then not b else b) |> makeBoolConst)
+            |> Option.defaultValue e
+
+        | Test(expr, kind, _) ->
+            match kind, expr with
+            // This optimization doesn't work well with erased unions
+            // | TypeTest typ, expr ->
+            //     typeEqualsAtCompileTime typ expr.Type |> makeBoolConst
+            | OptionTest isSome, Value(NewOption(expr,_,_),_)->
+                isSome = Option.isSome expr |> makeBoolConst
+            | ListTest isCons, Value(NewList(headAndTail,_),_) ->
+                isCons = Option.isSome headAndTail |> makeBoolConst
+            | UnionCaseTest tag1, Value(NewUnion(_,tag2,_,_),_) ->
+                tag1 = tag2 |> makeBoolConst
+            | _ -> e
 
         | IfThenElse(Value(BoolConstant b, _), thenExpr, elseExpr, _) -> if b then thenExpr else elseExpr