Skip to content

Commit

Permalink
Added FieldIndexSet
Browse files Browse the repository at this point in the history
  • Loading branch information
ncave committed Nov 16, 2020
1 parent 00bff1c commit 438c5ab
Show file tree
Hide file tree
Showing 8 changed files with 62 additions and 40 deletions.
2 changes: 1 addition & 1 deletion .vscode/launch.json
Original file line number Diff line number Diff line change
Expand Up @@ -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"
},
Expand Down
9 changes: 7 additions & 2 deletions src/Fable.AST/Fable.fs
Original file line number Diff line number Diff line change
Expand Up @@ -269,6 +269,11 @@ type GetKind =
| ListTail
| OptionValue

type SetKind =
| ByKeySet of KeyKind
| FieldIndexSet of string * int
| ValueSet

type TestKind =
| TypeTest of Type
| OptionTest of isSome: bool
Expand Down Expand Up @@ -307,8 +312,8 @@ type Expr =

// Getters, setters and bindings
| Let 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
Expand Down
2 changes: 1 addition & 1 deletion src/Fable.Transforms/FSharp2Fable.Util.fs
Original file line number Diff line number Diff line change
Expand Up @@ -1324,7 +1324,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

Expand Down
33 changes: 22 additions & 11 deletions src/Fable.Transforms/FSharp2Fable.fs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -221,11 +224,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 =
Expand Down Expand Up @@ -685,7 +691,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 ->
Expand All @@ -705,14 +711,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
Expand All @@ -734,7 +745,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
Expand Down
16 changes: 9 additions & 7 deletions src/Fable.Transforms/Fable2Babel.fs
Original file line number Diff line number Diff line change
Expand Up @@ -1215,9 +1215,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) =
Expand Down Expand Up @@ -1610,10 +1611,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 =
Expand Down
14 changes: 7 additions & 7 deletions src/Fable.Transforms/FableTransforms.fs
Original file line number Diff line number Diff line change
Expand Up @@ -70,9 +70,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) ->
Expand Down Expand Up @@ -138,8 +138,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, _) ->
Expand Down Expand Up @@ -478,9 +478,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 =
Expand Down
18 changes: 9 additions & 9 deletions src/Fable.Transforms/Replacements.fs
Original file line number Diff line number Diff line change
Expand Up @@ -382,7 +382,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 =
Expand Down Expand Up @@ -926,7 +926,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
Expand Down Expand Up @@ -1212,7 +1212,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...)"
Expand Down Expand Up @@ -1254,7 +1254,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) =
Expand Down Expand Up @@ -1736,7 +1736,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] ->
Expand Down Expand Up @@ -1824,7 +1824,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] ->
Expand Down Expand Up @@ -1854,7 +1854,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", _ ->
Expand Down Expand Up @@ -2235,7 +2235,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
Expand Down Expand Up @@ -2607,7 +2607,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

Expand Down
8 changes: 6 additions & 2 deletions src/fable-standalone/test/bench-compiler/package.json
Original file line number Diff line number Diff line change
@@ -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",
Expand Down Expand Up @@ -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",
Expand Down

0 comments on commit 438c5ab

Please sign in to comment.