Fix for anonymous record execution order (#6606)

* start of fix * fix anon recd construction * fix test * add tests, fix tests * add tests, fix tests
dotnet · Apr 23, 2019 · b3df14c · b3df14c
1 parent 028d118
commit b3df14c
Show file tree

Hide file tree

Showing 4 changed files with 151 additions and 54 deletions.
diff --git a/src/fsharp/TastOps.fs b/src/fsharp/TastOps.fs
@@ -6492,8 +6492,6 @@ let mkRefTupledNoTypes g m args = mkRefTupled g m args (List.map (tyOfExpr g) ar
 
 let mkRefTupledVars g m vs = mkRefTupled g m (List.map (exprForVal m) vs) (typesOfVals vs)
 
-let mkAnonRecd (_g: TcGlobals) m anonInfo es tys = Expr.Op (TOp.AnonRecd anonInfo,tys,es,m)
-
 //--------------------------------------------------------------------------
 // Permute expressions
 //--------------------------------------------------------------------------
@@ -6554,21 +6552,35 @@ let permuteExprList (sigma: int[]) (exprs: Expr list) (ty: TType list) (names: s
 ///     let sigma = Array.map #Index ()  
 /// However the presence of static fields means .Index may index into a non-compact set of instance field indexes. 
 /// We still need to sort by index. 
-let mkRecordExpr g (lnk, tcref, tinst, rfrefs: RecdFieldRef list, args, m) =  
+let mkRecordExpr g (lnk, tcref, tinst, unsortedRecdFields: RecdFieldRef list, unsortedFieldExprs, m) =  
     // Remove any abbreviations 
     let tcref, tinst = destAppTy g (mkAppTy tcref tinst)
 
-    let rfrefsArray = rfrefs |> List.indexed |> Array.ofList
-    rfrefsArray |> Array.sortInPlaceBy (fun (_, r) -> r.Index)
-    let sigma = Array.create rfrefsArray.Length -1
-    Array.iteri (fun j (i, _) -> 
-        if sigma.[i] <> -1 then error(InternalError("bad permutation", m))
-        sigma.[i] <- j) rfrefsArray
+    let sortedRecdFields = unsortedRecdFields |> List.indexed |> Array.ofList |> Array.sortBy (fun (_, r) -> r.Index)
+    let sigma = Array.create sortedRecdFields.Length -1
+    sortedRecdFields |> Array.iteri (fun sortedIdx (unsortedIdx, _) -> 
+        if sigma.[unsortedIdx] <> -1 then error(InternalError("bad permutation", m))
+        sigma.[unsortedIdx] <- sortedIdx) 
+
+    let unsortedArgTys = unsortedRecdFields |> List.map (fun rfref -> actualTyOfRecdFieldRef rfref tinst)
+    let unsortedArgNames = unsortedRecdFields |> List.map (fun rfref -> rfref.FieldName)
+    let unsortedArgBinds, sortedArgExprs = permuteExprList sigma unsortedFieldExprs unsortedArgTys unsortedArgNames
+    let core = Expr.Op (TOp.Recd (lnk, tcref), tinst, sortedArgExprs, m)
+    mkLetsBind m unsortedArgBinds core
+
+let mkAnonRecd (_g: TcGlobals) m (anonInfo: AnonRecdTypeInfo) (unsortedIds: Ident[]) (unsortedFieldExprs: Expr list) unsortedArgTys =
+    let sortedRecdFields = unsortedFieldExprs |> List.indexed |> Array.ofList |> Array.sortBy (fun (i,_) -> unsortedIds.[i].idText)
+    let sortedArgTys = unsortedArgTys |> List.indexed |> List.sortBy (fun (i,_) -> unsortedIds.[i].idText) |> List.map snd
+
+    let sigma = Array.create sortedRecdFields.Length -1
+    sortedRecdFields |> Array.iteri (fun sortedIdx (unsortedIdx, _) -> 
+        if sigma.[unsortedIdx] <> -1 then error(InternalError("bad permutation", m))
+        sigma.[unsortedIdx] <- sortedIdx) 
 
-    let argTys = List.map (fun rfref -> actualTyOfRecdFieldRef rfref tinst) rfrefs
-    let names = rfrefs |> List.map (fun rfref -> rfref.FieldName)
-    let binds, args = permuteExprList sigma args argTys names
-    mkLetsBind m binds (Expr.Op (TOp.Recd (lnk, tcref), tinst, args, m))
+    let unsortedArgNames = unsortedIds |> Array.toList |> List.map (fun id -> id.idText)
+    let unsortedArgBinds, sortedArgExprs = permuteExprList sigma unsortedFieldExprs unsortedArgTys unsortedArgNames
+    let core = Expr.Op (TOp.AnonRecd anonInfo, sortedArgTys, sortedArgExprs, m)
+    mkLetsBind m unsortedArgBinds core
 
 //-------------------------------------------------------------------------
 // List builders

diff --git a/src/fsharp/TastOps.fsi b/src/fsharp/TastOps.fsi
@@ -2120,7 +2120,7 @@ val mkMethodTy : TcGlobals -> TType list list -> TType -> TType
 
 val mkAnyAnonRecdTy : TcGlobals -> AnonRecdTypeInfo -> TType list -> TType
 
-val mkAnonRecd : TcGlobals -> range -> AnonRecdTypeInfo -> Exprs -> TType list -> Expr 
+val mkAnonRecd : TcGlobals -> range -> AnonRecdTypeInfo -> Ident[] -> Exprs -> TType list -> Expr 
 
 val AdjustValForExpectedArity : TcGlobals -> range -> ValRef -> ValUseFlag -> ValReprInfo -> Expr * TType
 

diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs
@@ -4673,11 +4673,11 @@ and TcTypeOrMeasure optKind cenv newOk checkCxs occ env (tpenv: SyntacticUnscope
     | SynType.AnonRecd(isStruct, args,m) ->   
         let tupInfo = mkTupInfo isStruct
         let args',tpenv = TcTypesAsTuple cenv newOk checkCxs occ env tpenv (args |> List.map snd |> List.map (fun x -> (false,x))) m
-        let unsortedIds = args |> List.map fst |> List.toArray
-        let anonInfo = AnonRecdTypeInfo.Create(cenv.topCcu, tupInfo, unsortedIds)
+        let unsortedFieldIds = args |> List.map fst |> List.toArray
+        let anonInfo = AnonRecdTypeInfo.Create(cenv.topCcu, tupInfo, unsortedFieldIds)
         // Sort into canonical order
-        let sortedArgTys, sortedCheckedArgTys = List.zip args args' |> List.indexed |> List.sortBy (fun (i,_) -> unsortedIds.[i].idText) |> List.map snd |> List.unzip
-        sortedArgTys |> List.iteri (fun i (x,_) -> 
+        let sortedFieldTys, sortedCheckedArgTys = List.zip args args' |> List.indexed |> List.sortBy (fun (i,_) -> unsortedFieldIds.[i].idText) |> List.map snd |> List.unzip
+        sortedFieldTys |> List.iteri (fun i (x,_) -> 
             let item = Item.AnonRecdField(anonInfo, sortedCheckedArgTys, i, x.idRange)
             CallNameResolutionSink cenv.tcSink (x.idRange,env.NameEnv,item,item,emptyTyparInst,ItemOccurence.UseInType,env.DisplayEnv,env.eAccessRights))
         TType_anon(anonInfo, sortedCheckedArgTys),tpenv
@@ -5879,8 +5879,8 @@ and TcExprUndelayed cenv overallTy env tpenv (synExpr: SynExpr) =
         let expr = mkAnyTupled cenv.g m tupInfo args' argTys 
         expr, tpenv
 
-    | SynExpr.AnonRecd (isStruct, optOrigExpr, unsortedArgs, mWholeExpr) -> 
-        TcAnonRecdExpr cenv overallTy env tpenv (isStruct, optOrigExpr, unsortedArgs, mWholeExpr)
+    | SynExpr.AnonRecd (isStruct, optOrigExpr, unsortedFieldExprs, mWholeExpr) -> 
+        TcAnonRecdExpr cenv overallTy env tpenv (isStruct, optOrigExpr, unsortedFieldExprs, mWholeExpr)
 
     | SynExpr.ArrayOrList (isArray, args, m) -> 
         CallExprHasTypeSink cenv.tcSink (m, env.NameEnv, overallTy, env.DisplayEnv, env.eAccessRights)
@@ -7036,26 +7036,39 @@ and TcRecdExpr cenv overallTy env tpenv (inherits, optOrigExpr, flds, mWholeExpr
 
 
 // Check '{| .... |}'
-and TcAnonRecdExpr cenv overallTy env tpenv (isStruct, optOrigExpr, unsortedArgs, mWholeExpr) =
+and TcAnonRecdExpr cenv overallTy env tpenv (isStruct, optOrigSynExpr, unsortedFieldIdsAndSynExprsGiven, mWholeExpr) =
+    let unsortedFieldSynExprsGiven = List.map snd unsortedFieldIdsAndSynExprsGiven
 
-    match optOrigExpr with 
+    match optOrigSynExpr with 
     | None -> 
-        let unsortedIds = unsortedArgs |> List.map fst |> List.toArray
-        let anonInfo, sortedArgTys = UnifyAnonRecdTypeAndInferCharacteristics env.eContextInfo cenv env.DisplayEnv mWholeExpr overallTy isStruct unsortedIds
+        let unsortedFieldIds = unsortedFieldIdsAndSynExprsGiven |> List.map fst |> List.toArray
+        let anonInfo, sortedFieldTys = UnifyAnonRecdTypeAndInferCharacteristics env.eContextInfo cenv env.DisplayEnv mWholeExpr overallTy isStruct unsortedFieldIds
 
         // Sort into canonical order
-        let sortedIndexedArgs = unsortedArgs |> List.indexed |> List.sortBy (fun (i,_) -> unsortedIds.[i].idText) 
+        let sortedIndexedArgs =
+            unsortedFieldIdsAndSynExprsGiven
+            |> List.indexed
+            |> List.sortBy (fun (i,_) -> unsortedFieldIds.[i].idText) 
+
+        // Map from sorted indexes to unsorted indexes
         let sigma = List.map fst sortedIndexedArgs |> List.toArray
-        let sortedArgs = List.map snd sortedIndexedArgs
-        sortedArgs |> List.iteri (fun j (x, _) -> 
-            let item = Item.AnonRecdField(anonInfo, sortedArgTys, j, x.idRange)
+        let sortedFieldExprs = List.map snd sortedIndexedArgs
+
+        sortedFieldExprs |> List.iteri (fun j (x, _) -> 
+            let item = Item.AnonRecdField(anonInfo, sortedFieldTys, j, x.idRange)
             CallNameResolutionSink cenv.tcSink (x.idRange, env.NameEnv, item, item, emptyTyparInst, ItemOccurence.Use, env.DisplayEnv, env.eAccessRights))
-        let unsortedArgTys = sortedArgTys |> List.indexed |> List.sortBy (fun (j, _) -> sigma.[j]) |> List.map snd
-        let flexes = unsortedArgTys |> List.map (fun _ -> true)
-        let unsortedCheckedArgs, tpenv = TcExprs cenv env mWholeExpr tpenv flexes unsortedArgTys (List.map snd unsortedArgs)
-        let sortedCheckedArgs = unsortedCheckedArgs |> List.indexed |> List.sortBy (fun (i,_) -> unsortedIds.[i].idText) |> List.map snd
 
-        mkAnonRecd cenv.g mWholeExpr anonInfo sortedCheckedArgs sortedArgTys, tpenv
+        let unsortedFieldTys =
+            sortedFieldTys
+            |> List.indexed
+            |> List.sortBy (fun (sortedIdx, _) -> sigma.[sortedIdx])
+            |> List.map snd
+
+        let flexes = unsortedFieldTys |> List.map (fun _ -> true)
+
+        let unsortedCheckedArgs, tpenv = TcExprs cenv env mWholeExpr tpenv flexes unsortedFieldTys unsortedFieldSynExprsGiven
+
+        mkAnonRecd cenv.g mWholeExpr anonInfo unsortedFieldIds unsortedCheckedArgs unsortedFieldTys, tpenv
 
     | Some (origExpr, _) -> 
         // The fairly complex case '{| origExpr with X = 1; Y = 2 |}'
@@ -7088,7 +7101,7 @@ and TcAnonRecdExpr cenv overallTy env tpenv (isStruct, optOrigExpr, unsortedArgs
         ///   - Choice1Of2 for a new binding
         ///   - Choice2Of2 for a binding coming from the original expression
         let unsortedIdAndExprsAll = 
-            [| for (id, e) in unsortedArgs do
+            [| for (id, e) in unsortedFieldIdsAndSynExprsGiven do
                     yield (id, Choice1Of2 e)
                match tryDestAnonRecdTy cenv.g origExprTy with
                | ValueSome (anonInfo, tinst) -> 
@@ -7104,32 +7117,61 @@ and TcAnonRecdExpr cenv overallTy env tpenv (isStruct, optOrigExpr, unsortedArgs
                         error (Error (FSComp.SR.tcCopyAndUpdateNeedsRecordType(), mOrigExpr)) |]
             |> Array.distinctBy (fst >> textOfId)
 
-        let unsortedIdsAll = Array.map fst unsortedIdAndExprsAll
-        let anonInfo, sortedArgTysAll = UnifyAnonRecdTypeAndInferCharacteristics env.eContextInfo cenv env.DisplayEnv mWholeExpr overallTy isStruct unsortedIdsAll
-        let sortedIndexedArgsAll = unsortedIdAndExprsAll |> Array.indexed |> Array.sortBy (snd >> fst >> textOfId) 
-        let sigma = Array.map fst sortedIndexedArgsAll // map from sorted indexes to unsorted indexes
-        let sortedArgsAll = Array.map snd sortedIndexedArgsAll
-        sortedArgsAll |> Array.iteri (fun j (x, expr) -> 
+        let unsortedFieldIdsAll = Array.map fst unsortedIdAndExprsAll
+
+        let anonInfo, sortedFieldTysAll = UnifyAnonRecdTypeAndInferCharacteristics env.eContextInfo cenv env.DisplayEnv mWholeExpr overallTy isStruct unsortedFieldIdsAll
+
+        let sortedIndexedFieldsAll = unsortedIdAndExprsAll |> Array.indexed |> Array.sortBy (snd >> fst >> textOfId) 
+
+        // map from sorted indexes to unsorted indexes
+        let sigma = Array.map fst sortedIndexedFieldsAll
+
+        let sortedFieldsAll = Array.map snd sortedIndexedFieldsAll
+
+        // Report _all_ identifiers to name resolution. We should likely just report the ones
+        // that are explicit in source code.
+        sortedFieldsAll |> Array.iteri (fun j (x, expr) -> 
             match expr with 
             | Choice1Of2 _ -> 
-                let item = Item.AnonRecdField(anonInfo, sortedArgTysAll, j, x.idRange)
+                let item = Item.AnonRecdField(anonInfo, sortedFieldTysAll, j, x.idRange)
                 CallNameResolutionSink cenv.tcSink (x.idRange, env.NameEnv, item, item, emptyTyparInst, ItemOccurence.Use, env.DisplayEnv, env.eAccessRights)
             | Choice2Of2 _ -> ())
 
-        let unsortedArgTysNew = sortedArgTysAll |> List.indexed |> List.sortBy (fun (j, _) -> sigma.[j]) |> List.take unsortedArgs.Length |> List.map snd
-        let flexes = unsortedArgTysNew |> List.map (fun _ -> true)
+        let unsortedFieldTysAll =
+            sortedFieldTysAll
+            |> List.indexed
+            |> List.sortBy (fun (sortedIdx, _) -> sigma.[sortedIdx])
+            |> List.map snd
+
+        let unsortedFieldTysGiven =
+            unsortedFieldTysAll
+            |> List.take unsortedFieldIdsAndSynExprsGiven.Length
+
+        let flexes = unsortedFieldTysGiven |> List.map (fun _ -> true)
 
-        let unsortedCheckedArgsNew, tpenv = TcExprs cenv env mWholeExpr tpenv flexes unsortedArgTysNew (List.map snd unsortedArgs)
-        let sortedArgTysAllArray = Array.ofList sortedArgTysAll
-        let unsortedCheckedArgsNewArray = unsortedCheckedArgsNew |> List.toArray
-        let sortedCheckedArgsAll = 
-            sortedArgsAll |> Array.mapi (fun j (_, expr) -> 
+        // Check the expressions in unsorted order
+        let unsortedFieldExprsGiven, tpenv =
+            TcExprs cenv env mWholeExpr tpenv flexes unsortedFieldTysGiven unsortedFieldSynExprsGiven
+
+        let unsortedFieldExprsGiven = unsortedFieldExprsGiven |> List.toArray
+
+        let unsortedFieldIds =
+            unsortedIdAndExprsAll
+            |> Array.map fst
+
+        let unsortedFieldExprs = 
+            unsortedIdAndExprsAll
+            |> Array.mapi (fun unsortedIdx (_, expr) -> 
                 match expr with 
-                | Choice1Of2 _ -> unsortedCheckedArgsNewArray.[sigma.[j]]
-                | Choice2Of2 subExpr -> UnifyTypes cenv env mOrigExpr (tyOfExpr cenv.g subExpr) sortedArgTysAllArray.[j]; subExpr) 
+                | Choice1Of2 _ -> unsortedFieldExprsGiven.[unsortedIdx]
+                | Choice2Of2 subExpr -> UnifyTypes cenv env mOrigExpr (tyOfExpr cenv.g subExpr) unsortedFieldTysAll.[unsortedIdx]; subExpr)
+            |> List.ofArray
 
-        let expr = mkAnonRecd cenv.g mWholeExpr anonInfo (List.ofArray sortedCheckedArgsAll) sortedArgTysAll
+        // Permute the expressions to sorted order in the TAST
+        let expr = mkAnonRecd cenv.g mWholeExpr anonInfo unsortedFieldIds unsortedFieldExprs unsortedFieldTysAll
         let expr = wrap expr
+
+        // Bind the original expression
         let expr = mkCompGenLet mOrigExpr oldv origExprChecked expr
         expr, tpenv
 

diff --git a/tests/fsharp/core/anon/lib.fs b/tests/fsharp/core/anon/lib.fs
@@ -17,7 +17,7 @@ let test (s : string) b =
 let check (s:string) x1 x2 = 
     stderr.Write(s)
     if (x1 = x2) then stderr.WriteLine " OK"
-    else (stderr.WriteLine (sprintf "fail, expected %A, got %A" x2 x1); report_failure (s))
+    else (stderr.WriteLine (sprintf " failed, expected %A, got %A" x2 x1); report_failure (s))
 
 let inline getX (x: ^TX) : ^X = 
         (^TX : (member get_X : unit -> ^X) (x))
@@ -205,13 +205,56 @@ module QuotesNewRecord2 =
 
     open FSharp.Quotations
     open FSharp.Quotations.Patterns
-    let ty, args = match <@ {| Y = "two"; X = 1 |} @> with NewRecord(a,b) -> a,b
+    let yarg,ty, args = match <@ {| Y = "two"; X = 1 |} @> with Let(_,yarg,NewRecord(a,b)) -> yarg,a,b
 
     check "qgceoijew90ewcw1"  (FSharp.Reflection.FSharpType.IsRecord(ty)) true
     check "qgceoijew90ewcw2"  (FSharp.Reflection.FSharpType.GetRecordFields(ty).Length) 2
     // Fields are sorted
     check "qgceoijew90ewcw2"  ([ for p in FSharp.Reflection.FSharpType.GetRecordFields(ty) -> p.Name ]) [ "X"; "Y" ]
-    check "qgceoijew90ewcw3"  args [ <@@ 1 @@>; <@@ "two" @@> ] 
+    check "qgceoijew90ewcw3"  args.[0] <@@ 1 @@> 
+    check "qgceoijew90ewcw4"  yarg <@@ "two" @@> 
+
+module QuotesFieldInitOrder = 
+
+    let mutable x = 1
+    let test() = 
+        x <- 1
+        {| X = (check "clwknckl1" x 1; x <- x + 1; 3)
+           Y = (check "cwkencelwe2" x 2; x <- x + 1; 2) 
+        |} |> check "ceweoiwe1" {| Y=2; X=3 |}
+        x <- 1
+        {| X = (check "clwknckl3" x 1; x <- x + 1; 2)
+           W = (check "cwkencelwe4" x 2; x <- x + 1; 3) 
+        |} |> check "ceweoiwe2" {| W=3; X=2 |}
+        x <- 1
+        {| X = (check "clwknckl5" x 1; x <- x + 1; 2)
+           Y = (check "clwknckl6" x 2; x <- x + 1; 3)
+           W = (check "cwkencelwe7" x 3; x <- x + 1; 4) |} 
+          |> check "ceweoiwe" {| Y=3; X=2; W=4 |}
+        x <- 1
+        let a = 
+            {| Y = (check "clwknckl8" x 1; x <- x + 1; 2)
+               X = (check "clwknckl9" x 2; x <- x + 1; 3)
+               W = (check "cwkencel10" x 3; x <- x + 1; 4) 
+            |} 
+        a |> check "ceweoiwe" {| Y=2; X=3; W=4 |}
+        x <- 1
+        let b = 
+            {| a with 
+                 X = (check "clwknckl9" x 1; x <- x + 1; 6)
+                 W = (check "cwkencel10" x 2; x <- x + 1; 7) 
+            |} 
+        b |> check "ceweoiwe87" {| Y=2; X=6; W=7 |}
+        x <- 1
+        let c = 
+            {| a with 
+                 X = (check "clwknckl9" x 1; x <- x + 1; 6)
+                 A = (check "cwkencel11" x 2; x <- x + 1; 8) 
+                 W = (check "cwkencel10" x 3; x <- x + 1; 7) 
+            |} 
+        c |> check "ceweoiwe87" {| Y=2; X=6; W=7; A=8 |}
+    test()
+
 
 module QuotesPropertyGet =