From e385504c22c35e14caa64482e121e149db905ca5 Mon Sep 17 00:00:00 2001 From: ncave <777696+ncave@users.noreply.github.com> Date: Wed, 25 Nov 2020 17:09:53 -0800 Subject: [PATCH] Added FieldIndexSet --- .vscode/launch.json | 2 +- src/Fable.AST/Fable.fs | 9 +++-- src/Fable.Transforms/FSharp2Fable.Util.fs | 2 +- src/Fable.Transforms/FSharp2Fable.fs | 33 ++++++++++++------- src/Fable.Transforms/Fable2Babel.fs | 16 +++++---- src/Fable.Transforms/FableTransforms.fs | 14 ++++---- src/Fable.Transforms/Replacements.fs | 18 +++++----- .../test/bench-compiler/package.json | 8 +++-- 8 files changed, 62 insertions(+), 40 deletions(-) diff --git a/.vscode/launch.json b/.vscode/launch.json index 13c18f3b6..4e44ba798 100644 --- a/.vscode/launch.json +++ b/.vscode/launch.json @@ -65,7 +65,7 @@ "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}/../fable-test/fable-test.fsproj", "out-test", "--eraseUnions"], // "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 7db8ab660..5481533f5 100644 --- a/src/Fable.AST/Fable.fs +++ b/src/Fable.AST/Fable.fs @@ -273,6 +273,11 @@ type GetKind = | ListTail | OptionValue +type SetKind = + | ByKeySet of KeyKind + | FieldIndexSet of string * int + | ValueSet + type TestKind = | TypeTest of Type | OptionTest of isSome: bool @@ -312,8 +317,8 @@ type Expr = // Getters, setters and bindings | Let of Ident * Expr * body: Expr | LetRec of bindings: (Ident * Expr) list * body: Expr - | Get of Expr * GetKind * typ: Type * range: SourceLocation option - | Set of Expr * key: KeyKind option * value: Expr * range: SourceLocation option + | Get of Expr * kind: GetKind * typ: Type * range: SourceLocation option + | Set of Expr * kind: SetKind * value: Expr * range: SourceLocation option // Control flow | Sequential of Expr list diff --git a/src/Fable.Transforms/FSharp2Fable.Util.fs b/src/Fable.Transforms/FSharp2Fable.Util.fs index d27352edb..1b245ffe4 100644 --- a/src/Fable.Transforms/FSharp2Fable.Util.fs +++ b/src/Fable.Transforms/FSharp2Fable.Util.fs @@ -1327,7 +1327,7 @@ module Util = let t = memb.CurriedParameterGroups.[0].[0].Type |> makeType Map.empty let arg = callInfo.Args |> List.tryHead |> Option.defaultWith makeNull let key = makeFieldKey name true t - Fable.Set(callee, Some key, arg, r) + Fable.Set(callee, Fable.ByKeySet key, arg, r) else getSimple callee name |> makeCall r typ callInfo diff --git a/src/Fable.Transforms/FSharp2Fable.fs b/src/Fable.Transforms/FSharp2Fable.fs index afc131d24..ae0715f8d 100644 --- a/src/Fable.Transforms/FSharp2Fable.fs +++ b/src/Fable.Transforms/FSharp2Fable.fs @@ -53,8 +53,11 @@ 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 _, _ -> (makeStrConst unionCase.Name)::argExprs |> Fable.NewTuple |> makeValue r + // | 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.AsValue, [arg] -> arg | EraseKind.AsValue, _ -> failwith "Shouldn't happen, error?" | EraseKind.AsTuple, _ -> Fable.NewTuple argExprs |> makeValue r @@ -224,11 +227,14 @@ let private transformUnionCaseTest (com: IFableCompiler) (ctx: Context) r | ErasedUnion(kind, tdef, genArgs) -> match kind with | EraseKind.AsNamedTuple caseRule -> - if unionCase.UnionCaseFields.Count = 0 then - return makeEqOp r unionExpr (transformStringEnum caseRule unionCase) BinaryEqualStrict - else - let name = Fable.Get(unionExpr, Fable.TupleIndex(0), Fable.String, None) - return makeEqOp r name (makeStrConst unionCase.Name) BinaryEqualStrict + let tag1 = Fable.Get(unionExpr, Fable.TupleIndex(0), Fable.Number Int32, None) + let tag2 = unionCaseTag tdef unionCase |> makeIntConst + return makeEqOp r tag1 tag2 BinaryEqualStrict + // if unionCase.UnionCaseFields.Count = 0 then + // return makeEqOp r unionExpr (transformStringEnum caseRule unionCase) BinaryEqualStrict + // else + // let name = Fable.Get(unionExpr, Fable.TupleIndex(0), Fable.String, None) + // return makeEqOp r name (makeStrConst unionCase.Name) BinaryEqualStrict | EraseKind.AsValue -> let fi = unionCase.UnionCaseFields.[0] let typ = @@ -691,7 +697,7 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) fsExpr = if unionCase.UnionCaseFields.Count = 0 then return "StringEnum types cannot have fields" |> addErrorAndReturnNull com ctx.InlinePath r else - return getByIndex 1 + return getByIndex 2 | OptionUnion t -> return Fable.Get(unionExpr, Fable.OptionValue, makeType ctx.GenericArgs t, r) | ListUnion t -> @@ -711,14 +717,19 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) fsExpr = return Fable.Get(unionExpr, kind, typ, r) | BasicPatterns.FSharpFieldSet(callee, calleeType, field, value) -> + let r = makeRangeFrom fsExpr let! callee = transformExprOpt com ctx callee let! value = transformExpr com ctx value let callee = match callee with | Some callee -> callee | None -> entityRef com (FsEnt calleeType.TypeDefinition) - let field = FsField field :> Fable.Field |> Fable.FieldKey |> Some - return Fable.Set(callee, field, value, makeRangeFrom fsExpr) + if isErasedRecord com calleeType then + let index = calleeType.TypeDefinition.FSharpFields |> Seq.findIndex (fun x -> x.Name = field.Name) + return Fable.Set(callee, Fable.FieldIndexSet(field.Name, index + 1), value, r) + else + let key = FsField field :> Fable.Field |> Fable.FieldKey + return Fable.Set(callee, Fable.ByKeySet key, value, r) | BasicPatterns.UnionCaseTag(unionExpr, _unionType) -> let! unionExpr = transformExpr com ctx unionExpr @@ -740,7 +751,7 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) fsExpr = return makeCall r Fable.Unit info valToSet | _ -> let valToSet = makeValueFrom com ctx r valToSet - return Fable.Set(valToSet, None, valueExpr, r) + return Fable.Set(valToSet, Fable.ValueSet, valueExpr, r) | BasicPatterns.NewArray(FableType com ctx elTyp, argExprs) -> let! argExprs = transformExprList com ctx argExprs diff --git a/src/Fable.Transforms/Fable2Babel.fs b/src/Fable.Transforms/Fable2Babel.fs index 9d44e1102..5641dc81b 100644 --- a/src/Fable.Transforms/Fable2Babel.fs +++ b/src/Fable.Transforms/Fable2Babel.fs @@ -1234,9 +1234,10 @@ module Util = let value = com.TransformAsExpr(ctx, value) |> wrapIntExpression value.Type let var = match setKind with - | None -> var - | Some(Fable.FieldKey fi) -> get None var fi.Name - | Some(Fable.ExprKey(TransformExpr com ctx e)) -> getExpr None var e + | Fable.ValueSet -> var + | Fable.ByKeySet(Fable.FieldKey fi) -> get None var fi.Name + | Fable.ByKeySet(Fable.ExprKey(TransformExpr com ctx e)) -> getExpr None var e + | Fable.FieldIndexSet (_, index) -> getExpr None var (ofInt index) assign range var value let transformBindingExprBody (com: IBabelCompiler) ctx (var: Fable.Ident) (value: Fable.Expr) = @@ -1641,10 +1642,11 @@ module Util = | Fable.Set(TransformExpr com ctx expr, kind, value, _range) -> let ret = match kind with - | None -> Assign expr - | Some(Fable.ExprKey(TransformExpr com ctx prop)) -> getExpr None expr prop |> Assign - | Some(Fable.FieldKey fi) -> get None expr fi.Name |> Assign - com.TransformAsStatements(ctx, Some ret, value) + | Fable.ValueSet -> expr + | Fable.ByKeySet(Fable.ExprKey(TransformExpr com ctx prop)) -> getExpr None expr prop + | Fable.ByKeySet(Fable.FieldKey fi) -> get None expr fi.Name + | Fable.FieldIndexSet (_, index) -> getExpr None expr (ofInt index) + com.TransformAsStatements(ctx, Some (Assign ret), value) | Fable.IfThenElse(guardExpr, thenExpr, elseExpr, r) -> let asStatement = diff --git a/src/Fable.Transforms/FableTransforms.fs b/src/Fable.Transforms/FableTransforms.fs index 38a1eb0bc..f12f424a0 100644 --- a/src/Fable.Transforms/FableTransforms.fs +++ b/src/Fable.Transforms/FableTransforms.fs @@ -71,9 +71,9 @@ let visit f e = IfThenElse(f cond, f thenExpr, f elseExpr, r) | Set(e, kind, v, r) -> match kind with - | Some(ExprKey e2) -> - Set(f e, Some(ExprKey(f e2)), f v, r) - | Some(FieldKey _) | None -> Set(f e, kind, f v, r) + | ByKeySet(ExprKey e2) -> + Set(f e, ByKeySet(ExprKey(f e2)), f v, r) + | _ -> Set(f e, kind, f v, r) | WhileLoop(e1, e2, r) -> WhileLoop(f e1, f e2, r) | ForLoop(i, e1, e2, e3, up, r) -> ForLoop(i, f e1, f e2, f e3, up, r) | TryCatch(body, catch, finalizer, r) -> @@ -140,8 +140,8 @@ let getSubExpressions = function | IfThenElse(cond, thenExpr, elseExpr, _) -> [cond; thenExpr; elseExpr] | Set(e, kind, v, _) -> match kind with - | Some(ExprKey e2) -> [e; e2; v] - | Some(FieldKey _) | None -> [e; v] + | ByKeySet(ExprKey e2) -> [e; e2; v] + | _ -> [e; v] | WhileLoop(e1, e2, _) -> [e1; e2] | ForLoop(_, e1, e2, e3, _, _) -> [e1; e2; e3] | TryCatch(body, catch, finalizer, _) -> @@ -558,9 +558,9 @@ module private Transforms = let uci = com.GetEntity(ent).UnionCases.[tag] let args = uncurryConsArgs args uci.UnionCaseFields Value(NewUnion(args, tag, ent, genArgs), r) - | Set(e, Some(FieldKey fi), value, r) -> + | Set(e, ByKeySet(FieldKey fi), value, r) -> let value = uncurryArgs com false [fi.FieldType] [value] - Set(e, Some(FieldKey fi), List.head value, r) + Set(e, ByKeySet(FieldKey fi), List.head value, r) | e -> e let rec uncurryApplications (com: Compiler) e = diff --git a/src/Fable.Transforms/Replacements.fs b/src/Fable.Transforms/Replacements.fs index c32d340ec..12ec21757 100644 --- a/src/Fable.Transforms/Replacements.fs +++ b/src/Fable.Transforms/Replacements.fs @@ -384,7 +384,7 @@ let makeRefFromMutableValue com ctx (value: Expr) = let getter = Delegate([], value, None) let setter = let v = makeUniqueIdent ctx Any "v" - Delegate([v], Set(value, None, IdentExpr v, None), None) + Delegate([v], Set(value, ValueSet, IdentExpr v, None), None) Helper.LibCall(com, "Types", "FSharpRef", t, [getter; setter], isJsConstructor=true) let turnLastArgIntoRef com ctx args = @@ -951,7 +951,7 @@ let makePojoFromLambda com arg = | Lambda(_, lambdaBody, _) -> (flattenSequential lambdaBody, Some []) ||> List.foldBack (fun statement acc -> match acc, statement with - | Some acc, Set(_, Some(FieldKey fi), value, _) -> + | Some acc, Set(_, ByKeySet(FieldKey fi), value, _) -> objValue (fi.Name, value)::acc |> Some | _ -> None) | _ -> None @@ -1247,7 +1247,7 @@ let fableCoreLib (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Exp | "op_Dynamic", [left; memb] -> getExpr r t left memb |> Some | "op_DynamicAssignment", [callee; prop; MaybeLambdaUncurriedAtCompileTime value] -> - Set(callee, Some(ExprKey prop), value, r) |> Some + Set(callee, ByKeySet(ExprKey prop), value, r) |> Some | ("op_Dollar"|"createNew" as m), callee::args -> let args = destructureTupleArgs args if m = "createNew" then "new $0($1...)" else "$0($1...)" @@ -1289,7 +1289,7 @@ let fableCoreLib (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Exp | _ -> None let getReference r t expr = get r t expr "contents" -let setReference r expr value = Set(expr, Some(ExprKey(makeStrConst "contents")), value, r) +let setReference r expr value = Set(expr, ByKeySet(ExprKey(makeStrConst "contents")), value, r) let newReference com r t value = Helper.LibCall(com, "Types", "FSharpRef", t, [value], isJsConstructor=true, ?loc=r) let references (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = @@ -1771,7 +1771,7 @@ let resizeArrays (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (this | ".ctor", _, args -> Helper.GlobalCall("Array", t, args, memb="from", ?loc=r) |> Some | "get_Item", Some ar, [idx] -> getExpr r t ar idx |> Some - | "set_Item", Some ar, [idx; value] -> Set(ar, Some(ExprKey idx), value, r) |> Some + | "set_Item", Some ar, [idx; value] -> Set(ar, ByKeySet(ExprKey idx), value, r) |> Some | "Add", Some ar, [arg] -> "void ($0)" |> emitJsExpr r t [Helper.InstanceCall(ar, "push", t, [arg])] |> Some | "Remove", Some ar, [arg] -> @@ -1859,7 +1859,7 @@ let arrays (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: E match i.CompiledName, thisArg, args with | "get_Length", Some arg, _ -> get r t arg "length" |> Some | "get_Item", Some arg, [idx] -> getExpr r t arg idx |> Some - | "set_Item", Some arg, [idx; value] -> Set(arg, Some(ExprKey idx), value, r) |> Some + | "set_Item", Some arg, [idx; value] -> Set(arg, ByKeySet(ExprKey idx), value, r) |> Some | "Copy", None, [source; target; count] -> Helper.LibCall(com, "Array", "copyTo", t, [source; makeIntConst 0; target; makeIntConst 0; count], i.SignatureArgTypes, ?loc=r) |> Some | "Copy", None, [source; sourceIndex; target; targetIndex; count] -> @@ -1889,7 +1889,7 @@ let arrayModule (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (_: Ex | ("Length" | "Count"), [arg] -> get r t arg "length" |> Some | "Item", [idx; ar] -> getExpr r t ar idx |> Some | "Get", [ar; idx] -> getExpr r t ar idx |> Some - | "Set", [ar; idx; value] -> Set(ar, Some(ExprKey idx), value, r) |> Some + | "Set", [ar; idx; value] -> Set(ar, ByKeySet(ExprKey idx), value, r) |> Some | "ZeroCreate", [count] -> createArray count None |> Some | "Create", [count; value] -> createArray count (Some value) |> Some | "Empty", _ -> @@ -2273,7 +2273,7 @@ let intrinsicFunctions (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisAr | "MakeDecimal", _, _ -> decimals com ctx r t i thisArg args | "GetString", _, [ar; idx] | "GetArray", _, [ar; idx] -> getExpr r t ar idx |> Some - | "SetArray", _, [ar; idx; value] -> Set(ar, Some(ExprKey idx), value, r) |> Some + | "SetArray", _, [ar; idx; value] -> Set(ar, ByKeySet(ExprKey idx), value, r) |> Some | ("GetArraySlice" | "GetStringSlice"), None, [ar; lower; upper] -> let upper = match upper with @@ -2645,7 +2645,7 @@ let timers (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr opti match i.CompiledName, thisArg, args with | ".ctor", _, _ -> Helper.LibCall(com, "Timer", "default", t, args, i.SignatureArgTypes, isJsConstructor=true, ?loc=r) |> Some | Naming.StartsWith "get_" meth, Some x, _ -> get r t x meth |> Some - | Naming.StartsWith "set_" meth, Some x, [value] -> Set(x, Some(ExprKey(makeStrConst meth)), value, r) |> Some + | Naming.StartsWith "set_" meth, Some x, [value] -> Set(x, ByKeySet(ExprKey(makeStrConst meth)), value, r) |> Some | meth, Some x, args -> Helper.InstanceCall(x, meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some | _ -> None diff --git a/src/fable-standalone/test/bench-compiler/package.json b/src/fable-standalone/test/bench-compiler/package.json index a2d672515..d5a5ba3c3 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,9 +44,13 @@ "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 -- --eraseUnions", "tests": "npm run mocha -- out-tests -r esm --colors", + "prebuild-fable-library": "dotnet run -c Release ../../../fable-library/Fable.Library.fsproj ./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", + "tsc": "node ../../../../node_modules/typescript/bin/tsc", "babel": "node ../../../../node_modules/@babel/cli/bin/babel", "mocha": "node ../../../../node_modules/mocha/bin/mocha",