Fixed erased type testing

Author: ncave

src/Fable.Transforms/FSharp2Fable.Util.fs

@@ -436,14 +436,15 @@ module Helpers =
     let makeRangeFrom (fsExpr: FSharpExpr) =
         Some (makeRange fsExpr.Range)
 
-    let isErasedType (com: Compiler) (t: FSharpType) =
-        // TODO: value types
+    let isErasedTypeDef (com: Compiler) (tdef: FSharpEntity) =
         com.Options.EraseUnions
-        && t.HasTypeDefinition
-        && (t.TypeDefinition.IsFSharpRecord || t.TypeDefinition.IsFSharpUnion)
-        && not (t.TypeDefinition.TryFullName = Some Types.reference) // F# refs are records
-        && not (hasAttribute Atts.customEquality t.TypeDefinition.Attributes)
-        && not (hasAttribute Atts.customComparison t.TypeDefinition.Attributes)
+        && (tdef.IsFSharpUnion || tdef.IsFSharpRecord) // || tdef.IsValueType)
+        && 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
@@ -1174,6 +1175,11 @@ 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/FSharp2Fable.fs

@@ -58,7 +58,7 @@ let private transformNewUnion com ctx r fsType (unionCase: FSharpUnionCase) (arg
         | EraseKind.AsValue, _ -> failwith "Shouldn't happen, error?"
         | EraseKind.AsTuple, _ -> Fable.NewTuple argExprs |> makeValue r
         | EraseKind.AsNamedTuple, _ ->
-            let caseTag = unionCaseTag tdef unionCase |> makeIntConst
+            let caseTag = unionCaseTag com tdef unionCase |> makeIntConst
             let caseName = makeStrConst unionCase.CompiledName
             caseTag::caseName::argExprs |> Fable.NewTuple |> makeValue r
     | OptionUnion typ ->
@@ -231,7 +231,7 @@ let private transformUnionCaseTest (com: IFableCompiler) (ctx: Context) r
             return makeEqOp r unionExpr (transformStringEnum caseRule unionCase) BinaryEqualStrict
         | EraseKind.AsNamedTuple ->
             let tag1 = Fable.Get(unionExpr, Fable.TupleIndex(0), Fable.Number Int32, None)
-            let tag2 = unionCaseTag tdef unionCase |> makeIntConst
+            let tag2 = unionCaseTag com tdef unionCase |> makeIntConst
             return makeEqOp r tag1 tag2 BinaryEqualStrict
             // if unionCase.UnionCaseFields.Count = 0 then
             //     return makeEqOp r unionExpr (transformStringEnum caseRule unionCase) BinaryEqualStrict

src/Fable.Transforms/Fable2Babel.fs

@@ -256,9 +256,6 @@ module Reflection =
             |]
             |> libReflectionCall com ctx r "class"
 
-    let private ofString s = StringLiteral s :> Expression
-    let private ofArray babelExprs = ArrayExpression(List.toArray babelExprs) :> Expression
-
     let transformTypeTest (com: IBabelCompiler) ctx range expr (typ: Fable.Type): Expression =
         let warnAndEvalToFalse msg =
             "Cannot type test (evals to false): " + msg
@@ -311,6 +308,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
+                    upcast BinaryExpression(BinaryEqualStrict, actual, expected, ?loc=range)
                 else
                     match tryJsConstructor com ctx ent with
                     | Some cons ->

src/Fable.Transforms/Replacements.fs

@@ -417,6 +417,13 @@ let toString com (ctx: Context) r (args: Expr list) =
         // | DeclaredType(ent, _) when ent.IsFSharpUnion || ent.IsFSharpRecord || ent.IsValueType ->
         //     Helper.InstanceCall(head, "toString", String, [], ?loc=r)
         // | DeclaredType(ent, _) ->
+        //     let ent = com.GetEntity(ent)
+        //     if FSharp2Fable.Util.isErasedEntity com ent then
+        //         if ent.IsFSharpUnion
+        //         then emitJsExpr r String [head] "$0.shift().join(' ')" // unions
+        //         else emitJsExpr r String [head] "$0[0]" // records and value types
+        //     else
+        //         Helper.LibCall(com, "Types", "toString", String, [head], ?loc=r)
         | _ -> Helper.LibCall(com, "Types", "toString", String, [head], ?loc=r)
 
 let getParseParams (kind: NumberExtKind) =

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

@@ -26,8 +26,9 @@
     "terser-bundle": "npm run terser -- dist/bundle.js -o dist/bundle.min.js --mangle --compress",
     "webpack-bundle": "npm run webpack -- -p --entry ./out-node/app.js --output ./dist/bundle.min.js --target node",
 
-    "prebuild-lib-dotnet": "git clean -fdx && npm run tsc -- -p ../../../fable-library --outDir ./out-lib",
+    "build-lib-ts": "npm run tsc -- -p ../../../fable-library --outDir ./out-lib",
     "build-lib-dotnet": "dotnet run -c Release ../../../fable-library/Fable.Library.fsproj out-lib --fableLib out-lib",
+    "build-lib-erased": "dotnet run -c Release ../../../fable-library/Fable.Library.fsproj out-lib --fableLib out-lib --eraseUnions",
     "prebuild-lib-dotnet-ts": "git clean -fdx && mkdir out-lib && cp -R ../../../fable-library/*.ts out-lib",
     "build-lib-dotnet-ts": "dotnet run -c Release ../../../fable-library/Fable.Library.fsproj out-lib --typescript --fableLib out-lib",
     "tsc-lib-init": "npm run tsc -- --init --target es2020 --module es2020 --allowJs",
@@ -46,13 +47,10 @@
     "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",
+    "prebuild-tests-erased": "git clean -fdx && npm run build-lib-erased && npm run build-lib-ts",
+    "build-tests-erased": "npm run build-tests-dotnet -- --fableLib out-lib --eraseUnions",
     "tests": "npm run mocha -- out-tests -r esm --colors --reporter dot",
 
-    "prebuild-fable-library": "dotnet run -c Release ../../../fable-library/Fable.Library.fsproj out-lib --fableLib out-lib --eraseUnions",
-    "build-fable-library": "npm run tsc -- -p ../../../fable-library --outDir ./out-lib",
-    "prebuild-tests": "git clean -fdx && npm run build-fable-library",
-    "build-tests": "npm run build-tests-dotnet -- --fableLib out-lib --eraseUnions",
-
     "tsc": "node ../../../../node_modules/typescript/bin/tsc",
     "babel": "node ../../../../node_modules/@babel/cli/bin/babel",
     "mocha": "node ../../../../node_modules/mocha/bin/mocha",