Skip to content

Commit 192f618

Browse files
ncavencave
committed
Separate StringEnum handling
1 parent 18ca13e commit 192f618

File tree

4 files changed

+44
-41
lines changed

4 files changed

+44
-41
lines changed

‎src/Fable.Transforms/FSharp2Fable.Util.fs‎

Lines changed: 12 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -686,7 +686,8 @@ module Patterns =
686686
type EraseKind =
687687
| AsValue
688688
| AsTuple
689-
| AsNamedTuple of CaseRules
689+
| AsNamedTuple
690+
| AsStringEnum of CaseRules
690691

691692
let (|OptionUnion|ListUnion|ErasedUnion|DiscriminatedUnion|)
692693
(com: Compiler, NonAbbreviatedType typ: FSharpType, unionCase: FSharpUnionCase) =
@@ -696,18 +697,19 @@ module Patterns =
696697
| Some(_, (:? int as rule)) -> enum<CaseRules>(rule)
697698
| _ -> CaseRules.LowerFirst
698699

699-
let getEraseKind (tdef: FSharpEntity) caseRule =
700-
if tdef.UnionCases.Count = 1 && tdef.UnionCases.[0].UnionCaseFields.Count = 1
701-
then EraseKind.AsValue
702-
else EraseKind.AsNamedTuple(caseRule)
700+
let getEraseKind (tdef: FSharpEntity) (att: FSharpAttribute) =
701+
match unionCase.UnionCaseFields.Count with
702+
| 0 -> EraseKind.AsStringEnum(getCaseRule att)
703+
| 1 -> EraseKind.AsValue
704+
| _ -> EraseKind.AsTuple
703705

704706
match tryDefinition typ with
705707
| None -> failwith "Union without definition"
706708
| Some(tdef, fullName) ->
707709
match defaultArg fullName tdef.CompiledName with
708710
| Types.valueOption
709-
| Types.option -> OptionUnion typ.GenericArguments.[0]
710-
| Types.list -> ListUnion typ.GenericArguments.[0]
711+
| Types.option -> OptionUnion(typ.GenericArguments.[0])
712+
| Types.list -> ListUnion(typ.GenericArguments.[0])
711713
| _ ->
712714
unionCase.Attributes |> Seq.tryPick (fun att ->
713715
match att.AttributeType.TryFullName with
@@ -719,13 +721,12 @@ module Patterns =
719721
match att.AttributeType.TryFullName with
720722
| Some Atts.erase
721723
| Some Atts.stringEnum ->
722-
let kind = getEraseKind tdef (getCaseRule att)
724+
let kind = getEraseKind tdef att
723725
Some (ErasedUnion(kind, tdef, typ.GenericArguments))
724726
| _ -> None))
725727
|> Option.defaultWith (fun () ->
726-
if com.Options.EraseUnions then
727-
let kind = getEraseKind tdef CaseRules.None
728-
ErasedUnion(kind, tdef, typ.GenericArguments)
728+
if com.Options.EraseUnions
729+
then ErasedUnion(EraseKind.AsNamedTuple, tdef, typ.GenericArguments)
729730
else DiscriminatedUnion(tdef, typ.GenericArguments))
730731

731732
let (|ContainsAtt|_|) (fullName: string) (ent: FSharpEntity) =

‎src/Fable.Transforms/FSharp2Fable.fs‎

Lines changed: 11 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -53,14 +53,14 @@ let private transformNewUnion com ctx r fsType (unionCase: FSharpUnionCase) (arg
5353
match com, fsType, unionCase with
5454
| ErasedUnion(kind, tdef, _genArgs) ->
5555
match kind, argExprs with
56-
// | EraseKind.AsNamedTuple caseRule, [] -> transformStringEnum caseRule unionCase
57-
| EraseKind.AsNamedTuple _, _ ->
58-
let caseTag = unionCaseTag tdef unionCase |> makeIntConst
59-
let caseName = makeStrConst unionCase.CompiledName
60-
caseTag::caseName::argExprs |> Fable.NewTuple |> makeValue r
56+
| EraseKind.AsStringEnum caseRule, _ -> transformStringEnum caseRule unionCase
6157
| EraseKind.AsValue, [arg] -> arg
6258
| EraseKind.AsValue, _ -> failwith "Shouldn't happen, error?"
6359
| EraseKind.AsTuple, _ -> Fable.NewTuple argExprs |> makeValue r
60+
| EraseKind.AsNamedTuple, _ ->
61+
let caseTag = unionCaseTag tdef unionCase |> makeIntConst
62+
let caseName = makeStrConst unionCase.CompiledName
63+
caseTag::caseName::argExprs |> Fable.NewTuple |> makeValue r
6464
| OptionUnion typ ->
6565
let typ = makeType ctx.GenericArgs typ
6666
let expr =
@@ -230,7 +230,9 @@ let private transformUnionCaseTest (com: IFableCompiler) (ctx: Context) r
230230
match com, fsType, unionCase with
231231
| ErasedUnion(kind, tdef, genArgs) ->
232232
match kind with
233-
| EraseKind.AsNamedTuple caseRule ->
233+
| EraseKind.AsStringEnum caseRule ->
234+
return makeEqOp r unionExpr (transformStringEnum caseRule unionCase) BinaryEqualStrict
235+
| EraseKind.AsNamedTuple ->
234236
let tag1 = Fable.Get(unionExpr, Fable.TupleIndex(0), Fable.Number Int32, None)
235237
let tag2 = unionCaseTag tdef unionCase |> makeIntConst
236238
return makeEqOp r tag1 tag2 BinaryEqualStrict
@@ -705,11 +707,9 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) fsExpr =
705707
match kind with
706708
| EraseKind.AsValue -> return unionExpr
707709
| EraseKind.AsTuple -> return getByIndex 0
708-
| EraseKind.AsNamedTuple _ ->
709-
if unionCase.UnionCaseFields.Count = 0 then
710-
return "StringEnum types cannot have fields" |> addErrorAndReturnNull com ctx.InlinePath r
711-
else
712-
return getByIndex 2
710+
| EraseKind.AsNamedTuple -> return getByIndex 2
711+
| EraseKind.AsStringEnum _ ->
712+
return "StringEnum types cannot have fields" |> addErrorAndReturnNull com ctx.InlinePath r
713713
| OptionUnion t ->
714714
return Fable.Get(unionExpr, Fable.OptionValue, makeType ctx.GenericArgs t, r)
715715
| ListUnion t ->

‎src/Fable.Transforms/Replacements.fs‎

Lines changed: 18 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -702,28 +702,30 @@ let getEntityHashMethod (com: ICompiler) (ent: Entity) =
702702
if (ent.IsFSharpUnion || ent.IsFSharpRecord) then
703703
if com.Options.EraseUnions
704704
then "Util", "structuralHash"
705-
else "Util", "hashSafe"
705+
else "Util", "safeHash"
706706
elif ent.IsValueType
707-
then "Util", "hashSafe"
707+
then "Util", "safeHash"
708708
else "Util", "identityHash"
709709

710710
let getEntityEqualsMethod (com: ICompiler) (ent: Entity) =
711-
if (ent.IsFSharpUnion || ent.IsFSharpRecord) then
712-
if com.Options.EraseUnions
713-
then "Util", "equals"
714-
else "Util", "equalsSafe"
715-
elif ent.IsValueType
716-
then "Util", "equalsSafe"
717-
else "Util", "equals"
711+
// if (ent.IsFSharpUnion || ent.IsFSharpRecord) then
712+
// if com.Options.EraseUnions
713+
// then "Util", "equals"
714+
// else "Util", "equals"
715+
// elif ent.IsValueType
716+
// then "Util", "equals"
717+
// else "Util", "equals"
718+
"Util", "equals"
718719

719720
let getEntityCompareMethod (com: ICompiler) (ent: Entity) =
720-
if (ent.IsFSharpUnion || ent.IsFSharpRecord) then
721-
if com.Options.EraseUnions
722-
then "Util", "compare"
723-
else "Util", "compareSafe"
724-
elif ent.IsValueType
725-
then "Util", "compareSafe"
726-
else "Util", "compare"
721+
// if (ent.IsFSharpUnion || ent.IsFSharpRecord) then
722+
// if com.Options.EraseUnions
723+
// then "Util", "compare"
724+
// else "Util", "compare"
725+
// elif ent.IsValueType
726+
// then "Util", "compare"
727+
// else "Util", "compare"
728+
"Util", "compare"
727729

728730
let identityHashMethod (com: ICompiler) = function
729731
| Boolean | Char | String | Number _ | Enum _ | Option _ | Tuple _ | List _

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

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -44,12 +44,12 @@
4444
"build-tests-dotnet-ts": "dotnet run -c Release ../../../../tests/Main/Fable.Tests.fsproj out-tests --typescript",
4545
"build-tests-dotnet-opt": "dotnet run -c Release ../../../../tests/Main/Fable.Tests.fsproj out-tests --optimize",
4646
"build-tests-node": "node out-node/app.js ../../../../tests/Main/Fable.Tests.fsproj out-tests",
47-
"tests": "npm run mocha -- out-tests -r esm --colors",
47+
"tests": "npm run mocha -- out-tests -r esm --colors --reporter dot",
4848

49-
"prebuild-fable-library": "dotnet run -c Release ../../../fable-library/Fable.Library.fsproj ./out-lib --eraseUnions",
49+
"prebuild-fable-library": "dotnet run -c Release ../../../fable-library/Fable.Library.fsproj out-lib --fableLib out-lib --eraseUnions",
5050
"build-fable-library": "npm run tsc -- -p ../../../fable-library --outDir ./out-lib",
5151
"prebuild-tests": "git clean -fdx && npm run build-fable-library",
52-
"build-tests": "npm run build-tests-dotnet -- --eraseUnions",
52+
"build-tests": "npm run build-tests-dotnet -- --fableLib out-lib --eraseUnions",
5353

5454
"tsc": "node ../../../../node_modules/typescript/bin/tsc",
5555
"babel": "node ../../../../node_modules/@babel/cli/bin/babel",

0 commit comments

Comments
 (0)