Skip to content

Commit 52922f1

Browse files
ncavencave
committed
Added support for erased records
1 parent 2f55c5a commit 52922f1

File tree

12 files changed

+102
-31
lines changed

12 files changed

+102
-31
lines changed

‎.vscode/launch.json‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -65,8 +65,8 @@
6565
"name": "Run bench-compiler (.NET)",
6666
"program": "${workspaceFolder}/src/fable-standalone/test/bench-compiler/bin/Debug/netcoreapp3.1/bench-compiler.dll",
6767
// "args": ["${workspaceRoot}/tests/Main/Fable.Tests.fsproj", "out-tests"],
68-
// "args": ["${workspaceRoot}/../fable-test/fable-test.fsproj", "out-test", "--typescript"],
69-
"args": ["${workspaceRoot}/src/fable-library/Fable.Library.fsproj", "out-lib", "--typescript"],
68+
"args": ["${workspaceRoot}/../fable-test/fable-test.fsproj", "out-test", "--typescript"],
69+
// "args": ["${workspaceRoot}/src/fable-library/Fable.Library.fsproj", "out-lib", "--typescript"],
7070
"cwd": "${workspaceFolder}/src/fable-standalone/test/bench-compiler"
7171
},
7272
{

‎src/Fable.AST/Fable.fs‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -266,6 +266,7 @@ type KeyKind =
266266
type GetKind =
267267
| ByKey of KeyKind
268268
| TupleIndex of int
269+
| FieldIndex of string * int
269270
| UnionField of index: int * fieldType: Type
270271
| UnionTag
271272
| ListHead

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

Lines changed: 5 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -433,6 +433,10 @@ module Helpers =
433433
let makeRangeFrom (fsExpr: FSharpExpr) =
434434
Some (makeRange fsExpr.Range)
435435

436+
let isErasedRecord (com: Compiler) (t: FSharpType) =
437+
// TODO: check for custom equality or comparison
438+
com.Options.EraseUnions && t.HasTypeDefinition && t.TypeDefinition.IsFSharpRecord
439+
436440
let unionCaseTag (ent: FSharpEntity) (unionCase: FSharpUnionCase) =
437441
try
438442
ent.UnionCases |> Seq.findIndex (fun uci -> unionCase.Name = uci.Name)
@@ -697,8 +701,7 @@ module Patterns =
697701
match tryDefinition typ with
698702
| None -> failwith "Union without definition"
699703
| Some(tdef, fullName) ->
700-
let fullName = defaultArg fullName tdef.CompiledName
701-
match fullName with
704+
match defaultArg fullName tdef.CompiledName with
702705
| Types.valueOption
703706
| Types.option -> OptionUnion typ.GenericArguments.[0]
704707
| Types.list -> ListUnion typ.GenericArguments.[0]

‎src/Fable.Transforms/FSharp2Fable.fs‎

Lines changed: 28 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -646,21 +646,30 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) fsExpr =
646646

647647
// Getters and Setters
648648
| BasicPatterns.AnonRecordGet(callee, calleeType, fieldIndex) ->
649+
let r = makeRangeFrom fsExpr
649650
let! callee = transformExpr com ctx callee
650-
let fieldName = calleeType.AnonRecordTypeDetails.SortedFieldNames.[fieldIndex]
651651
let typ = makeType ctx.GenericArgs fsExpr.Type
652-
let key = FsField(fieldName, lazy typ) :> Fable.Field |> Fable.FieldKey
653-
return Fable.Get(callee, Fable.ByKey key, typ, makeRangeFrom fsExpr)
652+
let fieldName = calleeType.AnonRecordTypeDetails.SortedFieldNames.[fieldIndex]
653+
if isErasedRecord com calleeType then
654+
return Fable.Get(callee, Fable.FieldIndex(fieldName, fieldIndex), typ, r)
655+
else
656+
let key = FsField(fieldName, lazy typ) :> Fable.Field |> Fable.FieldKey
657+
return Fable.Get(callee, Fable.ByKey key, typ, r)
654658

655659
| BasicPatterns.FSharpFieldGet(callee, calleeType, field) ->
660+
let r = makeRangeFrom fsExpr
656661
let! callee = transformExprOpt com ctx callee
657662
let callee =
658663
match callee with
659664
| Some callee -> callee
660665
| None -> entityRef com (FsEnt calleeType.TypeDefinition)
661-
let key = FsField field :> Fable.Field |> Fable.FieldKey
662666
let typ = makeType ctx.GenericArgs fsExpr.Type
663-
return Fable.Get(callee, Fable.ByKey key, typ, makeRangeFrom fsExpr)
667+
if isErasedRecord com calleeType then
668+
let index = calleeType.TypeDefinition.FSharpFields |> Seq.findIndex (fun x -> x.Name = field.Name)
669+
return Fable.Get(callee, Fable.FieldIndex(field.Name, index + 1), typ, r)
670+
else
671+
let key = FsField field :> Fable.Field |> Fable.FieldKey
672+
return Fable.Get(callee, Fable.ByKey key, typ, r)
664673

665674
| BasicPatterns.TupleGet(_tupleType, tupleElemIndex, tupleExpr) ->
666675
let! tupleExpr = transformExpr com ctx tupleExpr
@@ -778,15 +787,24 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) fsExpr =
778787
return Fable.Sequential exprs
779788

780789
| BasicPatterns.NewRecord(fsType, argExprs) ->
790+
let r = makeRangeFrom fsExpr
781791
let! argExprs = transformExprList com ctx argExprs
782-
let genArgs = makeGenArgs ctx.GenericArgs (getGenericArguments fsType)
783-
return Fable.NewRecord(argExprs, FsEnt.Ref fsType.TypeDefinition, genArgs) |> makeValue (makeRangeFrom fsExpr)
792+
if isErasedRecord com fsType then
793+
let recordName = (makeStrConst (getFsTypeFullName fsType))
794+
return recordName::argExprs |> Fable.NewTuple |> makeValue r
795+
else
796+
let genArgs = makeGenArgs ctx.GenericArgs (getGenericArguments fsType)
797+
return Fable.NewRecord(argExprs, FsEnt.Ref fsType.TypeDefinition, genArgs) |> makeValue r
784798

785799
| BasicPatterns.NewAnonRecord(fsType, argExprs) ->
800+
let r = makeRangeFrom fsExpr
786801
let! argExprs = transformExprList com ctx argExprs
787-
let fieldNames = fsType.AnonRecordTypeDetails.SortedFieldNames
788-
let genArgs = makeGenArgs ctx.GenericArgs (getGenericArguments fsType)
789-
return Fable.NewAnonymousRecord(argExprs, fieldNames, genArgs) |> makeValue (makeRangeFrom fsExpr)
802+
if isErasedRecord com fsType then
803+
return argExprs |> Fable.NewTuple |> makeValue r
804+
else
805+
let fieldNames = fsType.AnonRecordTypeDetails.SortedFieldNames
806+
let genArgs = makeGenArgs ctx.GenericArgs (getGenericArguments fsType)
807+
return Fable.NewAnonymousRecord(argExprs, fieldNames, genArgs) |> makeValue r
790808

791809
| BasicPatterns.NewUnionCase(fsType, unionCase, argExprs) ->
792810
let! argExprs = transformExprList com ctx argExprs

‎src/Fable.Transforms/Fable2Babel.fs‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1208,6 +1208,7 @@ module Util =
12081208
| Fable.ListTail ->
12091209
get range (com.TransformAsExpr(ctx, fableExpr)) "tail"
12101210

1211+
| Fable.FieldIndex (_, index)
12111212
| Fable.TupleIndex index ->
12121213
match fableExpr with
12131214
// TODO: Check the erased expressions don't have side effects?

‎src/Fable.Transforms/FableTransforms.fs‎

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -59,8 +59,8 @@ let visit f e =
5959
Operation(Logical(op, f left, f right), t, r)
6060
| Get(e, kind, t, r) ->
6161
match kind with
62-
| ListHead | ListTail | OptionValue | TupleIndex _ | UnionTag
63-
| UnionField _ | ByKey(FieldKey _) -> Get(f e, kind, t, r)
62+
| ListHead | ListTail | OptionValue | TupleIndex _ | FieldIndex _
63+
| UnionTag | UnionField _ | ByKey(FieldKey _) -> Get(f e, kind, t, r)
6464
| ByKey(ExprKey e2) -> Get(f e, ByKey(ExprKey(f e2)), t, r)
6565
| Sequential exprs -> Sequential(List.map f exprs)
6666
| Let(ident, value, body) -> Let(ident, f value, f body)
@@ -131,8 +131,8 @@ let getSubExpressions = function
131131
| Logical(_, left, right) -> [left; right]
132132
| Get(e, kind, _, _) ->
133133
match kind with
134-
| ListHead | ListTail | OptionValue | TupleIndex _ | UnionTag
135-
| UnionField _ | ByKey(FieldKey _) -> [e]
134+
| ListHead | ListTail | OptionValue | TupleIndex _ | FieldIndex _
135+
| UnionTag | UnionField _ | ByKey(FieldKey _) -> [e]
136136
| ByKey(ExprKey e2) -> [e; e2]
137137
| Sequential exprs -> exprs
138138
| Let(_, value, body) -> [value; body]

‎src/Fable.Transforms/Replacements.fs‎

Lines changed: 49 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -217,6 +217,7 @@ let (|Nameof|_|) com ctx = function
217217
| IdentExpr ident -> Some ident.DisplayName
218218
| Get(_, ByKey(ExprKey(StringConst prop)), _, _) -> Some prop
219219
| Get(_, ByKey(FieldKey fi), _, _) -> Some fi.Name
220+
| Get(_, FieldIndex(fieldName, _), _, _) -> Some fieldName
220221
| NestedLambda(args, Call(IdentExpr ident, info, _, _), None) ->
221222
if List.sameLength args info.Args && List.zip args info.Args |> List.forall (fun (a1, a2) ->
222223
match a2 with IdentExpr id2 -> a1.Name = id2.Name | _ -> false)
@@ -695,6 +696,50 @@ let isCompatibleWithJsComparison = function
695696
// * `.GetHashCode` called directly defaults to identity hash (for reference types except string) if not implemented.
696697
// * `LanguagePrimitive.PhysicalHash` creates an identity hash no matter whether GetHashCode is implemented or not.
697698

699+
let getEntityHashMethod (com: ICompiler) (ent: Entity) =
700+
if (ent.IsFSharpUnion || ent.IsFSharpRecord) then
701+
if com.Options.EraseUnions
702+
then "Util", "structuralHash"
703+
else "Util", "hashSafe"
704+
elif ent.IsValueType
705+
then "Util", "hashSafe"
706+
else "Util", "identityHash"
707+
708+
let getEntityEqualsMethod (com: ICompiler) (ent: Entity) =
709+
if (ent.IsFSharpUnion || ent.IsFSharpRecord) then
710+
if com.Options.EraseUnions
711+
then "Util", "equals"
712+
else "Util", "equalsSafe"
713+
elif ent.IsValueType
714+
then "Util", "equalsSafe"
715+
else "Util", "equals"
716+
717+
let getEntityCompareMethod (com: ICompiler) (ent: Entity) =
718+
if (ent.IsFSharpUnion || ent.IsFSharpRecord) then
719+
if com.Options.EraseUnions
720+
then "Util", "compare"
721+
else "Util", "compareSafe"
722+
elif ent.IsValueType
723+
then "Util", "compareSafe"
724+
else "Util", "compare"
725+
726+
let identityHashMethod (com: ICompiler) = function
727+
| Boolean | Char | String | Number _ | Enum _ | Option _ | Tuple _ | List _
728+
| Builtin (BclInt64 | BclUInt64 | BclDecimal | BclBigInt)
729+
| Builtin (BclGuid | BclTimeSpan | BclDateTime | BclDateTimeOffset)
730+
| Builtin (FSharpSet _ | FSharpMap _ | FSharpChoice _ | FSharpResult _) ->
731+
"Util", "structuralHash"
732+
| DeclaredType(ent, _) -> com.GetEntity(ent) |> getEntityHashMethod com
733+
| _ -> "Util", "identityHash"
734+
735+
let structuralHashMethod (com: ICompiler) = function
736+
| MetaType -> "Reflection", "getHashCode"
737+
| DeclaredType(ent, _) ->
738+
let ent = com.GetEntity(ent)
739+
if not ent.IsInterface then getEntityHashMethod com ent
740+
else "Util", "structuralHash"
741+
| _ -> "Util", "structuralHash"
742+
698743
let identityHash com r (arg: Expr) =
699744
let methodName =
700745
match arg.Type with
@@ -747,10 +792,8 @@ let rec equals (com: ICompiler) ctx r equal (left: Expr) (right: Expr) =
747792
Helper.LibCall(com, coreModFor bt, "equals", Boolean, [left; right], ?loc=r) |> is equal
748793
| DeclaredType(ent, _) ->
749794
let ent = com.GetEntity(ent)
750-
if ent.IsFSharpUnion || ent.IsFSharpRecord || ent.IsValueType then
751-
Helper.LibCall(com, "Util", "equalsSafe", Boolean, [left; right], ?loc=r) |> is equal
752-
else
753-
Helper.LibCall(com, "Util", "equals", Boolean, [left; right], ?loc=r) |> is equal
795+
let moduleName, methodName = getEntityEqualsMethod com ent
796+
Helper.LibCall(com, moduleName, methodName, Boolean, [left; right], ?loc=r) |> is equal
754797
| Array t ->
755798
let f = makeComparerFunction com ctx t
756799
Helper.LibCall(com, "Array", "equalsWith", Boolean, [f; left; right], ?loc=r) |> is equal
@@ -775,10 +818,8 @@ and compare (com: ICompiler) ctx r (left: Expr) (right: Expr) =
775818
Helper.LibCall(com, coreModFor bt, "compare", Number Int32, [left; right], ?loc=r)
776819
| DeclaredType(ent, _) ->
777820
let ent = com.GetEntity(ent)
778-
if ent.IsFSharpUnion || ent.IsFSharpRecord || ent.IsValueType then
779-
Helper.LibCall(com, "Util", "compareSafe", Number Int32, [left; right], ?loc=r)
780-
else
781-
Helper.LibCall(com, "Util", "compare", Number Int32, [left; right], ?loc=r)
821+
let moduleName, methodName = getEntityCompareMethod com ent
822+
Helper.LibCall(com, moduleName, methodName, Number Int32, [left; right], ?loc=r)
782823
| Array t ->
783824
let f = makeComparerFunction com ctx t
784825
Helper.LibCall(com, "Array", "compareWith", Number Int32, [f; left; right], ?loc=r)

‎src/fable-standalone/src/Interfaces.fs‎

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -64,7 +64,9 @@ type IFableManager =
6464
abstract GetToolTipText: parseResults: IParseResults * line: int * col: int * lineText: string -> string[]
6565
abstract GetCompletionsAtLocation: parseResults: IParseResults * line: int * col: int * lineText: string -> Completion[]
6666
abstract CompileToBabelAst: fableLibrary: string * parseResults: IParseResults * fileName: string
67+
* ?eraseUnions: bool
6768
* ?typedArrays: bool
68-
* ?typescript: bool -> IBabelResult
69+
* ?typescript: bool
70+
-> IBabelResult
6971
abstract PrintBabelAst: babelResult: IBabelResult * IWriter -> Async<unit>
7072
abstract FSharpAstToString: parseResults: IParseResults * fileName: string -> string

‎src/fable-standalone/src/Main.fs‎

Lines changed: 4 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -258,14 +258,16 @@ let init () =
258258
getCompletionsAtLocation res line col lineText
259259

260260
member __.CompileToBabelAst(fableLibrary:string, parseResults:IParseResults, fileName:string,
261-
?typedArrays, ?typescript) =
261+
?eraseUnions, ?typedArrays, ?typescript) =
262262
let res = parseResults :?> ParseResults
263263
let project = res.GetProject()
264264
let define = parseResults.OtherFSharpOptions |> Array.choose (fun x ->
265265
if x.StartsWith("--define:") || x.StartsWith("-d:")
266266
then x.[(x.IndexOf(':') + 1)..] |> Some
267267
else None) |> Array.toList
268-
let options = Fable.CompilerOptionsHelper.Make(define=define, ?typedArrays=typedArrays, ?typescript=typescript)
268+
let options =
269+
Fable.CompilerOptionsHelper.Make(define=define,
270+
?eraseUnions=eraseUnions, ?typedArrays=typedArrays, ?typescript=typescript)
269271
let com = CompilerImpl(fileName, project, options, fableLibrary)
270272
let ast =
271273
FSharp2Fable.Compiler.transformFile com

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

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -6,6 +6,7 @@ type CmdLineOptions = {
66
benchmark: bool
77
optimize: bool
88
// sourceMaps: bool
9+
eraseUnions: bool
910
typedArrays: bool
1011
typescript: bool
1112
printAst: bool

0 commit comments

Comments
 (0)