diff --git a/src/fsharp/TastOps.fs b/src/fsharp/TastOps.fs index 6e05af04b66..4743ff03dfc 100644 --- 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 index bf944a4f597..f9011081bbf 100755 --- 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 index 5da1e9325a2..d5eb78f5284 100644 --- 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 index abeb7711ab9..9fc219e1cb1 100644 --- 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 =