From 52922f1ac14e335fbf200f32bbc7184fcf725f9e Mon Sep 17 00:00:00 2001 From: ncave <777696+ncave@users.noreply.github.com> Date: Wed, 25 Nov 2020 17:09:23 -0800 Subject: [PATCH] Added support for erased records --- .vscode/launch.json | 4 +- src/Fable.AST/Fable.fs | 1 + src/Fable.Transforms/FSharp2Fable.Util.fs | 7 ++- src/Fable.Transforms/FSharp2Fable.fs | 38 +++++++++---- src/Fable.Transforms/Fable2Babel.fs | 1 + src/Fable.Transforms/FableTransforms.fs | 8 +-- src/Fable.Transforms/Replacements.fs | 57 ++++++++++++++++--- src/fable-standalone/src/Interfaces.fs | 4 +- src/fable-standalone/src/Main.fs | 6 +- .../test/bench-compiler/Platform.fs | 1 + .../test/bench-compiler/app.fs | 2 + .../test/bench-compiler/package.json | 4 +- 12 files changed, 102 insertions(+), 31 deletions(-) diff --git a/.vscode/launch.json b/.vscode/launch.json index f6956c058f..13c18f3b65 100644 --- a/.vscode/launch.json +++ b/.vscode/launch.json @@ -65,8 +65,8 @@ "name": "Run bench-compiler (.NET)", "program": "${workspaceFolder}/src/fable-standalone/test/bench-compiler/bin/Debug/netcoreapp3.1/bench-compiler.dll", // "args": ["${workspaceRoot}/tests/Main/Fable.Tests.fsproj", "out-tests"], - // "args": ["${workspaceRoot}/../fable-test/fable-test.fsproj", "out-test", "--typescript"], - "args": ["${workspaceRoot}/src/fable-library/Fable.Library.fsproj", "out-lib", "--typescript"], + "args": ["${workspaceRoot}/../fable-test/fable-test.fsproj", "out-test", "--typescript"], + // "args": ["${workspaceRoot}/src/fable-library/Fable.Library.fsproj", "out-lib", "--typescript"], "cwd": "${workspaceFolder}/src/fable-standalone/test/bench-compiler" }, { diff --git a/src/Fable.AST/Fable.fs b/src/Fable.AST/Fable.fs index 67492d9cbf..7db8ab660b 100644 --- a/src/Fable.AST/Fable.fs +++ b/src/Fable.AST/Fable.fs @@ -266,6 +266,7 @@ type KeyKind = type GetKind = | ByKey of KeyKind | TupleIndex of int + | FieldIndex of string * int | UnionField of index: int * fieldType: Type | UnionTag | ListHead diff --git a/src/Fable.Transforms/FSharp2Fable.Util.fs b/src/Fable.Transforms/FSharp2Fable.Util.fs index 9c402d623b..d27352edb9 100644 --- a/src/Fable.Transforms/FSharp2Fable.Util.fs +++ b/src/Fable.Transforms/FSharp2Fable.Util.fs @@ -433,6 +433,10 @@ module Helpers = let makeRangeFrom (fsExpr: FSharpExpr) = Some (makeRange fsExpr.Range) + let isErasedRecord (com: Compiler) (t: FSharpType) = + // TODO: check for custom equality or comparison + com.Options.EraseUnions && t.HasTypeDefinition && t.TypeDefinition.IsFSharpRecord + let unionCaseTag (ent: FSharpEntity) (unionCase: FSharpUnionCase) = try ent.UnionCases |> Seq.findIndex (fun uci -> unionCase.Name = uci.Name) @@ -697,8 +701,7 @@ module Patterns = match tryDefinition typ with | None -> failwith "Union without definition" | Some(tdef, fullName) -> - let fullName = defaultArg fullName tdef.CompiledName - match fullName with + match defaultArg fullName tdef.CompiledName with | Types.valueOption | Types.option -> OptionUnion typ.GenericArguments.[0] | Types.list -> ListUnion typ.GenericArguments.[0] diff --git a/src/Fable.Transforms/FSharp2Fable.fs b/src/Fable.Transforms/FSharp2Fable.fs index 01c85d02be..afc131d24e 100644 --- a/src/Fable.Transforms/FSharp2Fable.fs +++ b/src/Fable.Transforms/FSharp2Fable.fs @@ -646,21 +646,30 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) fsExpr = // Getters and Setters | BasicPatterns.AnonRecordGet(callee, calleeType, fieldIndex) -> + let r = makeRangeFrom fsExpr let! callee = transformExpr com ctx callee - let fieldName = calleeType.AnonRecordTypeDetails.SortedFieldNames.[fieldIndex] let typ = makeType ctx.GenericArgs fsExpr.Type - let key = FsField(fieldName, lazy typ) :> Fable.Field |> Fable.FieldKey - return Fable.Get(callee, Fable.ByKey key, typ, makeRangeFrom fsExpr) + let fieldName = calleeType.AnonRecordTypeDetails.SortedFieldNames.[fieldIndex] + if isErasedRecord com calleeType then + return Fable.Get(callee, Fable.FieldIndex(fieldName, fieldIndex), typ, r) + else + let key = FsField(fieldName, lazy typ) :> Fable.Field |> Fable.FieldKey + return Fable.Get(callee, Fable.ByKey key, typ, r) | BasicPatterns.FSharpFieldGet(callee, calleeType, field) -> + let r = makeRangeFrom fsExpr let! callee = transformExprOpt com ctx callee let callee = match callee with | Some callee -> callee | None -> entityRef com (FsEnt calleeType.TypeDefinition) - let key = FsField field :> Fable.Field |> Fable.FieldKey let typ = makeType ctx.GenericArgs fsExpr.Type - return Fable.Get(callee, Fable.ByKey key, typ, makeRangeFrom fsExpr) + if isErasedRecord com calleeType then + let index = calleeType.TypeDefinition.FSharpFields |> Seq.findIndex (fun x -> x.Name = field.Name) + return Fable.Get(callee, Fable.FieldIndex(field.Name, index + 1), typ, r) + else + let key = FsField field :> Fable.Field |> Fable.FieldKey + return Fable.Get(callee, Fable.ByKey key, typ, r) | BasicPatterns.TupleGet(_tupleType, tupleElemIndex, tupleExpr) -> let! tupleExpr = transformExpr com ctx tupleExpr @@ -778,15 +787,24 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) fsExpr = return Fable.Sequential exprs | BasicPatterns.NewRecord(fsType, argExprs) -> + let r = makeRangeFrom fsExpr let! argExprs = transformExprList com ctx argExprs - let genArgs = makeGenArgs ctx.GenericArgs (getGenericArguments fsType) - return Fable.NewRecord(argExprs, FsEnt.Ref fsType.TypeDefinition, genArgs) |> makeValue (makeRangeFrom fsExpr) + if isErasedRecord com fsType then + let recordName = (makeStrConst (getFsTypeFullName fsType)) + return recordName::argExprs |> Fable.NewTuple |> makeValue r + else + let genArgs = makeGenArgs ctx.GenericArgs (getGenericArguments fsType) + return Fable.NewRecord(argExprs, FsEnt.Ref fsType.TypeDefinition, genArgs) |> makeValue r | BasicPatterns.NewAnonRecord(fsType, argExprs) -> + let r = makeRangeFrom fsExpr let! argExprs = transformExprList com ctx argExprs - let fieldNames = fsType.AnonRecordTypeDetails.SortedFieldNames - let genArgs = makeGenArgs ctx.GenericArgs (getGenericArguments fsType) - return Fable.NewAnonymousRecord(argExprs, fieldNames, genArgs) |> makeValue (makeRangeFrom fsExpr) + if isErasedRecord com fsType then + return argExprs |> Fable.NewTuple |> makeValue r + else + let fieldNames = fsType.AnonRecordTypeDetails.SortedFieldNames + let genArgs = makeGenArgs ctx.GenericArgs (getGenericArguments fsType) + return Fable.NewAnonymousRecord(argExprs, fieldNames, genArgs) |> makeValue r | BasicPatterns.NewUnionCase(fsType, unionCase, argExprs) -> let! argExprs = transformExprList com ctx argExprs diff --git a/src/Fable.Transforms/Fable2Babel.fs b/src/Fable.Transforms/Fable2Babel.fs index 309e850840..9d44e1102b 100644 --- a/src/Fable.Transforms/Fable2Babel.fs +++ b/src/Fable.Transforms/Fable2Babel.fs @@ -1208,6 +1208,7 @@ module Util = | Fable.ListTail -> get range (com.TransformAsExpr(ctx, fableExpr)) "tail" + | Fable.FieldIndex (_, index) | Fable.TupleIndex index -> match fableExpr with // TODO: Check the erased expressions don't have side effects? diff --git a/src/Fable.Transforms/FableTransforms.fs b/src/Fable.Transforms/FableTransforms.fs index b4dd818404..38a1eb0bcc 100644 --- a/src/Fable.Transforms/FableTransforms.fs +++ b/src/Fable.Transforms/FableTransforms.fs @@ -59,8 +59,8 @@ let visit f e = Operation(Logical(op, f left, f right), t, r) | Get(e, kind, t, r) -> match kind with - | ListHead | ListTail | OptionValue | TupleIndex _ | UnionTag - | UnionField _ | ByKey(FieldKey _) -> Get(f e, kind, t, r) + | ListHead | ListTail | OptionValue | TupleIndex _ | FieldIndex _ + | UnionTag | UnionField _ | ByKey(FieldKey _) -> Get(f e, kind, t, r) | ByKey(ExprKey e2) -> Get(f e, ByKey(ExprKey(f e2)), t, r) | Sequential exprs -> Sequential(List.map f exprs) | Let(ident, value, body) -> Let(ident, f value, f body) @@ -131,8 +131,8 @@ let getSubExpressions = function | Logical(_, left, right) -> [left; right] | Get(e, kind, _, _) -> match kind with - | ListHead | ListTail | OptionValue | TupleIndex _ | UnionTag - | UnionField _ | ByKey(FieldKey _) -> [e] + | ListHead | ListTail | OptionValue | TupleIndex _ | FieldIndex _ + | UnionTag | UnionField _ | ByKey(FieldKey _) -> [e] | ByKey(ExprKey e2) -> [e; e2] | Sequential exprs -> exprs | Let(_, value, body) -> [value; body] diff --git a/src/Fable.Transforms/Replacements.fs b/src/Fable.Transforms/Replacements.fs index fa752002fc..c32d340ec7 100644 --- a/src/Fable.Transforms/Replacements.fs +++ b/src/Fable.Transforms/Replacements.fs @@ -217,6 +217,7 @@ let (|Nameof|_|) com ctx = function | IdentExpr ident -> Some ident.DisplayName | Get(_, ByKey(ExprKey(StringConst prop)), _, _) -> Some prop | Get(_, ByKey(FieldKey fi), _, _) -> Some fi.Name + | Get(_, FieldIndex(fieldName, _), _, _) -> Some fieldName | NestedLambda(args, Call(IdentExpr ident, info, _, _), None) -> if List.sameLength args info.Args && List.zip args info.Args |> List.forall (fun (a1, a2) -> match a2 with IdentExpr id2 -> a1.Name = id2.Name | _ -> false) @@ -695,6 +696,50 @@ let isCompatibleWithJsComparison = function // * `.GetHashCode` called directly defaults to identity hash (for reference types except string) if not implemented. // * `LanguagePrimitive.PhysicalHash` creates an identity hash no matter whether GetHashCode is implemented or not. +let getEntityHashMethod (com: ICompiler) (ent: Entity) = + if (ent.IsFSharpUnion || ent.IsFSharpRecord) then + if com.Options.EraseUnions + then "Util", "structuralHash" + else "Util", "hashSafe" + elif ent.IsValueType + then "Util", "hashSafe" + 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" + +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" + +let identityHashMethod (com: ICompiler) = function + | Boolean | Char | String | Number _ | Enum _ | Option _ | Tuple _ | List _ + | Builtin (BclInt64 | BclUInt64 | BclDecimal | BclBigInt) + | Builtin (BclGuid | BclTimeSpan | BclDateTime | BclDateTimeOffset) + | Builtin (FSharpSet _ | FSharpMap _ | FSharpChoice _ | FSharpResult _) -> + "Util", "structuralHash" + | DeclaredType(ent, _) -> com.GetEntity(ent) |> getEntityHashMethod com + | _ -> "Util", "identityHash" + +let structuralHashMethod (com: ICompiler) = function + | MetaType -> "Reflection", "getHashCode" + | DeclaredType(ent, _) -> + let ent = com.GetEntity(ent) + if not ent.IsInterface then getEntityHashMethod com ent + else "Util", "structuralHash" + | _ -> "Util", "structuralHash" + let identityHash com r (arg: Expr) = let methodName = match arg.Type with @@ -747,10 +792,8 @@ let rec equals (com: ICompiler) ctx r equal (left: Expr) (right: Expr) = Helper.LibCall(com, coreModFor bt, "equals", Boolean, [left; right], ?loc=r) |> is equal | DeclaredType(ent, _) -> let ent = com.GetEntity(ent) - if ent.IsFSharpUnion || ent.IsFSharpRecord || ent.IsValueType then - Helper.LibCall(com, "Util", "equalsSafe", Boolean, [left; right], ?loc=r) |> is equal - else - Helper.LibCall(com, "Util", "equals", Boolean, [left; right], ?loc=r) |> is equal + let moduleName, methodName = getEntityEqualsMethod com ent + Helper.LibCall(com, moduleName, methodName, Boolean, [left; right], ?loc=r) |> is equal | Array t -> let f = makeComparerFunction com ctx t 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) = Helper.LibCall(com, coreModFor bt, "compare", Number Int32, [left; right], ?loc=r) | DeclaredType(ent, _) -> let ent = com.GetEntity(ent) - if ent.IsFSharpUnion || ent.IsFSharpRecord || ent.IsValueType then - Helper.LibCall(com, "Util", "compareSafe", Number Int32, [left; right], ?loc=r) - else - Helper.LibCall(com, "Util", "compare", Number Int32, [left; right], ?loc=r) + let moduleName, methodName = getEntityCompareMethod com ent + Helper.LibCall(com, moduleName, methodName, Number Int32, [left; right], ?loc=r) | Array t -> let f = makeComparerFunction com ctx t Helper.LibCall(com, "Array", "compareWith", Number Int32, [f; left; right], ?loc=r) diff --git a/src/fable-standalone/src/Interfaces.fs b/src/fable-standalone/src/Interfaces.fs index e31d36ce42..53ae798f3a 100644 --- a/src/fable-standalone/src/Interfaces.fs +++ b/src/fable-standalone/src/Interfaces.fs @@ -64,7 +64,9 @@ type IFableManager = abstract GetToolTipText: parseResults: IParseResults * line: int * col: int * lineText: string -> string[] abstract GetCompletionsAtLocation: parseResults: IParseResults * line: int * col: int * lineText: string -> Completion[] abstract CompileToBabelAst: fableLibrary: string * parseResults: IParseResults * fileName: string + * ?eraseUnions: bool * ?typedArrays: bool - * ?typescript: bool -> IBabelResult + * ?typescript: bool + -> IBabelResult abstract PrintBabelAst: babelResult: IBabelResult * IWriter -> Async abstract FSharpAstToString: parseResults: IParseResults * fileName: string -> string diff --git a/src/fable-standalone/src/Main.fs b/src/fable-standalone/src/Main.fs index d609af3eec..11ff593b07 100644 --- a/src/fable-standalone/src/Main.fs +++ b/src/fable-standalone/src/Main.fs @@ -258,14 +258,16 @@ let init () = getCompletionsAtLocation res line col lineText member __.CompileToBabelAst(fableLibrary:string, parseResults:IParseResults, fileName:string, - ?typedArrays, ?typescript) = + ?eraseUnions, ?typedArrays, ?typescript) = let res = parseResults :?> ParseResults let project = res.GetProject() let define = parseResults.OtherFSharpOptions |> Array.choose (fun x -> if x.StartsWith("--define:") || x.StartsWith("-d:") then x.[(x.IndexOf(':') + 1)..] |> Some else None) |> Array.toList - let options = Fable.CompilerOptionsHelper.Make(define=define, ?typedArrays=typedArrays, ?typescript=typescript) + let options = + Fable.CompilerOptionsHelper.Make(define=define, + ?eraseUnions=eraseUnions, ?typedArrays=typedArrays, ?typescript=typescript) let com = CompilerImpl(fileName, project, options, fableLibrary) let ast = FSharp2Fable.Compiler.transformFile com diff --git a/src/fable-standalone/test/bench-compiler/Platform.fs b/src/fable-standalone/test/bench-compiler/Platform.fs index 6187270c18..e6eb375f2d 100644 --- a/src/fable-standalone/test/bench-compiler/Platform.fs +++ b/src/fable-standalone/test/bench-compiler/Platform.fs @@ -6,6 +6,7 @@ type CmdLineOptions = { benchmark: bool optimize: bool // sourceMaps: bool + eraseUnions: bool typedArrays: bool typescript: bool printAst: bool diff --git a/src/fable-standalone/test/bench-compiler/app.fs b/src/fable-standalone/test/bench-compiler/app.fs index 394e9cdd85..f0011bdd76 100644 --- a/src/fable-standalone/test/bench-compiler/app.fs +++ b/src/fable-standalone/test/bench-compiler/app.fs @@ -145,6 +145,7 @@ let parseFiles projectFileName options = let parseFable (res, fileName) = fable.CompileToBabelAst(libDir, res, fileName, + eraseUnions = options.eraseUnions, typedArrays = options.typedArrays, typescript = options.typescript) @@ -227,6 +228,7 @@ let run opts projectFileName outDir = benchmark = opts |> hasFlag "--benchmark" optimize = opts |> hasFlag "--optimize" // sourceMaps = opts |> hasFlag "--sourceMaps" + eraseUnions = opts |> hasFlag "--eraseUnions" typedArrays = opts |> tryFlag "--typedArrays" |> Option.defaultValue (opts |> hasFlag "--typescript" |> not) typescript = opts |> hasFlag "--typescript" diff --git a/src/fable-standalone/test/bench-compiler/package.json b/src/fable-standalone/test/bench-compiler/package.json index fc53585d31..a2d672515b 100644 --- a/src/fable-standalone/test/bench-compiler/package.json +++ b/src/fable-standalone/test/bench-compiler/package.json @@ -1,6 +1,6 @@ { "private": true, - "type": "module", + "_type": "module", "scripts": { "build-cli": "dotnet run -c Release -p ../../../Fable.Cli -- bench-compiler.fsproj --outDir out-node", "postbuild-cli": "npm run rollup-bundle", @@ -44,7 +44,7 @@ "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", - "pretests": "npm run build-tests-dotnet", + "_pretests": "npm run build-tests-dotnet -- --eraseUnions", "tests": "npm run mocha -- out-tests -r esm --colors", "tsc": "node ../../../../node_modules/typescript/bin/tsc",