Separate StringEnum handling

fable-compiler · Dec 22, 2020 · 611657c · 611657c
1 parent a36c730
commit 611657c
Show file tree

Hide file tree

Showing 4 changed files with 44 additions and 41 deletions.
diff --git a/src/Fable.Transforms/FSharp2Fable.Util.fs b/src/Fable.Transforms/FSharp2Fable.Util.fs
@@ -686,7 +686,8 @@ module Patterns =
     type EraseKind =
         | AsValue
         | AsTuple
-        | AsNamedTuple of CaseRules
+        | AsNamedTuple
+        | AsStringEnum of CaseRules
 
     let (|OptionUnion|ListUnion|ErasedUnion|DiscriminatedUnion|)
             (com: Compiler, NonAbbreviatedType typ: FSharpType, unionCase: FSharpUnionCase) =
@@ -696,18 +697,19 @@ module Patterns =
             | Some(_, (:? int as rule)) -> enum<CaseRules>(rule)
             | _ -> CaseRules.LowerFirst
 
-        let getEraseKind (tdef: FSharpEntity) caseRule =
-            if tdef.UnionCases.Count = 1 && tdef.UnionCases.[0].UnionCaseFields.Count = 1
-            then EraseKind.AsValue
-            else EraseKind.AsNamedTuple(caseRule)
+        let getEraseKind (tdef: FSharpEntity) (att: FSharpAttribute) =
+            match unionCase.UnionCaseFields.Count with
+            | 0 -> EraseKind.AsStringEnum(getCaseRule att)
+            | 1 -> EraseKind.AsValue
+            | _ -> EraseKind.AsTuple
 
         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]
+            | Types.option -> OptionUnion(typ.GenericArguments.[0])
+            | Types.list -> ListUnion(typ.GenericArguments.[0])
             | _ ->
                 unionCase.Attributes |> Seq.tryPick (fun att ->
                     match att.AttributeType.TryFullName with
@@ -719,13 +721,12 @@ module Patterns =
                         match att.AttributeType.TryFullName with
                         | Some Atts.erase
                         | Some Atts.stringEnum ->
-                            let kind = getEraseKind tdef (getCaseRule att)
+                            let kind = getEraseKind tdef att
                             Some (ErasedUnion(kind, tdef, typ.GenericArguments))
                         | _ -> None))
                 |> Option.defaultWith (fun () ->
-                    if com.Options.EraseUnions then
-                        let kind = getEraseKind tdef CaseRules.None
-                        ErasedUnion(kind, tdef, typ.GenericArguments)
+                    if com.Options.EraseUnions
+                    then ErasedUnion(EraseKind.AsNamedTuple, tdef, typ.GenericArguments)
                     else DiscriminatedUnion(tdef, typ.GenericArguments))
 
     let (|ContainsAtt|_|) (fullName: string) (ent: FSharpEntity) =

diff --git a/src/Fable.Transforms/FSharp2Fable.fs b/src/Fable.Transforms/FSharp2Fable.fs
@@ -53,14 +53,14 @@ let private transformNewUnion com ctx r fsType (unionCase: FSharpUnionCase) (arg
     match com, fsType, unionCase with
     | ErasedUnion(kind, tdef, _genArgs) ->
         match kind, argExprs with
-        // | EraseKind.AsNamedTuple caseRule, [] -> transformStringEnum caseRule unionCase
-        | EraseKind.AsNamedTuple _, _ ->
-            let caseTag = unionCaseTag tdef unionCase |> makeIntConst
-            let caseName = makeStrConst unionCase.CompiledName
-            caseTag::caseName::argExprs |> Fable.NewTuple |> makeValue r
+        | EraseKind.AsStringEnum caseRule, _ -> transformStringEnum caseRule unionCase
         | EraseKind.AsValue, [arg] -> arg
         | EraseKind.AsValue, _ -> failwith "Shouldn't happen, error?"
         | EraseKind.AsTuple, _ -> Fable.NewTuple argExprs |> makeValue r
+        | EraseKind.AsNamedTuple, _ ->
+            let caseTag = unionCaseTag tdef unionCase |> makeIntConst
+            let caseName = makeStrConst unionCase.CompiledName
+            caseTag::caseName::argExprs |> Fable.NewTuple |> makeValue r
     | OptionUnion typ ->
         let typ = makeType ctx.GenericArgs typ
         let expr =
@@ -230,7 +230,9 @@ let private transformUnionCaseTest (com: IFableCompiler) (ctx: Context) r
     match com, fsType, unionCase with
     | ErasedUnion(kind, tdef, genArgs) ->
         match kind with
-        | EraseKind.AsNamedTuple caseRule ->
+        | EraseKind.AsStringEnum caseRule ->
+            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
             return makeEqOp r tag1 tag2 BinaryEqualStrict
@@ -705,11 +707,9 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) fsExpr =
             match kind with
             | EraseKind.AsValue -> return unionExpr
             | EraseKind.AsTuple -> return getByIndex 0
-            | EraseKind.AsNamedTuple _ ->
-                if unionCase.UnionCaseFields.Count = 0 then
-                    return "StringEnum types cannot have fields" |> addErrorAndReturnNull com ctx.InlinePath r
-                else
-                    return getByIndex 2
+            | EraseKind.AsNamedTuple -> return getByIndex 2
+            | EraseKind.AsStringEnum _ ->
+                return "StringEnum types cannot have fields" |> addErrorAndReturnNull com ctx.InlinePath r
         | OptionUnion t ->
             return Fable.Get(unionExpr, Fable.OptionValue, makeType ctx.GenericArgs t, r)
         | ListUnion t ->

diff --git a/src/Fable.Transforms/Replacements.fs b/src/Fable.Transforms/Replacements.fs
@@ -702,28 +702,30 @@ let getEntityHashMethod (com: ICompiler) (ent: Entity) =
     if (ent.IsFSharpUnion || ent.IsFSharpRecord) then
         if com.Options.EraseUnions
         then "Util", "structuralHash"
-        else "Util", "hashSafe"
+        else "Util", "safeHash"
     elif ent.IsValueType
-    then "Util", "hashSafe"
+    then "Util", "safeHash"
     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"
+    // if (ent.IsFSharpUnion || ent.IsFSharpRecord) then
+    //     if com.Options.EraseUnions
+    //     then "Util", "equals"
+    //     else "Util", "equals"
+    // elif ent.IsValueType
+    // then "Util", "equals"
+    // else "Util", "equals"
+    "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"
+    // if (ent.IsFSharpUnion || ent.IsFSharpRecord) then
+    //     if com.Options.EraseUnions
+    //     then "Util", "compare"
+    //     else "Util", "compare"
+    // elif ent.IsValueType
+    // then "Util", "compare"
+    // else "Util", "compare"
+    "Util", "compare"
 
 let identityHashMethod (com: ICompiler) = function
     | Boolean | Char | String | Number _ | Enum _ | Option _ | Tuple _ | List _

diff --git a/src/fable-standalone/test/bench-compiler/package.json b/src/fable-standalone/test/bench-compiler/package.json
@@ -44,12 +44,12 @@
     "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",
-    "tests": "npm run mocha -- out-tests -r esm --colors",
+    "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 --eraseUnions",
+    "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 -- --eraseUnions",
+    "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",