From 611657c72a6aa08d599715cc9fb581280410c757 Mon Sep 17 00:00:00 2001 From: ncave <777696+ncave@users.noreply.github.com> Date: Mon, 21 Dec 2020 16:29:48 -0800 Subject: [PATCH] Separate StringEnum handling --- src/Fable.Transforms/FSharp2Fable.Util.fs | 23 +++++++------ src/Fable.Transforms/FSharp2Fable.fs | 22 ++++++------ src/Fable.Transforms/Replacements.fs | 34 ++++++++++--------- .../test/bench-compiler/package.json | 6 ++-- 4 files changed, 44 insertions(+), 41 deletions(-) diff --git a/src/Fable.Transforms/FSharp2Fable.Util.fs b/src/Fable.Transforms/FSharp2Fable.Util.fs index 5de895f11..d0e8285c4 100644 --- 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(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 index 16e017df6..a09e3979e 100644 --- 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 index b21de8580..ebee9b30d 100644 --- 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 index d5a5ba3c3..d1ee86137 100644 --- 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",