Added support for erased records

.vscode/launch.json

@@ -65,8 +65,8 @@
             "name": "Run bench-compiler (.NET)",
             "program": "${workspaceFolder}/src/fable-standalone/test/bench-compiler/bin/Debug/netcoreapp3.1/bench-compiler.dll",
             // "args": ["${workspaceRoot}/tests/Main/Fable.Tests.fsproj", "out-tests"],
-            // "args": ["${workspaceRoot}/../fable-test/fable-test.fsproj", "out-test", "--typescript"],
-            "args": ["${workspaceRoot}/src/fable-library/Fable.Library.fsproj", "out-lib", "--typescript"],
+            "args": ["${workspaceRoot}/../fable-test/fable-test.fsproj", "out-test", "--typescript"],
+            // "args": ["${workspaceRoot}/src/fable-library/Fable.Library.fsproj", "out-lib", "--typescript"],
             "cwd": "${workspaceFolder}/src/fable-standalone/test/bench-compiler"
         },
         {

src/Fable.AST/Fable.fs

@@ -262,6 +262,7 @@ type KeyKind =
 type GetKind =
     | ByKey of KeyKind
     | TupleIndex of int
+    | FieldIndex of string * int
     | UnionField of index: int * fieldType: Type
     | UnionTag
     | ListHead

src/Fable.Transforms/FSharp2Fable.Util.fs

@@ -441,6 +441,10 @@ module Helpers =
     let makeRangeFrom (fsExpr: FSharpExpr) =
         Some (makeRange fsExpr.Range)
 
+    let isErasedRecord (com: Compiler) (t: FSharpType) =
+        // TODO: check for custom equality or comparison
+        com.Options.EraseUnions && t.HasTypeDefinition && t.TypeDefinition.IsFSharpRecord
+
     let unionCaseTag (ent: FSharpEntity) (unionCase: FSharpUnionCase) =
         try
             ent.UnionCases |> Seq.findIndex (fun uci -> unionCase.Name = uci.Name)
@@ -705,8 +709,7 @@ module Patterns =
         match tryDefinition typ with
         | None -> failwith "Union without definition"
         | Some(tdef, fullName) ->
-            let fullName = defaultArg fullName tdef.CompiledName
-            match fullName with
+            match defaultArg fullName tdef.CompiledName with
             | Types.valueOption
             | Types.option -> OptionUnion typ.GenericArguments.[0]
             | Types.list -> ListUnion typ.GenericArguments.[0]

src/Fable.Transforms/FSharp2Fable.fs

@@ -640,21 +640,30 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) fsExpr =
 
     // Getters and Setters
     | BasicPatterns.AnonRecordGet(callee, calleeType, fieldIndex) ->
+        let r = makeRangeFrom fsExpr
         let! callee = transformExpr com ctx callee
-        let fieldName = calleeType.AnonRecordTypeDetails.SortedFieldNames.[fieldIndex]
         let typ = makeType ctx.GenericArgs fsExpr.Type
-        let key = FsField(fieldName, lazy typ) :> Fable.Field |> Fable.FieldKey
-        return Fable.Get(callee, Fable.ByKey key, typ, makeRangeFrom fsExpr)
+        let fieldName = calleeType.AnonRecordTypeDetails.SortedFieldNames.[fieldIndex]
+        if isErasedRecord com calleeType then
+            return Fable.Get(callee, Fable.FieldIndex(fieldName, fieldIndex), typ, r)
+        else
+            let key = FsField(fieldName, lazy typ) :> Fable.Field |> Fable.FieldKey
+            return Fable.Get(callee, Fable.ByKey key, typ, r)
 
     | BasicPatterns.FSharpFieldGet(callee, calleeType, field) ->
+        let r = makeRangeFrom fsExpr
         let! callee = transformExprOpt com ctx callee
         let callee =
             match callee with
             | Some callee -> callee
             | None -> entityRef com (FsEnt calleeType.TypeDefinition)
-        let key = FsField field :> Fable.Field |> Fable.FieldKey
         let typ = makeType ctx.GenericArgs fsExpr.Type
-        return Fable.Get(callee, Fable.ByKey key, typ, makeRangeFrom fsExpr)
+        if isErasedRecord com calleeType then
+            let index = calleeType.TypeDefinition.FSharpFields |> Seq.findIndex (fun x -> x.Name = field.Name)
+            return Fable.Get(callee, Fable.FieldIndex(field.Name, index + 1), typ, r)
+        else
+            let key = FsField field :> Fable.Field |> Fable.FieldKey
+            return Fable.Get(callee, Fable.ByKey key, typ, r)
 
     | BasicPatterns.TupleGet(_tupleType, tupleElemIndex, tupleExpr) ->
         let! tupleExpr = transformExpr com ctx tupleExpr
@@ -772,15 +781,24 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) fsExpr =
         return Fable.Sequential exprs
 
     | BasicPatterns.NewRecord(fsType, argExprs) ->
+        let r = makeRangeFrom fsExpr
         let! argExprs = transformExprList com ctx argExprs
-        let genArgs = makeGenArgs ctx.GenericArgs (getGenericArguments fsType)
-        return Fable.NewRecord(argExprs, FsEnt.Ref fsType.TypeDefinition, genArgs) |> makeValue (makeRangeFrom fsExpr)
+        if isErasedRecord com fsType then
+            let recordName = (makeStrConst (getFsTypeFullName fsType))
+            return recordName::argExprs |> Fable.NewTuple |> makeValue r
+        else
+            let genArgs = makeGenArgs ctx.GenericArgs (getGenericArguments fsType)
+            return Fable.NewRecord(argExprs, FsEnt.Ref fsType.TypeDefinition, genArgs) |> makeValue r
 
     | BasicPatterns.NewAnonRecord(fsType, argExprs) ->
+        let r = makeRangeFrom fsExpr
         let! argExprs = transformExprList com ctx argExprs
-        let fieldNames = fsType.AnonRecordTypeDetails.SortedFieldNames
-        let genArgs = makeGenArgs ctx.GenericArgs (getGenericArguments fsType)
-        return Fable.NewAnonymousRecord(argExprs, fieldNames, genArgs) |> makeValue (makeRangeFrom fsExpr)
+        if isErasedRecord com fsType then
+            return argExprs |> Fable.NewTuple |> makeValue r
+        else
+            let fieldNames = fsType.AnonRecordTypeDetails.SortedFieldNames
+            let genArgs = makeGenArgs ctx.GenericArgs (getGenericArguments fsType)
+            return Fable.NewAnonymousRecord(argExprs, fieldNames, genArgs) |> makeValue r
 
     | BasicPatterns.NewUnionCase(fsType, unionCase, argExprs) ->
         let! argExprs = transformExprList com ctx argExprs

src/Fable.Transforms/Fable2Babel.fs

@@ -1189,6 +1189,7 @@ module Util =
         | Fable.ListTail ->
             get range (com.TransformAsExpr(ctx, fableExpr)) "tail"
 
+        | Fable.FieldIndex (_, index)
         | Fable.TupleIndex index ->
             match fableExpr with
             // TODO: Check the erased expressions don't have side effects?

src/Fable.Transforms/FableTransforms.fs

@@ -59,8 +59,8 @@ let visit f e =
             Operation(Logical(op, f left, f right), t, r)
     | Get(e, kind, t, r) ->
         match kind with
-        | ListHead | ListTail | OptionValue | TupleIndex _ | UnionTag
-        | UnionField _ | ByKey(FieldKey _) -> Get(f e, kind, t, r)
+        | ListHead | ListTail | OptionValue | TupleIndex _ | FieldIndex _
+        | UnionTag | UnionField _ | ByKey(FieldKey _) -> Get(f e, kind, t, r)
         | ByKey(ExprKey e2) -> Get(f e, ByKey(ExprKey(f e2)), t, r)
     | Sequential exprs -> Sequential(List.map f exprs)
     | Let(bs, body) ->
@@ -130,8 +130,8 @@ let getSubExpressions = function
         | Logical(_, left, right) -> [left; right]
     | Get(e, kind, _, _) ->
         match kind with
-        | ListHead | ListTail | OptionValue | TupleIndex _ | UnionTag
-        | UnionField _ | ByKey(FieldKey _) -> [e]
+        | ListHead | ListTail | OptionValue | TupleIndex _ | FieldIndex _
+        | UnionTag | UnionField _ | ByKey(FieldKey _) -> [e]
         | ByKey(ExprKey e2) -> [e; e2]
     | Sequential exprs -> exprs
     | Let(bs, body) -> (List.map snd bs) @ [body]

src/Fable.Transforms/Replacements.fs

@@ -214,6 +214,7 @@ let (|Nameof|_|) com ctx = function
     | IdentExpr ident -> Some ident.DisplayName
     | Get(_, ByKey(ExprKey(StringConst prop)), _, _) -> Some prop
     | Get(_, ByKey(FieldKey fi), _, _) -> Some fi.Name
+    | Get(_, FieldIndex(fieldName, _), _, _) -> Some fieldName
     | NestedLambda(args, Call(IdentExpr ident, info, _, _), None) ->
         if List.sameLength args info.Args && List.zip args info.Args |> List.forall (fun (a1, a2) ->
             match a2 with IdentExpr id2 -> a1.Name = id2.Name | _ -> false)
@@ -693,24 +694,47 @@ let isCompatibleWithJsComparison = function
 // * `.GetHashCode` called directly defaults to identity hash (for reference types except string) if not implemented.
 // * `LanguagePrimitive.PhysicalHash` creates an identity hash no matter whether GetHashCode is implemented or not.
 
-let getEntityHashMethod (ent: Entity) =
-    if ent.IsFSharpUnion || ent.IsFSharpRecord || ent.IsValueType then "Util", "hashSafe"
+let getEntityHashMethod (com: ICompiler) (ent: Entity) =
+    if (ent.IsFSharpUnion || ent.IsFSharpRecord) then
+        if com.Options.EraseUnions
+        then "Util", "structuralHash"
+        else "Util", "hashSafe"
+    elif ent.IsValueType
+    then "Util", "hashSafe"
     else "Util", "identityHash"
 
+let getEntityEqualsMethod (com: ICompiler) (ent: Entity) =
+    if (ent.IsFSharpUnion || ent.IsFSharpRecord) then
+        if com.Options.EraseUnions
+        then "Util", "equals"
+        else "Util", "equalsSafe"
+    elif ent.IsValueType
+    then "Util", "equalsSafe"
+    else "Util", "equals"
+
+let getEntityCompareMethod (com: ICompiler) (ent: Entity) =
+    if (ent.IsFSharpUnion || ent.IsFSharpRecord) then
+        if com.Options.EraseUnions
+        then "Util", "compare"
+        else "Util", "compareSafe"
+    elif ent.IsValueType
+    then "Util", "compareSafe"
+    else "Util", "compare"
+
 let identityHashMethod (com: ICompiler) = function
     | Boolean | Char | String | Number _ | Enum _ | Option _ | Tuple _ | List _
     | Builtin (BclInt64 | BclUInt64 | BclDecimal | BclBigInt)
     | Builtin (BclGuid | BclTimeSpan | BclDateTime | BclDateTimeOffset)
     | Builtin (FSharpSet _ | FSharpMap _ | FSharpChoice _ | FSharpResult _) ->
         "Util", "structuralHash"
-    | DeclaredType(ent, _) -> com.GetEntity(ent) |> getEntityHashMethod
+    | DeclaredType(ent, _) -> com.GetEntity(ent) |> getEntityHashMethod com
     | _ -> "Util", "identityHash"
 
 let structuralHashMethod (com: ICompiler) = function
     | MetaType -> "Reflection", "getHashCode"
     | DeclaredType(ent, _) ->
         let ent = com.GetEntity(ent)
-        if not ent.IsInterface then getEntityHashMethod ent
+        if not ent.IsInterface then getEntityHashMethod com ent
         else "Util", "structuralHash"
     | _ -> "Util", "structuralHash"
 
@@ -739,10 +763,8 @@ let rec equals (com: ICompiler) ctx r equal (left: Expr) (right: Expr) =
         Helper.LibCall(com, coreModFor bt, "equals", Boolean, [left; right], ?loc=r) |> is equal
     | DeclaredType(ent, _) ->
         let ent = com.GetEntity(ent)
-        if ent.IsFSharpUnion || ent.IsFSharpRecord || ent.IsValueType then
-            Helper.LibCall(com, "Util", "equalsSafe", Boolean, [left; right], ?loc=r) |> is equal
-        else
-            Helper.LibCall(com, "Util", "equals", Boolean, [left; right], ?loc=r) |> is equal
+        let moduleName, methodName = getEntityEqualsMethod com ent
+        Helper.LibCall(com, moduleName, methodName, Boolean, [left; right], ?loc=r) |> is equal
     | Array t ->
         let f = makeComparerFunction com ctx t
         Helper.LibCall(com, "Array", "equalsWith", Boolean, [f; left; right], ?loc=r) |> is equal
@@ -767,10 +789,8 @@ and compare (com: ICompiler) ctx r (left: Expr) (right: Expr) =
         Helper.LibCall(com, coreModFor bt, "compare", Number Int32, [left; right], ?loc=r)
     | DeclaredType(ent, _) ->
         let ent = com.GetEntity(ent)
-        if ent.IsFSharpUnion || ent.IsFSharpRecord || ent.IsValueType then
-            Helper.LibCall(com, "Util", "compareSafe", Number Int32, [left; right], ?loc=r)
-        else
-            Helper.LibCall(com, "Util", "compare", Number Int32, [left; right], ?loc=r)
+        let moduleName, methodName = getEntityCompareMethod com ent
+        Helper.LibCall(com, moduleName, methodName, Number Int32, [left; right], ?loc=r)
     | Array t ->
         let f = makeComparerFunction com ctx t
         Helper.LibCall(com, "Array", "compareWith", Number Int32, [f; left; right], ?loc=r)

src/fable-standalone/src/Interfaces.fs

@@ -64,7 +64,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
+                                * ?eraseUnions: 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

@@ -258,14 +258,16 @@ let init () =
             getCompletionsAtLocation res line col lineText
 
         member __.CompileToBabelAst(fableLibrary:string, parseResults:IParseResults, fileName:string,
-                                    ?typedArrays, ?typescript) =
+                                    ?eraseUnions, ?typedArrays, ?typescript) =
             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(define=define, ?typedArrays=typedArrays, ?typescript=typescript)
+            let options =
+                Fable.CompilerOptionsHelper.Make(define=define,
+                    ?eraseUnions=eraseUnions, ?typedArrays=typedArrays, ?typescript=typescript)
             let com = CompilerImpl(fileName, project, options, fableLibrary)
             let ast =
                 FSharp2Fable.Compiler.transformFile com

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

@@ -6,6 +6,7 @@ type CmdLineOptions = {
     benchmark: bool
     optimize: bool
     // sourceMaps: bool
+    eraseUnions: bool
     typedArrays: bool
     typescript: bool
     printAst: bool

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

@@ -145,6 +145,7 @@ let parseFiles projectFileName options =
 
     let parseFable (res, fileName) =
         fable.CompileToBabelAst(libDir, res, fileName,
+            eraseUnions = options.eraseUnions,
             typedArrays = options.typedArrays,
             typescript = options.typescript)
 
@@ -227,6 +228,7 @@ let run opts projectFileName outDir =
         benchmark = opts |> hasFlag "--benchmark"
         optimize = opts |> hasFlag "--optimize"
         // sourceMaps = opts |> hasFlag "--sourceMaps"
+        eraseUnions = opts |> hasFlag "--eraseUnions"
         typedArrays = opts |> tryFlag "--typedArrays"
                            |> Option.defaultValue (opts |> hasFlag "--typescript" |> not)
         typescript = opts |> hasFlag "--typescript"

src/fable-standalone/test/bench-compiler/package.json

@@ -1,6 +1,6 @@
 {
   "private": true,
-  "type": "module",
+  "_type": "module",
   "scripts": {
     "build-cli": "dotnet run -c Release -p ../../../Fable.Cli -- bench-compiler.fsproj --outDir out-node",
     "postbuild-cli": "npm run rollup-bundle",
@@ -44,7 +44,7 @@
     "build-tests-dotnet-ts": "dotnet run -c Release ../../../../tests/Main/Fable.Tests.fsproj out-tests --typescript",
     "build-tests-dotnet-opt": "dotnet run -c Release ../../../../tests/Main/Fable.Tests.fsproj out-tests --optimize",
     "build-tests-node": "node out-node/app.js ../../../../tests/Main/Fable.Tests.fsproj out-tests",
-    "pretests": "npm run build-tests-dotnet",
+    "_pretests": "npm run build-tests-dotnet -- --eraseUnions",
     "tests": "npm run mocha -- out-tests -r esm --colors",
 
     "tsc": "node ../../../../node_modules/typescript/bin/tsc",