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

@@ -14,6 +14,7 @@ type Language =
     | TypeScript
 
 type CompilerOptions =
+      abstract EraseTypes: bool
       abstract TypedArrays: bool
       abstract ClampByteArrays: bool
       abstract Language: Language

src/Fable.Cli/Entry.fs

@@ -172,6 +172,7 @@ type Runner =
 
         let compilerOptions =
             CompilerOptionsHelper.Make(language=language,
+                                       eraseTypes = flagEnabled "--eraseTypes" args,
                                        typedArrays = typedArrays,
                                        fileExtension = fileExt,
                                        define = define,

src/Fable.Transforms/FSharp2Fable.Util.fs

@@ -448,6 +448,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.
@@ -1180,6 +1190,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

@@ -310,6 +310,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 ->
@@ -382,6 +388,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) ->
@@ -813,9 +820,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) =
@@ -961,27 +977,39 @@ 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.Language = 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 typeParamInst =
+                    if com.Options.Language = TypeScript && (ent.FullName = Types.reference)
+                    then makeGenTypeParamInst com ctx genArgs
+                    else None
+                Expression.newExpression(consRef, values |> List.toArray, ?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.Language = 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.Language = 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", [||])
@@ -1200,7 +1228,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"
@@ -1228,15 +1263,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

@@ -6,6 +6,7 @@ module Literals =
 type CompilerOptionsHelper =
     static member DefaultExtension = ".fs.js"
     static member Make(?language,
+                       ?eraseTypes,
                        ?typedArrays,
                        ?define,
                        ?optimizeFSharpAst,
@@ -18,6 +19,7 @@ type CompilerOptionsHelper =
               member _.Define = define
               member _.DebugMode = isDebug
               member _.Language = defaultArg language JavaScript
+              member _.EraseTypes = defaultArg eraseTypes false
               member _.TypedArrays = defaultArg typedArrays true
               member _.OptimizeFSharpAst = defaultArg optimizeFSharpAst false
               member _.Verbosity = defaultArg verbosity Verbosity.Normal

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") {

src/fable-standalone/src/Interfaces.fs

@@ -67,7 +67,9 @@ type IFableManager =
     abstract GetToolTipText: parseResults: IParseResults * line: int * col: int * lineText: string -> string[]
     abstract GetCompletionsAtLocation: parseResults: IParseResults * line: int * col: int * lineText: string -> Completion[]
     abstract CompileToBabelAst: fableLibrary: string * parseResults: IParseResults * fileName: string
+                                * ?eraseTypes: bool
                                 * ?typedArrays: bool
-                                * ?typescript: bool -> IBabelResult
+                                * ?typescript: bool
+                                -> IBabelResult
     abstract PrintBabelAst: babelResult: IBabelResult * IWriter -> Async<unit>
     abstract FSharpAstToString: parseResults: IParseResults * fileName: string -> string

src/fable-standalone/src/Main.fs

@@ -212,14 +212,15 @@ let getCompletionsAtLocation (parseResults: ParseResults) (line: int) (col: int)
     | None ->
         [||]
 
-let compileToFableAst (parseResults: IParseResults) fileName fableLibrary typedArrays language =
+let compileToFableAst (parseResults: IParseResults) fileName fableLibrary typedArrays language eraseTypes =
     let res = parseResults :?> ParseResults
     let project = res.GetProject()
     let define = parseResults.OtherFSharpOptions |> Array.choose (fun x ->
         if x.StartsWith("--define:") || x.StartsWith("-d:")
         then x.[(x.IndexOf(':') + 1)..] |> Some
         else None) |> Array.toList
-    let options = Fable.CompilerOptionsHelper.Make(language=language, define=define, ?typedArrays=typedArrays)
+    let options = Fable.CompilerOptionsHelper.Make(language=language,
+                    define=define, ?typedArrays=typedArrays, ?eraseTypes=eraseTypes)
     let com = CompilerImpl(fileName, project, options, fableLibrary)
     let fableAst =
         FSharp2Fable.Compiler.transformFile com
@@ -288,10 +289,10 @@ let init () =
             getCompletionsAtLocation res line col lineText
 
         member __.CompileToBabelAst(fableLibrary:string, parseResults:IParseResults, fileName:string,
-                                    ?typedArrays, ?typescript) =
+                                    ?typedArrays, ?typescript, ?eraseTypes) =
             let language = match typescript with | Some true -> TypeScript | _ -> JavaScript
             let com, fableAst, errors =
-                compileToFableAst parseResults fileName fableLibrary typedArrays language
+                compileToFableAst parseResults fileName fableLibrary typedArrays language eraseTypes
             let babelAst =
                 fableAst |> Fable2Babel.Compiler.transformFile com
             upcast BabelResult(babelAst, errors)

src/fable-standalone/test/bench-compiler/Platform.fs

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