[WIP] --eraseUnions compiler flag

src/Fable.AST/Plugins.fs

@@ -10,6 +10,7 @@ type Verbosity =
     | Silent
 
 type CompilerOptions =
+      abstract EraseUnions: bool
       abstract TypedArrays: bool
       abstract ClampByteArrays: bool
       abstract Typescript: bool

src/Fable.Cli/Entry.fs

@@ -117,7 +117,8 @@ type Runner =
             |> List.distinct
 
         let compilerOptions =
-            CompilerOptionsHelper.Make(typescript = typescript,
+            CompilerOptionsHelper.Make(eraseUnions = flagEnabled "--eraseUnions" args,
+                                       typescript = typescript,
                                        typedArrays = typedArrays,
                                        ?fileExtension = argValue "--extension" args,
                                        define = define,

src/Fable.Transforms/FSharp2Fable.Util.fs

@@ -675,33 +675,59 @@ module Patterns =
         | true, kind -> Some kind
         | false, _ -> None
 
-    let (|OptionUnion|ListUnion|ErasedUnion|ErasedUnionCase|StringEnum|DiscriminatedUnion|)
-                            (NonAbbreviatedType typ: FSharpType, unionCase: FSharpUnionCase) =
+    [<RequireQualifiedAccess>]
+    type EraseKind =
+        | AsValue
+        | AsTuple
+        | AsTupleWithName
+        | AsName of CaseRules
+
+    let (|OptionUnion|ListUnion|ErasedUnion|DiscriminatedUnion|)
+            (com: Compiler, NonAbbreviatedType typ: FSharpType, unionCase: FSharpUnionCase) =
+
         let getCaseRule (att: FSharpAttribute) =
             match Seq.tryHead att.ConstructorArguments with
             | Some(_, (:? int as rule)) -> enum<CaseRules>(rule)
             | _ -> CaseRules.LowerFirst
 
-        unionCase.Attributes |> Seq.tryPick (fun att ->
-            match att.AttributeType.TryFullName with
-            | Some Atts.erase -> Some ErasedUnionCase
-            | _ -> None)
-        |> Option.defaultWith (fun () ->
-            match tryDefinition typ with
-            | None -> failwith "Union without definition"
-            | Some(tdef, fullName) ->
-                match defaultArg fullName tdef.CompiledName with
-                | Types.valueOption
-                | Types.option -> OptionUnion typ.GenericArguments.[0]
-                | Types.list -> ListUnion typ.GenericArguments.[0]
-                | _ ->
+        let getEraseKind (tdef: FSharpEntity) _fullName =
+            if tdef.UnionCases.Count = 1 then
+                match tdef.UnionCases.[0].UnionCaseFields.Count with
+                | 0 -> EraseKind.AsName(CaseRules.None)
+                | 1 -> EraseKind.AsValue
+                | _ -> EraseKind.AsTuple
+            else
+//                if System.Text.RegularExpressions.Regex.IsMatch(fullName, @"Fable\.Core\.U\d+")
+//                then EraseKind.AsValue
+//                elif tdef.UnionCases |> Seq.forall (fun uci -> uci.UnionCaseFields.Count = 0)
+//                then EraseKind.AsName
+//                else
+                    EraseKind.AsTupleWithName
+
+        match tryDefinition typ with
+        | None -> failwith "Union without definition"
+        | Some(tdef, fullName) ->
+            let fullName = defaultArg fullName tdef.CompiledName
+            match fullName with
+            | Types.valueOption
+            | Types.option -> OptionUnion typ.GenericArguments.[0]
+            | Types.list -> ListUnion typ.GenericArguments.[0]
+            | _ ->
+                unionCase.Attributes |> Seq.tryPick (fun att ->
+                    match att.AttributeType.TryFullName with
+                    | Some Atts.erase -> Some (ErasedUnion(EraseKind.AsTuple, tdef, typ.GenericArguments))
+                    | _ -> None)
+                |> Option.orElseWith (fun () ->
                     tdef.Attributes |> Seq.tryPick (fun att ->
                         match att.AttributeType.TryFullName with
-                        | Some Atts.erase -> Some (ErasedUnion(tdef, typ.GenericArguments, getCaseRule att))
-                        | Some Atts.stringEnum -> Some (StringEnum(tdef, getCaseRule att))
-                        | _ -> None)
-                    |> Option.defaultValue (DiscriminatedUnion(tdef, typ.GenericArguments))
-        )
+                        | Some Atts.erase -> Some (ErasedUnion(EraseKind.AsValue, tdef, typ.GenericArguments))
+                        | Some Atts.stringEnum -> Some (ErasedUnion(EraseKind.AsName(getCaseRule att), tdef, typ.GenericArguments))
+                        | _ -> None))
+                |> Option.defaultWith (fun () ->
+                    if com.Options.EraseUnions then
+                        let kind = getEraseKind tdef fullName
+                        ErasedUnion(kind, tdef, typ.GenericArguments)
+                    else DiscriminatedUnion(tdef, typ.GenericArguments))
 
     let (|ContainsAtt|_|) (fullName: string) (ent: FSharpEntity) =
         tryFindAtt fullName ent.Attributes

src/Fable.Transforms/FSharp2Fable.fs

@@ -50,22 +50,14 @@ let private transformBaseConsCall com ctx r (baseEnt: FSharpEntity) (baseCons: F
         | e -> e
 
 let private transformNewUnion com ctx r fsType (unionCase: FSharpUnionCase) (argExprs: Fable.Expr list) =
-    match fsType, unionCase with
-    | ErasedUnionCase ->
-        Fable.NewTuple argExprs |> makeValue r
-    | ErasedUnion(tdef, _genArgs, rule) ->
-        match argExprs with
-        | [] -> transformStringEnum rule unionCase
-        | [argExpr] -> argExpr
-        | _ when tdef.UnionCases.Count > 1 ->
-            "Erased unions with multiple cases must have one single field: " + (getFsTypeFullName fsType)
-            |> addErrorAndReturnNull com ctx.InlinePath r
-        | argExprs -> Fable.NewTuple argExprs |> makeValue r
-    | StringEnum(tdef, rule) ->
-        match argExprs with
-        | [] -> transformStringEnum rule unionCase
-        | _ -> sprintf "StringEnum types cannot have fields: %O" tdef.TryFullName
-               |> addErrorAndReturnNull com ctx.InlinePath r
+    match com, fsType, unionCase with
+    | ErasedUnion(kind, tdef, _genArgs) ->
+        match kind, argExprs with
+        | EraseKind.AsName rule, _ -> transformStringEnum rule unionCase
+        | EraseKind.AsTupleWithName, _ -> (makeStrConst unionCase.Name)::argExprs |> Fable.NewTuple |> makeValue r
+        | EraseKind.AsValue, [arg] -> arg
+        | EraseKind.AsValue, _ // Shouldn't happen, error?
+        | EraseKind.AsTuple, _ -> Fable.NewTuple argExprs |> makeValue r
     | OptionUnion typ ->
         let typ = makeType ctx.GenericArgs typ
         let expr =
@@ -286,14 +278,15 @@ let private transformUnionCaseTest (com: IFableCompiler) (ctx: Context) r
                             unionExpr fsType (unionCase: FSharpUnionCase) =
   trampoline {
     let! unionExpr = transformExpr com ctx unionExpr
-    match fsType, unionCase with
-    | ErasedUnionCase ->
-        return "Cannot test erased union cases"
-        |> addErrorAndReturnNull com ctx.InlinePath r
-    | ErasedUnion(tdef, genArgs, rule) ->
-        match unionCase.UnionCaseFields.Count with
-        | 0 -> return makeEqOp r unionExpr (transformStringEnum rule unionCase) BinaryEqualStrict
-        | 1 ->
+    match com, fsType, unionCase with
+    | ErasedUnion(kind, tdef, genArgs) ->
+        match kind with
+        | EraseKind.AsName rule ->
+            return makeEqOp r unionExpr (transformStringEnum rule unionCase) BinaryEqualStrict
+        | EraseKind.AsTupleWithName ->
+            let name = Fable.Get(unionExpr, Fable.TupleIndex(0), Fable.String, None)
+            return makeEqOp r name (makeStrConst unionCase.Name) BinaryEqualStrict
+        | EraseKind.AsValue ->
             let fi = unionCase.UnionCaseFields.[0]
             let typ =
                 if fi.FieldType.IsGenericParameter then
@@ -305,17 +298,15 @@ let private transformUnionCaseTest (com: IFableCompiler) (ctx: Context) r
                 else fi.FieldType
             let kind = makeType ctx.GenericArgs typ |> Fable.TypeTest
             return Fable.Test(unionExpr, kind, r)
-        | _ ->
-            return "Erased unions with multiple cases cannot have more than one field: " + (getFsTypeFullName fsType)
+        | EraseKind.AsTuple ->
+            return "Cannot test erased union cases"
             |> addErrorAndReturnNull com ctx.InlinePath r
     | OptionUnion _ ->
         let kind = Fable.OptionTest(unionCase.Name <> "None" && unionCase.Name <> "ValueNone")
         return Fable.Test(unionExpr, kind, r)
     | ListUnion _ ->
         let kind = Fable.ListTest(unionCase.CompiledName <> "Empty")
         return Fable.Test(unionExpr, kind, r)
-    | StringEnum(_, rule) ->
-        return makeEqOp r unionExpr (transformStringEnum rule unionCase) BinaryEqualStrict
     | DiscriminatedUnion(tdef,_) ->
         let tag = unionCaseTag tdef unionCase
         return Fable.Test(unionExpr, Fable.UnionCaseTest(tag), r)
@@ -687,18 +678,19 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) fsExpr =
     | BasicPatterns.UnionCaseGet (unionExpr, fsType, unionCase, field) ->
         let r = makeRangeFrom fsExpr
         let! unionExpr = transformExpr com ctx unionExpr
-        match fsType, unionCase with
-        | ErasedUnionCase ->
-            let index = unionCase.UnionCaseFields |> Seq.findIndex (fun x -> x.Name = field.Name)
-            return Fable.Get(unionExpr, Fable.TupleIndex(index), makeType ctx.GenericArgs fsType, r)
-        | ErasedUnion _ ->
-            if unionCase.UnionCaseFields.Count = 1 then return unionExpr
-            else
+        match com, fsType, unionCase with
+        | ErasedUnion(kind, _, _) ->
+            let getByIndex offset =
                 let index = unionCase.UnionCaseFields |> Seq.findIndex (fun x -> x.Name = field.Name)
-                return Fable.Get(unionExpr, Fable.TupleIndex index, makeType ctx.GenericArgs fsType, r)
-        | StringEnum _ ->
-            return "StringEnum types cannot have fields"
-            |> addErrorAndReturnNull com ctx.InlinePath r
+                Fable.Get(unionExpr, Fable.TupleIndex(index + offset), makeType ctx.GenericArgs fsType, r)
+
+            match kind with
+            | EraseKind.AsName _ ->
+                return "StringEnum types cannot have fields"
+                |> addErrorAndReturnNull com ctx.InlinePath r
+            | EraseKind.AsValue -> return unionExpr
+            | EraseKind.AsTuple -> return getByIndex 0
+            | EraseKind.AsTupleWithName -> return getByIndex 1
         | OptionUnion t ->
             return Fable.Get(unionExpr, Fable.OptionValue, makeType ctx.GenericArgs t, r)
         | ListUnion t ->

src/Fable.Transforms/Global/Compiler.fs

@@ -2,7 +2,8 @@ namespace Fable
 
 type CompilerOptionsHelper =
     static member DefaultFileExtension = ".fs.js"
-    static member Make(?typedArrays,
+    static member Make(?eraseUnions,
+                       ?typedArrays,
                        ?typescript,
                        ?define,
                        ?optimizeFSharpAst,
@@ -14,6 +15,7 @@ type CompilerOptionsHelper =
         { new CompilerOptions with
               member _.Define = define
               member _.DebugMode = isDebug
+              member _.EraseUnions = defaultArg eraseUnions false
               member _.Typescript = defaultArg typescript false
               member _.TypedArrays = defaultArg typedArrays true
               member _.OptimizeFSharpAst = defaultArg optimizeFSharpAst false