Added FieldIndexSet

Author: ncave

.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"
         },

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

src/Fable.Transforms/FSharp2Fable.Util.fs

@@ -1321,7 +1321,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
 

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
@@ -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 =
@@ -688,7 +694,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 ->
@@ -708,14 +714,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
@@ -737,7 +748,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

src/Fable.Transforms/Fable2Babel.fs

@@ -1225,9 +1225,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) =
@@ -1632,10 +1633,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 =

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, _) ->
@@ -506,9 +506,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 =

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
 

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",