Erase unions and records

Author: ncave

.vscode/launch.json

@@ -73,7 +73,7 @@
             "name": "Run bench-compiler (Node)",
             "program": "${workspaceRoot}/src/fable-standalone/test/bench-compiler/out-node/app.js",
             // "args": ["${workspaceRoot}/tests/Main/Fable.Tests.fsproj", "out-tests", "--fableLib", "out-lib"],
-            "args": ["${workspaceRoot}/../fable-test/fable-test.fsproj", "out-test", "--fableLib", "out-lib"],
+            "args": ["${workspaceRoot}/../fable-test/fable-test.fsproj", "out-test", "--fableLib", "out-lib", "--eraseTypes"],
             "cwd": "${workspaceRoot}/src/fable-standalone/test/bench-compiler"
         },
         {
@@ -82,7 +82,7 @@
             "name": "Run bench-compiler (.NET)",
             "program": "${workspaceFolder}/src/fable-standalone/test/bench-compiler/bin/Debug/net5.0/bench-compiler.dll",
             // "args": ["${workspaceRoot}/tests/Main/Fable.Tests.fsproj", "out-tests", "--fableLib", "out-lib"],
-            "args": ["${workspaceRoot}/../fable-test/fable-test.fsproj", "out-test", "--fableLib", "out-lib"],
+            "args": ["${workspaceRoot}/../fable-test/fable-test.fsproj", "out-test", "--fableLib", "out-lib", "--eraseTypes"],
             "cwd": "${workspaceFolder}/src/fable-standalone/test/bench-compiler"
         },
         {

src/Fable.AST/Plugins.fs

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

src/Fable.Cli/Entry.fs

@@ -159,7 +159,8 @@ type Runner =
             |> Option.defaultValue (defaultFileExt typescript args)
 
         let compilerOptions =
-            CompilerOptionsHelper.Make(typescript = typescript,
+            CompilerOptionsHelper.Make(eraseTypes = flagEnabled "--eraseTypes" args,
+                                       typescript = typescript,
                                        typedArrays = typedArrays,
                                        fileExtension = fileExt,
                                        define = define,

src/Fable.Transforms/FSharp2Fable.Util.fs

@@ -447,6 +447,16 @@ module Helpers =
     let makeRangeFrom (fsExpr: FSharpExpr) =
         Some (makeRange fsExpr.Range)
 
+    let isErasedTypeDef (com: Compiler) (tdef: FSharpEntity) =
+        com.Options.EraseTypes && tdef.IsFSharp
+        && (tdef.IsFSharpUnion || tdef.IsFSharpRecord || tdef.IsValueType || tdef.IsByRef)
+        && not (tdef.TryFullName = Some Types.reference) // no F# refs
+        && not (hasAttribute Atts.customEquality tdef.Attributes)
+        && not (hasAttribute Atts.customComparison tdef.Attributes)
+
+    let isErasedType (com: Compiler) (t: FSharpType) =
+        t.HasTypeDefinition && (isErasedTypeDef com t.TypeDefinition)
+
     let unionCaseTag (com: IFableCompiler) (ent: FSharpEntity) (unionCase: FSharpUnionCase) =
         try
             // If the order of cases changes in the declaration, the tag has to change too.
@@ -1167,6 +1177,12 @@ module Util =
             makeImportUserGenerated None Fable.Any selector path |> Some
         | _ -> None
 
+    let isErasedEntity (com: Compiler) (ent: Fable.Entity) =
+        match ent with
+        | :? FsEnt as fsEnt ->
+            Helpers.isErasedTypeDef com fsEnt.FSharpEntity
+        | _ -> false
+
     let isErasedOrStringEnumEntity (ent: Fable.Entity) =
         ent.Attributes |> Seq.exists (fun att ->
             match att.Entity.FullName with

src/Fable.Transforms/Fable2Babel.fs

@@ -311,6 +311,12 @@ module Reflection =
                 let ent = com.GetEntity(ent)
                 if ent.IsInterface then
                     warnAndEvalToFalse "interfaces"
+                elif FSharp2Fable.Util.isErasedEntity com ent then
+                    let expr = com.TransformAsExpr(ctx, expr)
+                    let idx = if ent.IsFSharpUnion then 1 else 0
+                    let actual = Util.getExpr None expr (Util.ofInt idx)
+                    let expected = Util.ofString ent.FullName
+                    Expression.binaryExpression(BinaryEqualStrict, actual, expected, ?loc=range)
                 else
                     match tryJsConstructor com ctx ent with
                     | Some cons ->
@@ -383,6 +389,7 @@ module Annotation =
         | Fable.LambdaType _ -> Util.uncurryLambdaType typ ||> makeFunctionTypeAnnotation com ctx typ
         | Fable.DelegateType(argTypes, returnType) -> makeFunctionTypeAnnotation com ctx typ argTypes returnType
         | Fable.GenericParam name -> makeSimpleTypeAnnotation com ctx name
+        | Replacements.ErasedType com (_, _, _, genArgs) -> makeTupleTypeAnnotation com ctx genArgs
         | Fable.DeclaredType(ent, genArgs) ->
             makeEntityTypeAnnotation com ctx ent genArgs
         | Fable.AnonymousRecordType(fieldNames, genArgs) ->
@@ -814,9 +821,18 @@ module Util =
     let getUnionCaseName (uci: Fable.UnionCase) =
         match uci.CompiledName with Some cname -> cname | None -> uci.Name
 
+    // let getUnionCaseFullName (uci: Fable.UnionCase) =
+    //     uci.XmlDocSig
+    //     |> Naming.replacePrefix "T:Microsoft.FSharp." "FSharp."
+    //     |> Naming.replacePrefix "T:" ""
+
     let getUnionExprTag (com: IBabelCompiler) ctx r (fableExpr: Fable.Expr) =
         let expr = com.TransformAsExpr(ctx, fableExpr)
-        getExpr r expr (Expression.stringLiteral("tag"))
+        match fableExpr.Type with
+        | Replacements.ErasedType com _ ->
+            getExpr r expr (ofInt 0)
+        | _ ->
+            getExpr r expr (Expression.stringLiteral("tag"))
 
     /// Wrap int expressions with `| 0` to help optimization of JS VMs
     let wrapIntExpression typ (e: Expression) =
@@ -962,27 +978,40 @@ module Util =
             com.TransformAsExpr(ctx, x)
         | Fable.NewRecord(values, ent, genArgs) ->
             let ent = com.GetEntity(ent)
-            let values = List.mapToArray (fun x -> com.TransformAsExpr(ctx, x)) values
-            let consRef = ent |> jsConstructor com ctx
-            let typeParamInst =
-                if com.Options.Typescript && (ent.FullName = Types.reference)
-                then makeGenTypeParamInst com ctx genArgs
-                else None
-            Expression.newExpression(consRef, values, ?typeArguments=typeParamInst, ?loc=r)
+            let values = List.map (fun x -> com.TransformAsExpr(ctx, x)) values
+            if FSharp2Fable.Util.isErasedEntity com ent then
+                let recordName = ent.FullName |> ofString
+                recordName::values |> List.toArray |> Expression.arrayExpression
+            else
+                let consRef = ent |> jsConstructor com ctx
+                let values = values |> List.toArray
+                let typeParamInst =
+                    if com.Options.Typescript && (ent.FullName = Types.reference)
+                    then makeGenTypeParamInst com ctx genArgs
+                    else None
+                Expression.newExpression(consRef, values, ?typeArguments=typeParamInst, ?loc=r)
         | Fable.NewAnonymousRecord(values, fieldNames, _genArgs) ->
             let values = List.mapToArray (fun x -> com.TransformAsExpr(ctx, x)) values
-            Array.zip fieldNames values |> makeJsObject
+            if com.Options.EraseTypes then
+                values |> Expression.arrayExpression
+            else
+                Array.zip fieldNames values |> makeJsObject
         | Fable.NewUnion(values, tag, ent, genArgs) ->
             let ent = com.GetEntity(ent)
             let values = List.map (fun x -> com.TransformAsExpr(ctx, x)) values
-            let consRef = ent |> jsConstructor com ctx
-            let typeParamInst =
-                if com.Options.Typescript
-                then makeGenTypeParamInst com ctx genArgs
-                else None
-            // let caseName = ent.UnionCases |> List.item tag |> getUnionCaseName |> ofString
-            let values = (ofInt tag)::values |> List.toArray
-            Expression.newExpression(consRef, values, ?typeArguments=typeParamInst, ?loc=r)
+            if FSharp2Fable.Util.isErasedEntity com ent then
+                let caseTag = tag |> ofInt
+                let caseName = ent.UnionCases |> List.item tag |> getUnionCaseName |> ofString
+                caseTag::caseName::values |> List.toArray |> Expression.arrayExpression
+            else
+                let consRef = ent |> jsConstructor com ctx
+                let typeParamInst =
+                    if com.Options.Typescript
+                    then makeGenTypeParamInst com ctx genArgs
+                    else None
+                // let caseName = ent.UnionCases |> List.item tag |> getUnionCaseName |> ofString
+                let values = (ofInt tag)::values |> List.toArray
+                Expression.newExpression(consRef, values, ?typeArguments=typeParamInst, ?loc=r)
 
     let enumerator2iterator com ctx =
         let enumerator = Expression.callExpression(get None (Expression.identifier("this")) "GetEnumerator", [||])
@@ -1201,7 +1230,14 @@ module Util =
             let expr = com.TransformAsExpr(ctx, fableExpr)
             match key with
             | Fable.ExprKey(TransformExpr com ctx prop) -> getExpr range expr prop
-            | Fable.FieldKey field -> get range expr field.Name
+            | Fable.FieldKey field ->
+                match fableExpr.Type with
+                | Replacements.ErasedType com (fieldNames, offset, _, _) ->
+                    let indexOpt = fieldNames |> Array.tryFindIndex (fun name -> name = field.Name)
+                    match indexOpt with
+                    | Some index -> getExpr range expr (ofInt (offset + index))
+                    | _ -> get range expr field.Name
+                | _ -> get range expr field.Name
 
         | Fable.ListHead ->
             // get range (com.TransformAsExpr(ctx, fableExpr)) "head"
@@ -1229,15 +1265,26 @@ module Util =
 
         | Fable.UnionField(index, _) ->
             let expr = com.TransformAsExpr(ctx, fableExpr)
-            getExpr range (getExpr None expr (Expression.stringLiteral("fields"))) (ofInt index)
+            match fableExpr.Type with
+            | Replacements.ErasedType com (_, offset, _, _) ->
+                getExpr range expr (ofInt (offset + index))
+            | _ ->
+                getExpr range (getExpr None expr (Expression.stringLiteral("fields"))) (ofInt index)
 
     let transformSet (com: IBabelCompiler) ctx range fableExpr (value: Fable.Expr) kind =
         let expr = com.TransformAsExpr(ctx, fableExpr)
         let value = com.TransformAsExpr(ctx, value) |> wrapIntExpression value.Type
         let ret =
             match kind with
             | None -> expr
-            | Some(Fable.FieldKey fi) -> get None expr fi.Name
+            | Some(Fable.FieldKey field) ->
+                match fableExpr.Type with
+                | Replacements.ErasedType com (fieldNames, offset, _, _) ->
+                    let indexOpt = fieldNames |> Array.tryFindIndex (fun name -> name = field.Name)
+                    match indexOpt with
+                    | Some index -> getExpr None expr (ofInt (offset + index))
+                    | _ -> get None expr field.Name
+                | _ -> get None expr field.Name
             | Some(Fable.ExprKey(TransformExpr com ctx e)) -> getExpr None expr e
         assign range ret value
 

src/Fable.Transforms/Global/Compiler.fs

@@ -5,7 +5,8 @@ module Literals =
 
 type CompilerOptionsHelper =
     static member DefaultExtension = ".fs.js"
-    static member Make(?typedArrays,
+    static member Make(?eraseTypes,
+                       ?typedArrays,
                        ?typescript,
                        ?define,
                        ?optimizeFSharpAst,
@@ -17,6 +18,7 @@ type CompilerOptionsHelper =
         { new CompilerOptions with
               member _.Define = define
               member _.DebugMode = isDebug
+              member _.EraseTypes = defaultArg eraseTypes false
               member _.Typescript = defaultArg typescript false
               member _.TypedArrays = defaultArg typedArrays true
               member _.OptimizeFSharpAst = defaultArg optimizeFSharpAst false

src/Fable.Transforms/Replacements.fs

@@ -278,6 +278,20 @@ let (|NewAnonymousRecord|_|) = function
         Some([], exprs, fieldNames, genArgs, r)
     | _ -> None
 
+let (|ErasedType|_|) (com: Compiler) = function
+    | Fable.AnonymousRecordType (fieldNames, genArgs) when com.Options.EraseTypes ->
+        Some (fieldNames, 0, false, genArgs)
+    | Fable.DeclaredType (ent, genArgs) ->
+        let ent = com.GetEntity(ent)
+        if FSharp2Fable.Util.isErasedEntity com ent then
+            let offset = if ent.IsFSharpUnion then 2 else 1
+            let fieldNames =
+                if ent.IsFSharpUnion then [||] // not used for unions
+                else ent.FSharpFields |> List.map (fun x -> x.Name) |> List.toArray
+            Some (fieldNames, offset, ent.IsFSharpUnion, genArgs)
+        else None
+    | _ -> None
+
 let coreModFor = function
     | BclGuid -> "Guid"
     | BclDateTime -> "Date"
@@ -436,6 +450,9 @@ let toString com (ctx: Context) r (args: Expr list) =
         | Number _ -> Helper.InstanceCall(head, "toString", String, tail)
         | Array _ | List _ ->
             Helper.LibCall(com, "Types", "seqToString", String, [head], ?loc=r)
+        | ErasedType com (_, offset, isUnion, _) ->
+            let args = [makeIntConst offset; makeBoolConst isUnion; head]
+            Helper.LibCall(com, "Types", "erasedTypeToString", String, args, ?loc=r)
         // | DeclaredType(ent, _) when ent.IsFSharpUnion || ent.IsFSharpRecord || ent.IsValueType ->
         //     Helper.InstanceCall(head, "toString", String, [], ?loc=r)
         // | DeclaredType(ent, _) ->
@@ -732,6 +749,7 @@ let identityHash com r (arg: Expr) =
         // | Array _ -> "arrayHash"
         // | Builtin (BclDateTime|BclDateTimeOffset) -> "dateHash"
         // | Builtin (BclInt64|BclUInt64|BclDecimal) -> "fastStructuralHash"
+        | ErasedType com _ -> "structuralHash"
         | DeclaredType _ -> "safeHash"
         | _ -> "identityHash"
     Helper.LibCall(com, "Util", methodName, Number Int32, [arg], ?loc=r)
@@ -748,6 +766,7 @@ let structuralHash (com: ICompiler) r (arg: Expr) =
         | Array _ -> "arrayHash"
         | Builtin (BclDateTime|BclDateTimeOffset) -> "dateHash"
         | Builtin (BclInt64|BclUInt64|BclDecimal) -> "fastStructuralHash"
+        | ErasedType com _ -> "structuralHash"
         | DeclaredType(ent, _) ->
             let ent = com.GetEntity(ent)
             if not ent.IsInterface then "safeHash"
@@ -770,6 +789,8 @@ let rec equals (com: ICompiler) ctx r equal (left: Expr) (right: Expr) =
         Helper.InstanceCall(left, "Equals", Boolean, [right]) |> is equal
     | Builtin (BclInt64|BclUInt64|BclDecimal|BclBigInt as bt) ->
         Helper.LibCall(com, coreModFor bt, "equals", Boolean, [left; right], ?loc=r) |> is equal
+    | ErasedType com _ ->
+        Helper.LibCall(com, "Util", "equalArrays", Boolean, [left; right], ?loc=r) |> is equal
     | DeclaredType _ ->
         Helper.LibCall(com, "Util", "equals", Boolean, [left; right], ?loc=r) |> is equal
     | Array t ->
@@ -794,6 +815,8 @@ and compare (com: ICompiler) ctx r (left: Expr) (right: Expr) =
         Helper.LibCall(com, "Date", "compare", Number Int32, [left; right], ?loc=r)
     | Builtin (BclInt64|BclUInt64|BclDecimal|BclBigInt as bt) ->
         Helper.LibCall(com, coreModFor bt, "compare", Number Int32, [left; right], ?loc=r)
+    | ErasedType com _ ->
+        Helper.LibCall(com, "Util", "compareArrays", Number Int32, [left; right], ?loc=r)
     | DeclaredType _ ->
         Helper.LibCall(com, "Util", "compare", Number Int32, [left; right], ?loc=r)
     | Array t ->

src/fable-compiler-js/src/Platform.fs

@@ -10,6 +10,7 @@ type CmdLineOptions = {
     sourceMaps: bool
     typedArrays: bool
     typescript: bool
+    eraseTypes: bool
     printAst: bool
     // watch: bool
 }

src/fable-compiler-js/src/app.fs

@@ -162,6 +162,7 @@ let parseFiles projectFileName options =
 
     let parseFable (res, fileName) =
         fable.CompileToBabelAst(libDir, res, fileName,
+            eraseTypes = options.eraseTypes,
             typedArrays = options.typedArrays,
             typescript = options.typescript)
 
@@ -258,6 +259,7 @@ let run opts projectFileName outDir =
         typedArrays = opts |> tryFlag "--typedArrays"
                            |> Option.defaultValue (opts |> hasFlag "--typescript" |> not)
         typescript = opts |> hasFlag "--typescript"
+        eraseTypes = opts |> hasFlag "--eraseTypes"
         printAst = opts |> hasFlag "--printAst"
         // watch = opts |> hasFlag "--watch"
     }

src/fable-library/Types.ts

@@ -17,6 +17,20 @@ export function seqToString<T>(self: Iterable<T>): string {
   return str + "]";
 }
 
+export function erasedTypeToString(offset: number, isUnion: boolean, fields: any[]) {
+  if (Array.isArray(fields) && offset > 0) {
+    const name = toString(fields[offset - 1]);
+    if (isUnion) {
+      const caseName = name.substring(name.lastIndexOf(".") + 1);
+      return unionToString(caseName, fields.slice(offset));
+    } else {
+      return name; // records and value types
+    }
+  } else {
+    return toString(fields);
+  }
+}
+
 export function toString(x: any, callStack = 0): string {
   if (x != null && typeof x === "object") {
     if (typeof x.toString === "function") {