Skip to content

Commit 3c510f3

Browse files
ncavencave
committed
Added support for erased records
1 parent 2c9614b commit 3c510f3

File tree

12 files changed

+85
-35
lines changed

12 files changed

+85
-35
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
@@ -262,6 +262,7 @@ type KeyKind =
262262
type GetKind =
263263
| ByKey of KeyKind
264264
| TupleIndex of int
265+
| FieldIndex of string * int
265266
| UnionField of index: int * fieldType: Type
266267
| UnionTag
267268
| ListHead

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

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

444+
let isErasedRecord (com: Compiler) (t: FSharpType) =
445+
// TODO: check for custom equality or comparison
446+
com.Options.EraseUnions && t.HasTypeDefinition && t.TypeDefinition.IsFSharpRecord
447+
444448
let unionCaseTag (ent: FSharpEntity) (unionCase: FSharpUnionCase) =
445449
try
446450
ent.UnionCases |> Seq.findIndex (fun uci -> unionCase.Name = uci.Name)
@@ -705,8 +709,7 @@ module Patterns =
705709
match tryDefinition typ with
706710
| None -> failwith "Union without definition"
707711
| Some(tdef, fullName) ->
708-
let fullName = defaultArg fullName tdef.CompiledName
709-
match fullName with
712+
match defaultArg fullName tdef.CompiledName with
710713
| Types.valueOption
711714
| Types.option -> OptionUnion typ.GenericArguments.[0]
712715
| 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
@@ -640,21 +640,30 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) fsExpr =
640640

641641
// Getters and Setters
642642
| BasicPatterns.AnonRecordGet(callee, calleeType, fieldIndex) ->
643+
let r = makeRangeFrom fsExpr
643644
let! callee = transformExpr com ctx callee
644-
let fieldName = calleeType.AnonRecordTypeDetails.SortedFieldNames.[fieldIndex]
645645
let typ = makeType ctx.GenericArgs fsExpr.Type
646-
let key = FsField(fieldName, lazy typ) :> Fable.Field |> Fable.FieldKey
647-
return Fable.Get(callee, Fable.ByKey key, typ, makeRangeFrom fsExpr)
646+
let fieldName = calleeType.AnonRecordTypeDetails.SortedFieldNames.[fieldIndex]
647+
if isErasedRecord com calleeType then
648+
return Fable.Get(callee, Fable.FieldIndex(fieldName, fieldIndex), typ, r)
649+
else
650+
let key = FsField(fieldName, lazy typ) :> Fable.Field |> Fable.FieldKey
651+
return Fable.Get(callee, Fable.ByKey key, typ, r)
648652

649653
| BasicPatterns.FSharpFieldGet(callee, calleeType, field) ->
654+
let r = makeRangeFrom fsExpr
650655
let! callee = transformExprOpt com ctx callee
651656
let callee =
652657
match callee with
653658
| Some callee -> callee
654659
| None -> entityRef com (FsEnt calleeType.TypeDefinition)
655-
let key = FsField field :> Fable.Field |> Fable.FieldKey
656660
let typ = makeType ctx.GenericArgs fsExpr.Type
657-
return Fable.Get(callee, Fable.ByKey key, typ, makeRangeFrom fsExpr)
661+
if isErasedRecord com calleeType then
662+
let index = calleeType.TypeDefinition.FSharpFields |> Seq.findIndex (fun x -> x.Name = field.Name)
663+
return Fable.Get(callee, Fable.FieldIndex(field.Name, index + 1), typ, r)
664+
else
665+
let key = FsField field :> Fable.Field |> Fable.FieldKey
666+
return Fable.Get(callee, Fable.ByKey key, typ, r)
658667

659668
| BasicPatterns.TupleGet(_tupleType, tupleElemIndex, tupleExpr) ->
660669
let! tupleExpr = transformExpr com ctx tupleExpr
@@ -772,15 +781,24 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) fsExpr =
772781
return Fable.Sequential exprs
773782

774783
| BasicPatterns.NewRecord(fsType, argExprs) ->
784+
let r = makeRangeFrom fsExpr
775785
let! argExprs = transformExprList com ctx argExprs
776-
let genArgs = makeGenArgs ctx.GenericArgs (getGenericArguments fsType)
777-
return Fable.NewRecord(argExprs, FsEnt.Ref fsType.TypeDefinition, genArgs) |> makeValue (makeRangeFrom fsExpr)
786+
if isErasedRecord com fsType then
787+
let recordName = (makeStrConst (getFsTypeFullName fsType))
788+
return recordName::argExprs |> Fable.NewTuple |> makeValue r
789+
else
790+
let genArgs = makeGenArgs ctx.GenericArgs (getGenericArguments fsType)
791+
return Fable.NewRecord(argExprs, FsEnt.Ref fsType.TypeDefinition, genArgs) |> makeValue r
778792

779793
| BasicPatterns.NewAnonRecord(fsType, argExprs) ->
794+
let r = makeRangeFrom fsExpr
780795
let! argExprs = transformExprList com ctx argExprs
781-
let fieldNames = fsType.AnonRecordTypeDetails.SortedFieldNames
782-
let genArgs = makeGenArgs ctx.GenericArgs (getGenericArguments fsType)
783-
return Fable.NewAnonymousRecord(argExprs, fieldNames, genArgs) |> makeValue (makeRangeFrom fsExpr)
796+
if isErasedRecord com fsType then
797+
return argExprs |> Fable.NewTuple |> makeValue r
798+
else
799+
let fieldNames = fsType.AnonRecordTypeDetails.SortedFieldNames
800+
let genArgs = makeGenArgs ctx.GenericArgs (getGenericArguments fsType)
801+
return Fable.NewAnonymousRecord(argExprs, fieldNames, genArgs) |> makeValue r
784802

785803
| BasicPatterns.NewUnionCase(fsType, unionCase, argExprs) ->
786804
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
@@ -1194,6 +1194,7 @@ module Util =
11941194
| Fable.ListTail ->
11951195
get range (com.TransformAsExpr(ctx, fableExpr)) "tail"
11961196

1197+
| Fable.FieldIndex (_, index)
11971198
| Fable.TupleIndex index ->
11981199
match fableExpr with
11991200
// 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(bs, body) ->
@@ -130,8 +130,8 @@ let getSubExpressions = function
130130
| Logical(_, left, right) -> [left; right]
131131
| Get(e, kind, _, _) ->
132132
match kind with
133-
| ListHead | ListTail | OptionValue | TupleIndex _ | UnionTag
134-
| UnionField _ | ByKey(FieldKey _) -> [e]
133+
| ListHead | ListTail | OptionValue | TupleIndex _ | FieldIndex _
134+
| UnionTag | UnionField _ | ByKey(FieldKey _) -> [e]
135135
| ByKey(ExprKey e2) -> [e; e2]
136136
| Sequential exprs -> exprs
137137
| Let(bs, body) -> (List.map snd bs) @ [body]

‎src/Fable.Transforms/Replacements.fs‎

Lines changed: 32 additions & 12 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)
@@ -696,24 +697,47 @@ let isCompatibleWithJsComparison = function
696697
// * `.GetHashCode` called directly defaults to identity hash (for reference types except string) if not implemented.
697698
// * `LanguagePrimitive.PhysicalHash` creates an identity hash no matter whether GetHashCode is implemented or not.
698699

699-
let getEntityHashMethod (ent: Entity) =
700-
if ent.IsFSharpUnion || ent.IsFSharpRecord || ent.IsValueType then "Util", "hashSafe"
700+
let getEntityHashMethod (com: ICompiler) (ent: Entity) =
701+
if (ent.IsFSharpUnion || ent.IsFSharpRecord) then
702+
if com.Options.EraseUnions
703+
then "Util", "structuralHash"
704+
else "Util", "hashSafe"
705+
elif ent.IsValueType
706+
then "Util", "hashSafe"
701707
else "Util", "identityHash"
702708

709+
let getEntityEqualsMethod (com: ICompiler) (ent: Entity) =
710+
if (ent.IsFSharpUnion || ent.IsFSharpRecord) then
711+
if com.Options.EraseUnions
712+
then "Util", "equals"
713+
else "Util", "equalsSafe"
714+
elif ent.IsValueType
715+
then "Util", "equalsSafe"
716+
else "Util", "equals"
717+
718+
let getEntityCompareMethod (com: ICompiler) (ent: Entity) =
719+
if (ent.IsFSharpUnion || ent.IsFSharpRecord) then
720+
if com.Options.EraseUnions
721+
then "Util", "compare"
722+
else "Util", "compareSafe"
723+
elif ent.IsValueType
724+
then "Util", "compareSafe"
725+
else "Util", "compare"
726+
703727
let identityHashMethod (com: ICompiler) = function
704728
| Boolean | Char | String | Number _ | Enum _ | Option _ | Tuple _ | List _
705729
| Builtin (BclInt64 | BclUInt64 | BclDecimal | BclBigInt)
706730
| Builtin (BclGuid | BclTimeSpan | BclDateTime | BclDateTimeOffset)
707731
| Builtin (FSharpSet _ | FSharpMap _ | FSharpChoice _ | FSharpResult _) ->
708732
"Util", "structuralHash"
709-
| DeclaredType(ent, _) -> com.GetEntity(ent) |> getEntityHashMethod
733+
| DeclaredType(ent, _) -> com.GetEntity(ent) |> getEntityHashMethod com
710734
| _ -> "Util", "identityHash"
711735

712736
let structuralHashMethod (com: ICompiler) = function
713737
| MetaType -> "Reflection", "getHashCode"
714738
| DeclaredType(ent, _) ->
715739
let ent = com.GetEntity(ent)
716-
if not ent.IsInterface then getEntityHashMethod ent
740+
if not ent.IsInterface then getEntityHashMethod com ent
717741
else "Util", "structuralHash"
718742
| _ -> "Util", "structuralHash"
719743

@@ -742,10 +766,8 @@ let rec equals (com: ICompiler) ctx r equal (left: Expr) (right: Expr) =
742766
Helper.LibCall(com, coreModFor bt, "equals", Boolean, [left; right], ?loc=r) |> is equal
743767
| DeclaredType(ent, _) ->
744768
let ent = com.GetEntity(ent)
745-
if ent.IsFSharpUnion || ent.IsFSharpRecord || ent.IsValueType then
746-
Helper.LibCall(com, "Util", "equalsSafe", Boolean, [left; right], ?loc=r) |> is equal
747-
else
748-
Helper.LibCall(com, "Util", "equals", Boolean, [left; right], ?loc=r) |> is equal
769+
let moduleName, methodName = getEntityEqualsMethod com ent
770+
Helper.LibCall(com, moduleName, methodName, Boolean, [left; right], ?loc=r) |> is equal
749771
| Array t ->
750772
let f = makeComparerFunction com ctx t
751773
Helper.LibCall(com, "Array", "equalsWith", Boolean, [f; left; right], ?loc=r) |> is equal
@@ -770,10 +792,8 @@ and compare (com: ICompiler) ctx r (left: Expr) (right: Expr) =
770792
Helper.LibCall(com, coreModFor bt, "compare", Number Int32, [left; right], ?loc=r)
771793
| DeclaredType(ent, _) ->
772794
let ent = com.GetEntity(ent)
773-
if ent.IsFSharpUnion || ent.IsFSharpRecord || ent.IsValueType then
774-
Helper.LibCall(com, "Util", "compareSafe", Number Int32, [left; right], ?loc=r)
775-
else
776-
Helper.LibCall(com, "Util", "compare", Number Int32, [left; right], ?loc=r)
795+
let moduleName, methodName = getEntityCompareMethod com ent
796+
Helper.LibCall(com, moduleName, methodName, Number Int32, [left; right], ?loc=r)
777797
| Array t ->
778798
let f = makeComparerFunction com ctx t
779799
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)