From f746733f8c4fa43b9246dd524c4f478177e5e243 Mon Sep 17 00:00:00 2001 From: kerams Date: Sat, 25 Feb 2023 16:17:28 +0100 Subject: [PATCH 01/32] Nested record copy and update --- src/Compiler/Checking/CheckExpressions.fs | 95 ++++++++++++++++++- src/Compiler/Checking/NameResolution.fs | 110 ++++++++++++++++++++++ src/Compiler/Checking/NameResolution.fsi | 10 ++ 3 files changed, 213 insertions(+), 2 deletions(-) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 19d8f2cbaaa..16c0eb87d9e 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -7295,6 +7295,94 @@ and TcRecdExpr cenv (overallTy: TType) env tpenv (inherits, withExprOpt, synRecd let g = cenv.g + let transformAstForNestedUpdates (lid: LongIdent) v = + let recdExprCopyInfo ids withExprOpt (id: Ident) = + let upToId origSepRng id lidwd = + let rec buildLid res (id: Ident) = + function + | [] -> res + | (h: Ident) :: t -> if h.idText = id.idText then h :: res else buildLid (h :: res) id t + + let rec combineIds = + function + | [] | [_] -> [] + | id1::id2::rest -> (id1, id2) :: (id2 :: rest |> combineIds) + + let calcLidSeparatorRanges lid = + match lid with + | [] | [_] -> [origSepRng] + | _ :: t -> origSepRng :: List.map (fun (s : Ident, e : Ident) -> mkRange s.idRange.FileName s.idRange.End e.idRange.Start) t + + let lid = buildLid [] id lidwd |> List.rev + + (lid, lid |> combineIds |> calcLidSeparatorRanges) + + let totalRange (origId : Ident) (id : Ident) = + mkRange origId.idRange.FileName origId.idRange.End id.idRange.Start + + let rangeOfBlockSeperator (id : Ident) = + let idEnd = id.idRange.End + let blockSeperatorStartCol = idEnd.Column + let blockSeperatorEndCol = blockSeperatorStartCol + 4 + let blockSeperatorStartPos = mkPos idEnd.Line blockSeperatorStartCol + let blockSeporatorEndPos = mkPos idEnd.Line blockSeperatorEndCol + + mkRange id.idRange.FileName blockSeperatorStartPos blockSeporatorEndPos + + match withExprOpt with + | Some (SynExpr.Ident origId, (sepRange, _)) -> + let lid, rng = upToId sepRange id (origId :: ids) + Some (SynExpr.LongIdent (false, LongIdentWithDots(lid, rng), None, totalRange origId id), (rangeOfBlockSeperator id, None)) // TODO: id.idRange should be the range of the next separator + | _ -> None + + let rec synExprRecd copyInfo id flds = + SynExpr.Record( + None, + copyInfo id, + [ match flds with + | [] -> yield SynExprRecordField((LongIdentWithDots ([], []), true), None, v, None) + | [ fldId ] -> yield SynExprRecordField((LongIdentWithDots ([ fldId ], []), true), None, v, None) + | fldId :: rest -> + let nestedFld = synExprRecd copyInfo fldId + yield SynExprRecordField((LongIdentWithDots ([ fldId ], []), true), None, nestedFld rest, None) ], + id.idRange) + |> Some + + let access, flds = lid |> ResolveNestedField cenv.tcSink cenv.nameResolver env.eNameResEnv env.eAccessRights overallTy + + let expanded = + [ + match (access, flds) with + | [], [] -> () + | accessIds, [] -> yield (accessIds |> List.frontAndBack), v + | accessIds, [ fldId ] -> yield ((accessIds @ [ fldId ]) |> List.frontAndBack), v + | accessIds, fldId :: rest -> + yield (accessIds, fldId), synExprRecd (recdExprCopyInfo flds withExprOpt) fldId rest + ] + + expanded + + let groupUpdatesToNestedFields flds = + let groupedByField = flds |> List.groupBy (fun ((_, fld : Ident), _) -> fld.idText) + [ + for (_, flds) in groupedByField do + if (flds |> List.length < 2) then + yield! flds + else + let rec groupIfNested res xs = + match xs with + | [] -> res + | x::[] -> x :: res + | x::y::ys -> match x, y with + | (lidwid, Some(SynExpr.Record (aBI, aCI, aFlds, aRng))), (_, Some(SynExpr.Record (_, _, bFlds, _))) -> + let combinedFlds = aFlds @ bFlds + let reducedRecd = (lidwid, Some(SynExpr.Record (aBI, aCI, combinedFlds, aRng))) + groupIfNested (reducedRecd :: res) ys + | _ -> groupIfNested (x :: res) (y :: ys) + + yield! flds |> groupIfNested [] + ] + let requiresCtor = (GetCtorShapeCounter env = 1) // Get special expression forms for constructors let haveCtor = Option.isSome inherits @@ -7320,8 +7408,11 @@ and TcRecdExpr cenv (overallTy: TType) env tpenv (inherits, withExprOpt, synRecd // we assume that parse errors were already reported raise (ReportedError None) - yield (List.frontAndBack synLongId.LongIdent, v) - ] + match synLongId.LongIdent with + | [] -> () + | [id] -> yield (([], id), v) + | _ -> yield! transformAstForNestedUpdates synLongId.LongIdent v + ] |> groupUpdatesToNestedFields match flds with | [] -> [] diff --git a/src/Compiler/Checking/NameResolution.fs b/src/Compiler/Checking/NameResolution.fs index 414d102b691..5f85be70508 100644 --- a/src/Compiler/Checking/NameResolution.fs +++ b/src/Compiler/Checking/NameResolution.fs @@ -3692,6 +3692,116 @@ let ResolveField sink ncenv nenv ad ty mp id allFields = ResolutionInfo.SendEntityPathToSink(sink, ncenv, nenv, ItemOccurence.UseInType, ad, resInfo, checker) rfref) +/// Resolve a long identifier representing a nested record field +let ResolveNestedField sink (ncenv: NameResolver) nenv ad ty lid = + let typeNameResInfo = TypeNameResolutionInfo.Default + let g = ncenv.g + + let lookupFld ty (id: Ident) = + let m = id.idRange + let otherRecdFlds ty = + let typeName = NicePrint.minimalStringOfType nenv.eDisplayEnv ty + [ + for KeyValue (_, v) in nenv.eFieldLabels do + match v |> List.tryFind (fun r -> r.TyconRef.DisplayName = typeName) with + | Some rfref -> yield rfref.RecdField.Id + | None -> () + ] + + let lookup() = + let frefs = + match (Map.tryFind id.idText nenv.eFieldLabels) with + | Some field -> success field + | None -> raze (SuggestLabelsOfRelatedRecords g nenv id (otherRecdFlds ty)) + + // Eliminate duplicates arising from multiple 'open' + frefs + |?> ListSet.setify (fun fref1 fref2 -> tyconRefEq g fref1.TyconRef fref2.TyconRef) + |?> List.map (fun rfref -> FieldResolution(FreshenRecdFieldRef ncenv m rfref, false)) + + if isAppTy g ty then + match ncenv.InfoReader.TryFindRecdOrClassFieldInfoOfType(id.idText,m,ty) with + | ValueSome (RecdFieldInfo (_, rfref)) -> success [ FieldResolution(FreshenRecdFieldRef ncenv m rfref, false) ] + | _ -> + if isRecdTy g ty then + // record label doesn't belong to record type -> suggest other labels of same record + let suggestLabels addToBuffer = + for label in SuggestOtherLabelsOfSameRecordType g nenv ty id (otherRecdFlds ty) do + addToBuffer label + + let typeName = NicePrint.minimalStringOfType nenv.eDisplayEnv ty + let errorText = FSComp.SR.nrRecordDoesNotContainSuchLabel(typeName,id.idText) + raze (ErrorWithSuggestions(errorText, m, id.idText, suggestLabels)) + else + lookup() + else + lookup() + + let access, flds = + match lid with + | [] -> [], [] + | [ id ] -> [], lookupFld ty id |> ForceRaise + | id :: _ -> + let fldSearch () = + match lid with + | id :: rest -> + lookupFld ty id + |?> List.map (fun (FieldResolution (rfinfo, dep)) -> + let ref = rfinfo.RecdFieldRef + FieldResolution(rfinfo, dep), ref.FieldName, ref.RecdField.FormalType, rest) + | _ -> NoResultsOrUsefulErrors + + let tyconSearch ad () = + match lid with + | tn :: id :: rest -> + let m = tn.idRange + let tcrefs = LookupTypeNameInEnvNoArity OpenQualified tn.idText nenv + if isNil tcrefs then NoResultsOrUsefulErrors else + let tcrefs = tcrefs |> List.map (fun tcref -> (ResolutionInfo.Empty,tcref)) + + ResolveLongIdentInTyconRefs ResultCollectionSettings.AllResults ncenv nenv LookupKind.RecdField 1 m ad id rest typeNameResInfo tn.idRange tcrefs + |?> List.choose (fun x -> + match x with + | _, Item.RecdField (RecdFieldInfo (_, rfref)), rest ->Some(FieldResolution(FreshenRecdFieldRef ncenv m rfref, false), rfref.FieldName, rfref.RecdField.FormalType, rest) + | _ -> None) + | _ -> NoResultsOrUsefulErrors + + let moduleOrNsSearch ad () = + match lid with + | [] -> NoResultsOrUsefulErrors + | id :: rest -> + let m = id.idRange + + ResolveLongIdentAsModuleOrNamespaceThen sink ResultCollectionSettings.AtMostOneResult ncenv.amap m OpenQualified nenv ad id rest false (ResolveFieldInModuleOrNamespace ncenv nenv ad) + |?> List.map (fun (_, FieldResolution(rfinfo, dep), rest) -> + let ref = rfinfo.RecdFieldRef + FieldResolution(rfinfo, dep), ref.FieldName, ref.RecdField.FormalType, rest) + + let item, fldIdText, fldTy, rest = + fldSearch () +++ moduleOrNsSearch ad +++ tyconSearch ad +++ moduleOrNsSearch AccessibleFromSomeFSharpCode +++ tyconSearch AccessibleFromSomeFSharpCode + |> AtMostOneResult id.idRange + |> ForceRaise + + let idsBeforeField = lid |> List.takeWhile (fun id -> id.idText <> fldIdText) + + match rest with + | [] -> idsBeforeField, [ item ] + | _ -> + let rec nestedFieldSearch flds ty = + function + | [] -> flds + | id :: rest -> + let resolved = lookupFld ty id |> ForceRaise + let fldTy = + match resolved with + | [ FieldResolution (rfinfo, _) ] -> rfinfo.RecdField.FormalType + | _ -> ty + nestedFieldSearch (flds @ resolved) fldTy rest + + idsBeforeField, item :: (nestedFieldSearch [] fldTy rest) + + access, flds |> List.map (fun (FieldResolution (rfinfo, _)) -> lid |> List.find (fun id -> id.idText = rfinfo.RecdFieldRef.FieldName)) + /// Resolve F#/IL "." syntax in expressions (2). /// /// We have an expr. on the left, and we do an access, e.g. diff --git a/src/Compiler/Checking/NameResolution.fsi b/src/Compiler/Checking/NameResolution.fsi index 6a67054786e..58cce657cab 100755 --- a/src/Compiler/Checking/NameResolution.fsi +++ b/src/Compiler/Checking/NameResolution.fsi @@ -742,6 +742,16 @@ val internal ResolveField: allFields: Ident list -> FieldResolution list +/// Resolve a long identifier to a nested field +val internal ResolveNestedField: + sink: TcResultsSink -> + ncenv: NameResolver -> + nenv: NameResolutionEnv -> + ad: AccessorDomain -> + ty: TType -> + lid: Ident list -> + Ident list * Ident list + /// Resolve a long identifier occurring in an expression position val internal ResolveExprLongIdent: sink: TcResultsSink -> From c3b5c0b984a3d00b23438e037e50b271f8e39308 Mon Sep 17 00:00:00 2001 From: kerams Date: Sun, 26 Feb 2023 13:43:18 +0100 Subject: [PATCH 02/32] Add completions support --- src/Compiler/Checking/CheckExpressions.fs | 4 +- src/Compiler/Checking/NameResolution.fs | 8 +-- src/Compiler/Service/FSharpCheckerResults.fs | 58 +++++++++------- .../CompletionProviderTests.fs | 66 +++++++++++++++++++ 4 files changed, 106 insertions(+), 30 deletions(-) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 16c0eb87d9e..163b6a66ff0 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -7317,10 +7317,10 @@ and TcRecdExpr cenv (overallTy: TType) env tpenv (inherits, withExprOpt, synRecd (lid, lid |> combineIds |> calcLidSeparatorRanges) - let totalRange (origId : Ident) (id : Ident) = + let totalRange (origId: Ident) (id: Ident) = mkRange origId.idRange.FileName origId.idRange.End id.idRange.Start - let rangeOfBlockSeperator (id : Ident) = + let rangeOfBlockSeperator (id: Ident) = let idEnd = id.idRange.End let blockSeperatorStartCol = idEnd.Column let blockSeperatorEndCol = blockSeperatorStartCol + 4 diff --git a/src/Compiler/Checking/NameResolution.fs b/src/Compiler/Checking/NameResolution.fs index 5f85be70508..be0b9d40c69 100644 --- a/src/Compiler/Checking/NameResolution.fs +++ b/src/Compiler/Checking/NameResolution.fs @@ -3757,7 +3757,7 @@ let ResolveNestedField sink (ncenv: NameResolver) nenv ad ty lid = let m = tn.idRange let tcrefs = LookupTypeNameInEnvNoArity OpenQualified tn.idText nenv if isNil tcrefs then NoResultsOrUsefulErrors else - let tcrefs = tcrefs |> List.map (fun tcref -> (ResolutionInfo.Empty,tcref)) + let tcrefs = tcrefs |> List.map (fun tcref -> (ResolutionInfo.Empty, tcref)) ResolveLongIdentInTyconRefs ResultCollectionSettings.AllResults ncenv nenv LookupKind.RecdField 1 m ad id rest typeNameResInfo tn.idRange tcrefs |?> List.choose (fun x -> @@ -4809,11 +4809,7 @@ let ResolveCompletionsInTypeForItem (ncenv: NameResolver) nenv m ad statics ty ( let amap = ncenv.amap match item with - | Item.RecdField _ -> - yield! - ncenv.InfoReader.GetRecordOrClassFieldsOfType(None, ad, m, ty) - |> List.filter (fun rfref -> rfref.IsStatic = statics && IsFieldInfoAccessible ad rfref) - |> List.map Item.RecdField + | Item.RecdField _ -> yield! ResolveRecordOrClassFieldsOfType ncenv m ad ty statics | Item.UnionCase _ -> if statics then match tryAppTy g ty with diff --git a/src/Compiler/Service/FSharpCheckerResults.fs b/src/Compiler/Service/FSharpCheckerResults.fs index 90936cb457e..a8211e19e3f 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fs +++ b/src/Compiler/Service/FSharpCheckerResults.fs @@ -643,24 +643,37 @@ type internal TypeCheckInfo let thereWereSomeQuals = not (Array.isEmpty quals) thereWereSomeQuals, quals - /// obtains captured typing for the given position - /// if type of captured typing is record - returns list of record fields - let GetRecdFieldsForExpr (r: range) = - let _, quals = GetExprTypingForPosition(r.End) - - let bestQual = - match quals with - | [||] -> None - | quals -> - quals - |> Array.tryFind (fun (_, _, _, rq) -> - ignore (r) // for breakpoint - posEq r.Start rq.Start) - - match bestQual with - | Some (ty, nenv, ad, m) when isRecdTy nenv.DisplayEnv.g ty -> - let items = ResolveRecordOrClassFieldsOfType ncenv m ad ty false - Some(items, nenv.DisplayEnv, m) + /// Returns the list of available record fields, taking into account to potential nesting + let GetRecdFieldsForCopyAndUpdateExpr (identRange: range, plid: string list) = + let _, quals = GetExprTypingForPosition(identRange.End) + + let rec dive (ty, nenv: NameResolutionEnv, ad, m) plid isPastTypePrefix wasPathEmpty = + if isRecdTy nenv.DisplayEnv.g ty then + let fields = + ncenv.InfoReader.GetRecordOrClassFieldsOfType(None, ad, m, ty) + |> List.filter (fun rfref -> not rfref.IsStatic && IsFieldInfoAccessible ad rfref) + + match plid with + | [] -> + if wasPathEmpty || isPastTypePrefix then + Some(fields |> List.map Item.RecdField, nenv.DisplayEnv, m) + else + None + | id :: rest -> + match fields |> List.tryFind (fun f -> f.LogicalName = id) with + | Some f -> dive (f.RecdField.FormalType, nenv, ad, m) rest true wasPathEmpty + | _ -> + // Field name can be optionally qualified + // If we haven't matched a field name yet, keep peeling off the prefix + if isPastTypePrefix then + Some([], nenv.DisplayEnv, m) + else + dive (ty, nenv, ad, m) rest false wasPathEmpty + else + Some([], nenv.DisplayEnv, m) + + match quals |> Array.tryFind (fun (_, _, _, rq) -> posEq identRange.Start rq.Start) with + | Some qual -> dive qual plid false plid.IsEmpty | _ -> None /// Looks at the exact expression types at the position to the left of the @@ -1247,8 +1260,8 @@ type internal TypeCheckInfo GetEnvironmentLookupResolutionsIncludingRecordFieldsAtPosition cursorPos [] envItems // Completion at ' { XXX = ... with ... } " - | Some (CompletionContext.RecordField (RecordContext.CopyOnUpdate (r, (plid, _)))) -> - match GetRecdFieldsForExpr(r) with + | Some (CompletionContext.RecordField (RecordContext.CopyOnUpdate (identRange, (plid, _)))) -> + match GetRecdFieldsForCopyAndUpdateExpr(identRange, plid) with | None -> Some(GetClassOrRecordFieldsEnvironmentLookupResolutions(mkPos line loc, plid, false)) |> Option.map toCompletionItems @@ -1256,8 +1269,9 @@ type internal TypeCheckInfo // Completion at ' { XXX = ... with ... } " | Some (CompletionContext.RecordField (RecordContext.Constructor (typeName))) -> - Some(GetClassOrRecordFieldsEnvironmentLookupResolutions(mkPos line loc, [ typeName ], false)) - |> Option.map toCompletionItems + GetClassOrRecordFieldsEnvironmentLookupResolutions(mkPos line loc, [ typeName ], false) + |> toCompletionItems + |> Some // No completion at '...: string' | Some (CompletionContext.RecordField (RecordContext.Declaration true)) -> None diff --git a/vsintegration/tests/FSharp.Editor.Tests/CompletionProviderTests.fs b/vsintegration/tests/FSharp.Editor.Tests/CompletionProviderTests.fs index 11c7efbe0ac..029b393a3a2 100644 --- a/vsintegration/tests/FSharp.Editor.Tests/CompletionProviderTests.fs +++ b/vsintegration/tests/FSharp.Editor.Tests/CompletionProviderTests.fs @@ -1314,3 +1314,69 @@ type A = // Attribute on enum case - All settable properties available VerifyCompletionList(fileContents, "| [] + let ``Completion list for nested copy and update contains correct record fields, nominal`` () = + let fileContents = + """ +type AnotherNestedRecTy = { A: int } + +type NestdRecTy = { B: string; C: AnotherNestedRecTy } + +module F = + type RecTy = { D: NestdRecTy; E: string option } + +open F + +let t1 = { D = { B = "t1"; C = { A = 1; } }; E = None; } + +let t2 = { t1 with D.B = "12" } + +let t3 = { t2 with F.RecTy.d } + +let t4 = { t2 with F.RecTy.D. } + +let t5 = { t2 with F.RecTy.D.C. } + +let t6 = { t2 with E. } + +let t7 = { t2 with D.B. } + +let t8 = { t2 with F. } + +let t9 = { t2 with d } + +let t10 x = { x with d } + +let t11 = { t2 with NestdRecTy.C. } + +let t12 x = { x with F.RecTy.d } + +let t13 x = { x with RecTy.D. } +""" + + VerifyCompletionListExactly(fileContents, "t1 with ", [ "D"; "E" ]) + VerifyCompletionListExactly(fileContents, "t1 with D.", [ "B"; "C" ]) + + VerifyCompletionListExactly(fileContents, "let t3 = { t2 with F.RecTy.d", [ "D"; "E" ]) + + VerifyCompletionListExactly(fileContents, "let t4 = { t2 with F.RecTy.D.", [ "B"; "C" ]) + + VerifyCompletionListExactly(fileContents, "let t5 = { t2 with F.RecTy.D.C.", [ "A" ]) + + VerifyNoCompletionList(fileContents, "let t6 = { t2 with E.") + + VerifyNoCompletionList(fileContents, "let t7 = { t2 with D.B.") + + VerifyCompletionListExactly(fileContents, "let t8 = { t2 with F.", [ "D"; "E"; "RecTy" ]) + + VerifyCompletionListExactly(fileContents, "let t9 = { t2 with d", [ "D"; "E" ]) + + // The type of `x` is not known, so show fields of records in scope + VerifyCompletionList(fileContents, "let t10 x = { x with d", [ "A"; "B"; "C"; "D"; "E" ], []) + + VerifyNoCompletionList(fileContents, "let t11 = { t2 with NestdRecTy.C.") + + VerifyCompletionListExactly(fileContents, "let t12 x = { x with F.RecTy.d", [ "D"; "E" ]) + + VerifyCompletionListExactly(fileContents, "let t13 x = { x with RecTy.D.", [ "B"; "C" ]) From 76e1c4ea2b255bc1b938f8185d5f42bf712c4659 Mon Sep 17 00:00:00 2001 From: kerams Date: Mon, 27 Feb 2023 13:52:10 +0100 Subject: [PATCH 03/32] Add initial support for anonymous records --- src/Compiler/Checking/CheckExpressions.fs | 218 +++++++++++----------- src/Compiler/Checking/NameResolution.fs | 110 ++++++----- src/Compiler/Checking/NameResolution.fsi | 2 +- 3 files changed, 175 insertions(+), 155 deletions(-) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 163b6a66ff0..47f9ba06cc0 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -7291,128 +7291,124 @@ and TcAssertExpr cenv overallTy env (m: range) tpenv x = TcExpr cenv overallTy env tpenv callDiagnosticsExpr -and TcRecdExpr cenv (overallTy: TType) env tpenv (inherits, withExprOpt, synRecdFields, mWholeExpr) = - - let g = cenv.g - - let transformAstForNestedUpdates (lid: LongIdent) v = - let recdExprCopyInfo ids withExprOpt (id: Ident) = - let upToId origSepRng id lidwd = - let rec buildLid res (id: Ident) = - function - | [] -> res - | (h: Ident) :: t -> if h.idText = id.idText then h :: res else buildLid (h :: res) id t - - let rec combineIds = - function - | [] | [_] -> [] - | id1::id2::rest -> (id1, id2) :: (id2 :: rest |> combineIds) - - let calcLidSeparatorRanges lid = - match lid with - | [] | [_] -> [origSepRng] - | _ :: t -> origSepRng :: List.map (fun (s : Ident, e : Ident) -> mkRange s.idRange.FileName s.idRange.End e.idRange.Start) t - - let lid = buildLid [] id lidwd |> List.rev - - (lid, lid |> combineIds |> calcLidSeparatorRanges) - - let totalRange (origId: Ident) (id: Ident) = - mkRange origId.idRange.FileName origId.idRange.End id.idRange.Start - - let rangeOfBlockSeperator (id: Ident) = - let idEnd = id.idRange.End - let blockSeperatorStartCol = idEnd.Column - let blockSeperatorEndCol = blockSeperatorStartCol + 4 - let blockSeperatorStartPos = mkPos idEnd.Line blockSeperatorStartCol - let blockSeporatorEndPos = mkPos idEnd.Line blockSeperatorEndCol +and transformAstForNestedUpdates cenv env overallTy (lid: LongIdent) v withExprOpt = + let recdExprCopyInfo ids withExprOpt id = + let upToId origSepRng id lidwd = + let rec buildLid res (id: Ident) = + function + | [] -> res + | (h: Ident) :: t -> if h.idText = id.idText then h :: res else buildLid (h :: res) id t + + let rec combineIds = + function + | [] | [_] -> [] + | id1::id2::rest -> (id1, id2) :: (id2 :: rest |> combineIds) + + let calcLidSeparatorRanges lid = + match lid with + | [] | [_] -> [origSepRng] + | _ :: t -> origSepRng :: List.map (fun (s : Ident, e : Ident) -> mkRange s.idRange.FileName s.idRange.End e.idRange.Start) t + + let lid = buildLid [] id lidwd |> List.rev + + (lid, lid |> combineIds |> calcLidSeparatorRanges) + + let totalRange (origId: Ident) (id: Ident) = + mkRange origId.idRange.FileName origId.idRange.End id.idRange.Start + + let rangeOfBlockSeperator (id: Ident) = + let idEnd = id.idRange.End + let blockSeperatorStartCol = idEnd.Column + let blockSeperatorEndCol = blockSeperatorStartCol + 4 + let blockSeperatorStartPos = mkPos idEnd.Line blockSeperatorStartCol + let blockSeporatorEndPos = mkPos idEnd.Line blockSeperatorEndCol + + mkRange id.idRange.FileName blockSeperatorStartPos blockSeporatorEndPos + + match withExprOpt with + | Some (SynExpr.Ident origId, (sepRange, _)) -> + let lid, rng = upToId sepRange id (origId :: ids) + Some (SynExpr.LongIdent (false, LongIdentWithDots(lid, rng), None, totalRange origId id), (rangeOfBlockSeperator id, None)) // TODO: id.idRange should be the range of the next separator + | _ -> None - mkRange id.idRange.FileName blockSeperatorStartPos blockSeporatorEndPos + let rec synExprRecd copyInfo (id: Ident) fields v = + match fields with + | [] -> failwith "unreachable" + | (fldId, isAnon) :: rest -> + // todo the unit + let nestedField = if rest.IsEmpty then Option.defaultValue (mkSynUnit range0) v else synExprRecd copyInfo fldId rest v - match withExprOpt with - | Some (SynExpr.Ident origId, (sepRange, _)) -> - let lid, rng = upToId sepRange id (origId :: ids) - Some (SynExpr.LongIdent (false, LongIdentWithDots(lid, rng), None, totalRange origId id), (rangeOfBlockSeperator id, None)) // TODO: id.idRange should be the range of the next separator - | _ -> None + if isAnon then + // The correct structness will later be taken from the anynymous type, which already exists + SynExpr.AnonRecd(false, copyInfo id, [ (fldId, None, nestedField) ], id.idRange, { OpeningBraceRange = range0 }) + else + SynExpr.Record(None, copyInfo id, [ SynExprRecordField((LongIdentWithDots ([ fldId ], []), true), None, Some nestedField, None) ], id.idRange) + + let access, flds = ResolveNestedField cenv.tcSink cenv.nameResolver env.eNameResEnv env.eAccessRights overallTy lid + + match access, flds with + | [], [] -> None + | accessIds, [] -> Some (List.frontAndBack accessIds, v) + | accessIds, [ (fldId, _) ] -> Some (List.frontAndBack (accessIds @ [ fldId ]), v) + | accessIds, (fldId, _) :: rest -> + Some ((accessIds, fldId), Some (synExprRecd (recdExprCopyInfo (flds |> List.map fst) withExprOpt) fldId rest v)) + +and groupUpdatesToNestedFields (fields: ((Ident list * Ident) * SynExpr option) list) = + let rec groupIfNested res xs = + match xs with + | [] -> res + | x :: [] -> x :: res + | x :: y :: ys -> + match x, y with + | (lidwid, Some (SynExpr.Record (baseInfo, copyInfo, aFlds, m))), (_, Some (SynExpr.Record (recordFields = bFlds))) -> + let reducedRecd = (lidwid, Some(SynExpr.Record (baseInfo, copyInfo, aFlds @ bFlds, m))) + groupIfNested (reducedRecd :: res) ys + | (lidwid, Some (SynExpr.AnonRecd (isStruct, copyInfo, aFlds, m, trivia))), (_, Some (SynExpr.AnonRecd (recordFields = bFlds))) -> + let reducedRecd = (lidwid, Some(SynExpr.AnonRecd (isStruct, copyInfo, aFlds @ bFlds, m, trivia))) + groupIfNested (reducedRecd :: res) ys + | _ -> groupIfNested (x :: res) (y :: ys) + + fields + |> List.groupBy (fun ((_, field), _) -> field.idText) + |> List.collect (fun (_, fields) -> + if fields.Length < 2 then + fields + else + groupIfNested [] fields) - let rec synExprRecd copyInfo id flds = - SynExpr.Record( - None, - copyInfo id, - [ match flds with - | [] -> yield SynExprRecordField((LongIdentWithDots ([], []), true), None, v, None) - | [ fldId ] -> yield SynExprRecordField((LongIdentWithDots ([ fldId ], []), true), None, v, None) - | fldId :: rest -> - let nestedFld = synExprRecd copyInfo fldId - yield SynExprRecordField((LongIdentWithDots ([ fldId ], []), true), None, nestedFld rest, None) ], - id.idRange) - |> Some - - let access, flds = lid |> ResolveNestedField cenv.tcSink cenv.nameResolver env.eNameResEnv env.eAccessRights overallTy - - let expanded = - [ - match (access, flds) with - | [], [] -> () - | accessIds, [] -> yield (accessIds |> List.frontAndBack), v - | accessIds, [ fldId ] -> yield ((accessIds @ [ fldId ]) |> List.frontAndBack), v - | accessIds, fldId :: rest -> - yield (accessIds, fldId), synExprRecd (recdExprCopyInfo flds withExprOpt) fldId rest - ] - - expanded - - let groupUpdatesToNestedFields flds = - let groupedByField = flds |> List.groupBy (fun ((_, fld : Ident), _) -> fld.idText) - [ - for (_, flds) in groupedByField do - if (flds |> List.length < 2) then - yield! flds - else - let rec groupIfNested res xs = - match xs with - | [] -> res - | x::[] -> x :: res - | x::y::ys -> match x, y with - | (lidwid, Some(SynExpr.Record (aBI, aCI, aFlds, aRng))), (_, Some(SynExpr.Record (_, _, bFlds, _))) -> - let combinedFlds = aFlds @ bFlds - let reducedRecd = (lidwid, Some(SynExpr.Record (aBI, aCI, combinedFlds, aRng))) - groupIfNested (reducedRecd :: res) ys - | _ -> groupIfNested (x :: res) (y :: ys) - - yield! flds |> groupIfNested [] - ] +and TcRecdExpr cenv overallTy env tpenv (inherits, withExprOpt, synRecdFields, mWholeExpr) = + let g = cenv.g let requiresCtor = (GetCtorShapeCounter env = 1) // Get special expression forms for constructors let haveCtor = Option.isSome inherits - let withExprOpt, tpenv = - match withExprOpt with - | None -> None, tpenv - | Some (origExpr, _) -> - match inherits with - | Some (_, _, mInherits, _, _) -> error(Error(FSComp.SR.tcInvalidRecordConstruction(), mInherits)) - | None -> - let withExpr, tpenv = TcExpr cenv (MustEqual overallTy) env tpenv origExpr - Some withExpr, tpenv + let withExprOptChecked, tpenv = + match withExprOpt with + | None -> None, tpenv + | Some (origExpr, _) -> + match inherits with + | Some (_, _, mInherits, _, _) -> error(Error(FSComp.SR.tcInvalidRecordConstruction(), mInherits)) + | None -> + let withExpr, tpenv = TcExpr cenv (MustEqual overallTy) env tpenv origExpr + Some withExpr, tpenv - let hasOrigExpr = withExprOpt.IsSome + let hasOrigExpr = withExprOptChecked.IsSome let fldsList = let flds = - [ + synRecdFields + |> List.choose (fun (SynExprRecordField (fieldName = (synLongId, isOk); expr = v)) -> // if we met at least one field that is not syntactically correct - raise ReportedError to transfer control to the recovery routine - for SynExprRecordField(fieldName=(synLongId, isOk); expr=v) in synRecdFields do - if not isOk then - // raising ReportedError None transfers control to the closest errorRecovery point but do not make any records into log - // we assume that parse errors were already reported - raise (ReportedError None) - - match synLongId.LongIdent with - | [] -> () - | [id] -> yield (([], id), v) - | _ -> yield! transformAstForNestedUpdates synLongId.LongIdent v - ] |> groupUpdatesToNestedFields + if not isOk then + // raising ReportedError None transfers control to the closest errorRecovery point but do not make any records into log + // we assume that parse errors were already reported + raise (ReportedError None) + + match synLongId.LongIdent with + | [] -> None + | [ id ] -> Some (([], id), v) + | lid -> transformAstForNestedUpdates cenv env overallTy lid v withExprOpt) + |> groupUpdatesToNestedFields match flds with | [] -> [] @@ -7427,7 +7423,7 @@ and TcRecdExpr cenv (overallTy: TType) env tpenv (inherits, withExprOpt, synRecd | None -> () ] let withExprInfoOpt = - match withExprOpt with + match withExprOptChecked with | None -> None | Some withExpr -> let withExprAddrVal, withExprAddrValExpr = mkCompGenLocal mWholeExpr "inputRecord" (if isStructTy g overallTy then mkByrefTy g overallTy else overallTy) diff --git a/src/Compiler/Checking/NameResolution.fs b/src/Compiler/Checking/NameResolution.fs index be0b9d40c69..cd22917a2fb 100644 --- a/src/Compiler/Checking/NameResolution.fs +++ b/src/Compiler/Checking/NameResolution.fs @@ -3699,43 +3699,50 @@ let ResolveNestedField sink (ncenv: NameResolver) nenv ad ty lid = let lookupFld ty (id: Ident) = let m = id.idRange - let otherRecdFlds ty = - let typeName = NicePrint.minimalStringOfType nenv.eDisplayEnv ty - [ - for KeyValue (_, v) in nenv.eFieldLabels do - match v |> List.tryFind (fun r -> r.TyconRef.DisplayName = typeName) with - | Some rfref -> yield rfref.RecdField.Id - | None -> () - ] - let lookup() = - let frefs = - match (Map.tryFind id.idText nenv.eFieldLabels) with - | Some field -> success field - | None -> raze (SuggestLabelsOfRelatedRecords g nenv id (otherRecdFlds ty)) - - // Eliminate duplicates arising from multiple 'open' - frefs - |?> ListSet.setify (fun fref1 fref2 -> tyconRefEq g fref1.TyconRef fref2.TyconRef) - |?> List.map (fun rfref -> FieldResolution(FreshenRecdFieldRef ncenv m rfref, false)) - - if isAppTy g ty then - match ncenv.InfoReader.TryFindRecdOrClassFieldInfoOfType(id.idText,m,ty) with - | ValueSome (RecdFieldInfo (_, rfref)) -> success [ FieldResolution(FreshenRecdFieldRef ncenv m rfref, false) ] - | _ -> - if isRecdTy g ty then - // record label doesn't belong to record type -> suggest other labels of same record - let suggestLabels addToBuffer = - for label in SuggestOtherLabelsOfSameRecordType g nenv ty id (otherRecdFlds ty) do - addToBuffer label - - let typeName = NicePrint.minimalStringOfType nenv.eDisplayEnv ty - let errorText = FSComp.SR.nrRecordDoesNotContainSuchLabel(typeName,id.idText) - raze (ErrorWithSuggestions(errorText, m, id.idText, suggestLabels)) - else - lookup() - else - lookup() + match tryDestAnonRecdTy g ty with + | ValueSome (anonInfo, tys) -> + match anonInfo.SortedNames |> Array.tryFindIndex (fun x -> x = id.idText) with + | Some index -> Result [ Choice2Of2 (anonInfo, tys, index) ] + | _ -> NoResultsOrUsefulErrors + | _ -> + let otherRecdFlds ty = + let typeName = NicePrint.minimalStringOfType nenv.eDisplayEnv ty + [ + for KeyValue (_, v) in nenv.eFieldLabels do + match v |> List.tryFind (fun r -> r.TyconRef.DisplayName = typeName) with + | Some rfref -> yield rfref.RecdField.Id + | None -> () + ] + + let lookup() = + let frefs = + match (Map.tryFind id.idText nenv.eFieldLabels) with + | Some field -> success field + | None -> raze (SuggestLabelsOfRelatedRecords g nenv id (otherRecdFlds ty)) + + // Eliminate duplicates arising from multiple 'open' + frefs + |?> ListSet.setify (fun fref1 fref2 -> tyconRefEq g fref1.TyconRef fref2.TyconRef) + |?> List.map (fun rfref -> Choice1Of2(FieldResolution(FreshenRecdFieldRef ncenv m rfref, false))) + + if isAppTy g ty then + match ncenv.InfoReader.TryFindRecdOrClassFieldInfoOfType(id.idText, m, ty) with + | ValueSome (RecdFieldInfo (_, rfref)) -> success [ Choice1Of2(FieldResolution(FreshenRecdFieldRef ncenv m rfref, false)) ] + | _ -> + if isRecdTy g ty then + // record label doesn't belong to record type -> suggest other labels of same record + let suggestLabels addToBuffer = + for label in SuggestOtherLabelsOfSameRecordType g nenv ty id (otherRecdFlds ty) do + addToBuffer label + + let typeName = NicePrint.minimalStringOfType nenv.eDisplayEnv ty + let errorText = FSComp.SR.nrRecordDoesNotContainSuchLabel(typeName,id.idText) + raze (ErrorWithSuggestions(errorText, m, id.idText, suggestLabels)) + else + lookup() + else + lookup() let access, flds = match lid with @@ -3746,9 +3753,12 @@ let ResolveNestedField sink (ncenv: NameResolver) nenv ad ty lid = match lid with | id :: rest -> lookupFld ty id - |?> List.map (fun (FieldResolution (rfinfo, dep)) -> - let ref = rfinfo.RecdFieldRef - FieldResolution(rfinfo, dep), ref.FieldName, ref.RecdField.FormalType, rest) + |?> List.map (fun x -> + match x with + | Choice1Of2 (FieldResolution (rfinfo, dep)) -> + let ref = rfinfo.RecdFieldRef + Choice1Of2(FieldResolution(rfinfo, dep)), ref.FieldName, ref.RecdField.FormalType, rest + | Choice2Of2 (anonInfo, tys, index) -> Choice2Of2(anonInfo, tys, index), anonInfo.SortedNames[index], tys[index], rest) | _ -> NoResultsOrUsefulErrors let tyconSearch ad () = @@ -3762,7 +3772,10 @@ let ResolveNestedField sink (ncenv: NameResolver) nenv ad ty lid = ResolveLongIdentInTyconRefs ResultCollectionSettings.AllResults ncenv nenv LookupKind.RecdField 1 m ad id rest typeNameResInfo tn.idRange tcrefs |?> List.choose (fun x -> match x with - | _, Item.RecdField (RecdFieldInfo (_, rfref)), rest ->Some(FieldResolution(FreshenRecdFieldRef ncenv m rfref, false), rfref.FieldName, rfref.RecdField.FormalType, rest) + | _, Item.RecdField (RecdFieldInfo (_, rfref)), rest -> + (Choice1Of2(FieldResolution(FreshenRecdFieldRef ncenv m rfref, false)), rfref.FieldName, rfref.RecdField.FormalType, rest) |> Some + | _, Item.AnonRecdField (anonInfo, tys, i, _), rest -> + (Choice2Of2(anonInfo, tys, i), anonInfo.SortedNames[i], tys[i], rest) |> Some | _ -> None) | _ -> NoResultsOrUsefulErrors @@ -3775,7 +3788,7 @@ let ResolveNestedField sink (ncenv: NameResolver) nenv ad ty lid = ResolveLongIdentAsModuleOrNamespaceThen sink ResultCollectionSettings.AtMostOneResult ncenv.amap m OpenQualified nenv ad id rest false (ResolveFieldInModuleOrNamespace ncenv nenv ad) |?> List.map (fun (_, FieldResolution(rfinfo, dep), rest) -> let ref = rfinfo.RecdFieldRef - FieldResolution(rfinfo, dep), ref.FieldName, ref.RecdField.FormalType, rest) + Choice1Of2(FieldResolution(rfinfo, dep)), ref.FieldName, ref.RecdField.FormalType, rest) let item, fldIdText, fldTy, rest = fldSearch () +++ moduleOrNsSearch ad +++ tyconSearch ad +++ moduleOrNsSearch AccessibleFromSomeFSharpCode +++ tyconSearch AccessibleFromSomeFSharpCode @@ -3794,13 +3807,24 @@ let ResolveNestedField sink (ncenv: NameResolver) nenv ad ty lid = let resolved = lookupFld ty id |> ForceRaise let fldTy = match resolved with - | [ FieldResolution (rfinfo, _) ] -> rfinfo.RecdField.FormalType + | [ Choice1Of2 (FieldResolution (rfinfo, _)) ] -> rfinfo.RecdField.FormalType + | [ Choice2Of2 (_, tys, index) ] -> tys[index] | _ -> ty nestedFieldSearch (flds @ resolved) fldTy rest idsBeforeField, item :: (nestedFieldSearch [] fldTy rest) - access, flds |> List.map (fun (FieldResolution (rfinfo, _)) -> lid |> List.find (fun id -> id.idText = rfinfo.RecdFieldRef.FieldName)) + let flds = + flds + |> List.map (fun x -> + let fieldName, isAnon = + match x with + | Choice1Of2 (FieldResolution (rfinfo, _)) -> rfinfo.RecdFieldRef.FieldName, false + | Choice2Of2 (anonInfo, _, i) -> anonInfo.SortedNames[i], true + + lid |> List.find (fun id -> id.idText = fieldName), isAnon) + + access, flds /// Resolve F#/IL "." syntax in expressions (2). /// diff --git a/src/Compiler/Checking/NameResolution.fsi b/src/Compiler/Checking/NameResolution.fsi index 58cce657cab..2e176168627 100755 --- a/src/Compiler/Checking/NameResolution.fsi +++ b/src/Compiler/Checking/NameResolution.fsi @@ -750,7 +750,7 @@ val internal ResolveNestedField: ad: AccessorDomain -> ty: TType -> lid: Ident list -> - Ident list * Ident list + Ident list * (Ident * bool) list /// Resolve a long identifier occurring in an expression position val internal ResolveExprLongIdent: From 2f843bb19696cc0e4c45bd1fc674bd68e9bba664 Mon Sep 17 00:00:00 2001 From: kerams Date: Mon, 27 Feb 2023 20:18:08 +0100 Subject: [PATCH 04/32] Extend anonymous record support --- src/Compiler/Checking/CheckBasics.fs | 3 + src/Compiler/Checking/CheckBasics.fsi | 3 + src/Compiler/Checking/CheckDeclarations.fs | 3 +- src/Compiler/Checking/CheckExpressions.fs | 230 ++++++++++-------- src/Compiler/Checking/CheckExpressions.fsi | 2 +- src/Compiler/Checking/NameResolution.fs | 19 +- src/Compiler/SyntaxTree/SyntaxTree.fs | 2 +- src/Compiler/SyntaxTree/SyntaxTree.fsi | 2 +- src/Compiler/pars.fsy | 12 +- ...ervice.SurfaceArea.netstandard20.debug.bsl | 6 +- ...vice.SurfaceArea.netstandard20.release.bsl | 3 + 11 files changed, 167 insertions(+), 118 deletions(-) diff --git a/src/Compiler/Checking/CheckBasics.fs b/src/Compiler/Checking/CheckBasics.fs index 6df98110001..d24598734a6 100644 --- a/src/Compiler/Checking/CheckBasics.fs +++ b/src/Compiler/Checking/CheckBasics.fs @@ -242,6 +242,9 @@ type TcEnv = // Do we lay down an implicit debug point? eIsControlFlow: bool + + /// Type checking an expanded nested copy-and-update record expression + eIsInNestedCopyAndUpdate: bool } member tenv.DisplayEnv = tenv.eNameResEnv.DisplayEnv diff --git a/src/Compiler/Checking/CheckBasics.fsi b/src/Compiler/Checking/CheckBasics.fsi index 6081eab8ef6..40caf01d0a5 100644 --- a/src/Compiler/Checking/CheckBasics.fsi +++ b/src/Compiler/Checking/CheckBasics.fsi @@ -127,6 +127,9 @@ type TcEnv = eLambdaArgInfos: ArgReprInfo list list eIsControlFlow: bool + + /// Type checking an expanded nested copy-and-update record expression + eIsInNestedCopyAndUpdate: bool } member DisplayEnv: DisplayEnv diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index 85a72fa3222..9a861310368 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -5226,7 +5226,8 @@ let emptyTcEnv g = eCtorInfo = None eCallerMemberName = None eLambdaArgInfos = [] - eIsControlFlow = false } + eIsControlFlow = false + eIsInNestedCopyAndUpdate = false } let CreateInitialTcEnv(g, amap, scopem, assemblyName, ccus) = (emptyTcEnv g, ccus) ||> List.collectFold (fun env (ccu, autoOpens, internalsVisible) -> diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 47f9ba06cc0..a0d49d0e579 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -1852,6 +1852,94 @@ let BuildFieldMap (cenv: cenv) env isPartial ty (flds: ((Ident list * Ident) * ' | _ -> error(Error(FSComp.SR.tcRecordFieldInconsistentTypes(), m))) tinst, tcref, fldsmap, List.rev rfldsList +/// Merges updates to nested record fields on the same level in record copy-and-update +let GroupUpdatesToNestedFields (fields: (bool * (Ident list * Ident) * SynExpr option) list) = + let rec groupIfNested res xs = + match xs with + | [] -> res + | x :: [] -> x :: res + | x :: y :: ys -> + match x, y with + | (aIsNestedUpdate, lidwid, Some (SynExpr.Record (baseInfo, copyInfo, aFlds, m))), (bIsNestedUpdate, _, Some (SynExpr.Record (recordFields = bFlds))) -> + let reducedRecd = (aIsNestedUpdate || bIsNestedUpdate, lidwid, Some(SynExpr.Record (baseInfo, copyInfo, aFlds @ bFlds, m))) + groupIfNested (reducedRecd :: res) ys + | (aIsNestedUpdate, lidwid, Some (SynExpr.AnonRecd (isStruct, copyInfo, aFlds, m, trivia))), (bIsNestedUpdate, _, Some (SynExpr.AnonRecd (recordFields = bFlds))) -> + let reducedRecd = (aIsNestedUpdate || bIsNestedUpdate, lidwid, Some(SynExpr.AnonRecd (isStruct, copyInfo, aFlds @ bFlds, m, trivia))) + groupIfNested (reducedRecd :: res) ys + | _ -> groupIfNested (x :: res) (y :: ys) + + fields + |> List.groupBy (fun (_, (_, field), _) -> field.idText) + |> List.collect (fun (_, fields) -> + if fields.Length < 2 then + fields + else + groupIfNested [] fields) + +/// Expands a long identifier into nested copy-and-update expressions +let TransformAstForNestedUpdates cenv env overallTy (lid: LongIdent) v withExpr = + let recdExprCopyInfo ids withExpr id = + let upToId origSepRng id lidwd = + let rec buildLid res (id: Ident) = + function + | [] -> res + | (h: Ident) :: t -> if h.idText = id.idText then h :: res else buildLid (h :: res) id t + + let rec combineIds = + function + | [] | [_] -> [] + | id1::id2::rest -> (id1, id2) :: (id2 :: rest |> combineIds) + + let calcLidSeparatorRanges lid = + match lid with + | [] | [_] -> [origSepRng] + | _ :: t -> origSepRng :: List.map (fun (s: Ident, e: Ident) -> mkRange s.idRange.FileName s.idRange.End e.idRange.Start) t + + let lid = buildLid [] id lidwd |> List.rev + + (lid, lid |> combineIds |> calcLidSeparatorRanges) + + let totalRange (origId: Ident) (id: Ident) = + mkRange origId.idRange.FileName origId.idRange.End id.idRange.Start + + let rangeOfBlockSeperator (id: Ident) = + let idEnd = id.idRange.End + let blockSeperatorStartCol = idEnd.Column + let blockSeperatorEndCol = blockSeperatorStartCol + 4 + let blockSeperatorStartPos = mkPos idEnd.Line blockSeperatorStartCol + let blockSeporatorEndPos = mkPos idEnd.Line blockSeperatorEndCol + + mkRange id.idRange.FileName blockSeperatorStartPos blockSeporatorEndPos + + match withExpr with + | SynExpr.Ident origId, (sepRange, _) -> + let lid, rng = upToId sepRange id (origId :: ids) + Some (SynExpr.LongIdent (false, LongIdentWithDots(lid, rng), None, totalRange origId id), (rangeOfBlockSeperator id, None)) // TODO: id.idRange should be the range of the next separator + | _ -> None + + let rec synExprRecd copyInfo (id: Ident) fields v = + match fields with + | [] -> failwith "unreachable" + | (fldId, isAnon) :: rest -> + // todo the unit + let nestedField = if rest.IsEmpty then Option.defaultValue (mkSynUnit range0) v else synExprRecd copyInfo fldId rest v + + if isAnon then + // The correct structness will later be taken from the anynymous type, which already exists + SynExpr.AnonRecd(false, copyInfo id, [ ([ fldId ], None, nestedField) ], id.idRange, { OpeningBraceRange = range0 }) + else + SynExpr.Record(None, copyInfo id, [ SynExprRecordField((LongIdentWithDots ([ fldId ], []), true), None, Some nestedField, None) ], id.idRange) + + let access, flds = ResolveNestedField cenv.tcSink cenv.nameResolver env.eNameResEnv env.eAccessRights overallTy lid + + match access, flds with + | [], [] -> None + | accessIds, [] -> Some (false, List.frontAndBack accessIds, v) + | accessIds, [ (fldId, _) ] -> Some (false, List.frontAndBack (accessIds @ [ fldId ]), v) + | accessIds, (fldId, _) :: rest -> + // todo remove the other some + Some (true, (accessIds, fldId), Some (synExprRecd (recdExprCopyInfo (flds |> List.map fst) withExpr) fldId rest v)) + let rec ApplyUnionCaseOrExn (makerForUnionCase, makerForExnTag) m (cenv: cenv) env overallTy item = let g = cenv.g let ad = env.eAccessRights @@ -6565,7 +6653,7 @@ and TcRecordConstruction (cenv: cenv) (overallTy: TType) env tpenv withExprInfoO if not (Zset.subset ns2 ns1) then error(MissingFields(Zset.elements (Zset.diff ns2 ns1), m)) | _ -> - if oldFldsList.IsEmpty then + if oldFldsList.IsEmpty && not env.eIsInNestedCopyAndUpdate then let enabledByLangFeature = g.langVersion.SupportsFeature LanguageFeature.WarningWhenCopyAndUpdateRecordChangesAllFields warning(ErrorEnabledWithLanguageFeature(FSComp.SR.tcCopyAndUpdateRecordChangesAllFields(fullDisplayTextOfTyconRef tcref), m, enabledByLangFeature)) @@ -7291,91 +7379,6 @@ and TcAssertExpr cenv overallTy env (m: range) tpenv x = TcExpr cenv overallTy env tpenv callDiagnosticsExpr -and transformAstForNestedUpdates cenv env overallTy (lid: LongIdent) v withExprOpt = - let recdExprCopyInfo ids withExprOpt id = - let upToId origSepRng id lidwd = - let rec buildLid res (id: Ident) = - function - | [] -> res - | (h: Ident) :: t -> if h.idText = id.idText then h :: res else buildLid (h :: res) id t - - let rec combineIds = - function - | [] | [_] -> [] - | id1::id2::rest -> (id1, id2) :: (id2 :: rest |> combineIds) - - let calcLidSeparatorRanges lid = - match lid with - | [] | [_] -> [origSepRng] - | _ :: t -> origSepRng :: List.map (fun (s : Ident, e : Ident) -> mkRange s.idRange.FileName s.idRange.End e.idRange.Start) t - - let lid = buildLid [] id lidwd |> List.rev - - (lid, lid |> combineIds |> calcLidSeparatorRanges) - - let totalRange (origId: Ident) (id: Ident) = - mkRange origId.idRange.FileName origId.idRange.End id.idRange.Start - - let rangeOfBlockSeperator (id: Ident) = - let idEnd = id.idRange.End - let blockSeperatorStartCol = idEnd.Column - let blockSeperatorEndCol = blockSeperatorStartCol + 4 - let blockSeperatorStartPos = mkPos idEnd.Line blockSeperatorStartCol - let blockSeporatorEndPos = mkPos idEnd.Line blockSeperatorEndCol - - mkRange id.idRange.FileName blockSeperatorStartPos blockSeporatorEndPos - - match withExprOpt with - | Some (SynExpr.Ident origId, (sepRange, _)) -> - let lid, rng = upToId sepRange id (origId :: ids) - Some (SynExpr.LongIdent (false, LongIdentWithDots(lid, rng), None, totalRange origId id), (rangeOfBlockSeperator id, None)) // TODO: id.idRange should be the range of the next separator - | _ -> None - - let rec synExprRecd copyInfo (id: Ident) fields v = - match fields with - | [] -> failwith "unreachable" - | (fldId, isAnon) :: rest -> - // todo the unit - let nestedField = if rest.IsEmpty then Option.defaultValue (mkSynUnit range0) v else synExprRecd copyInfo fldId rest v - - if isAnon then - // The correct structness will later be taken from the anynymous type, which already exists - SynExpr.AnonRecd(false, copyInfo id, [ (fldId, None, nestedField) ], id.idRange, { OpeningBraceRange = range0 }) - else - SynExpr.Record(None, copyInfo id, [ SynExprRecordField((LongIdentWithDots ([ fldId ], []), true), None, Some nestedField, None) ], id.idRange) - - let access, flds = ResolveNestedField cenv.tcSink cenv.nameResolver env.eNameResEnv env.eAccessRights overallTy lid - - match access, flds with - | [], [] -> None - | accessIds, [] -> Some (List.frontAndBack accessIds, v) - | accessIds, [ (fldId, _) ] -> Some (List.frontAndBack (accessIds @ [ fldId ]), v) - | accessIds, (fldId, _) :: rest -> - Some ((accessIds, fldId), Some (synExprRecd (recdExprCopyInfo (flds |> List.map fst) withExprOpt) fldId rest v)) - -and groupUpdatesToNestedFields (fields: ((Ident list * Ident) * SynExpr option) list) = - let rec groupIfNested res xs = - match xs with - | [] -> res - | x :: [] -> x :: res - | x :: y :: ys -> - match x, y with - | (lidwid, Some (SynExpr.Record (baseInfo, copyInfo, aFlds, m))), (_, Some (SynExpr.Record (recordFields = bFlds))) -> - let reducedRecd = (lidwid, Some(SynExpr.Record (baseInfo, copyInfo, aFlds @ bFlds, m))) - groupIfNested (reducedRecd :: res) ys - | (lidwid, Some (SynExpr.AnonRecd (isStruct, copyInfo, aFlds, m, trivia))), (_, Some (SynExpr.AnonRecd (recordFields = bFlds))) -> - let reducedRecd = (lidwid, Some(SynExpr.AnonRecd (isStruct, copyInfo, aFlds @ bFlds, m, trivia))) - groupIfNested (reducedRecd :: res) ys - | _ -> groupIfNested (x :: res) (y :: ys) - - fields - |> List.groupBy (fun ((_, field), _) -> field.idText) - |> List.collect (fun (_, fields) -> - if fields.Length < 2 then - fields - else - groupIfNested [] fields) - and TcRecdExpr cenv overallTy env tpenv (inherits, withExprOpt, synRecdFields, mWholeExpr) = let g = cenv.g @@ -7394,7 +7397,7 @@ and TcRecdExpr cenv overallTy env tpenv (inherits, withExprOpt, synRecdFields, m let hasOrigExpr = withExprOptChecked.IsSome - let fldsList = + let fldsList, containsNestedUpdates = let flds = synRecdFields |> List.choose (fun (SynExprRecordField (fieldName = (synLongId, isOk); expr = v)) -> @@ -7404,23 +7407,27 @@ and TcRecdExpr cenv overallTy env tpenv (inherits, withExprOpt, synRecdFields, m // we assume that parse errors were already reported raise (ReportedError None) - match synLongId.LongIdent with - | [] -> None - | [ id ] -> Some (([], id), v) - | lid -> transformAstForNestedUpdates cenv env overallTy lid v withExprOpt) - |> groupUpdatesToNestedFields + match withExprOpt with + | Some withExpr -> + match synLongId.LongIdent with + | [] -> None + | [ id ] -> Some (false, ([], id), v) + | lid -> TransformAstForNestedUpdates cenv env overallTy lid v withExpr + | _ -> Some (false, List.frontAndBack synLongId.LongIdent, v)) + + let flds = if hasOrigExpr then GroupUpdatesToNestedFields flds else flds match flds with - | [] -> [] + | [] -> [], false | _ -> - let tinst, tcref, _, fldsList = BuildFieldMap cenv env hasOrigExpr overallTy flds mWholeExpr + let tinst, tcref, _, fldsList = BuildFieldMap cenv env hasOrigExpr overallTy (flds |> List.map (fun (_, x, y) -> x, y)) mWholeExpr let gtyp = mkAppTy tcref tinst UnifyTypes cenv env mWholeExpr overallTy gtyp [ for n, v in fldsList do match v with | Some v -> yield n, v - | None -> () ] + | None -> () ], flds |> List.exists (fun (isNestedUpdate, _, _) -> isNestedUpdate) let withExprInfoOpt = match withExprOptChecked with @@ -7462,7 +7469,8 @@ and TcRecdExpr cenv overallTy env tpenv (inherits, withExprOpt, synRecdFields, m errorR(InternalError("Unexpected failure in getting super type", mWholeExpr)) None, tpenv - let expr, tpenv = TcRecordConstruction cenv overallTy env tpenv withExprInfoOpt overallTy fldsList mWholeExpr + let envinner = if containsNestedUpdates then { env with eIsInNestedCopyAndUpdate = true } else env + let expr, tpenv = TcRecordConstruction cenv overallTy envinner tpenv withExprInfoOpt overallTy fldsList mWholeExpr let expr = match superInitExprOpt with @@ -7477,7 +7485,7 @@ and TcAnonRecdExpr cenv (overallTy: TType) env tpenv (isStruct, optOrigSynExpr, // Check for duplicate field IDs unsortedFieldIdsAndSynExprsGiven - |> List.countBy (fun (fId, _, _) -> fId.idText) + |> List.countBy (fun (fId, _, _) -> textOfLid fId) |> List.iter (fun (label, count) -> if count > 1 then error (Error (FSComp.SR.tcAnonRecdDuplicateFieldId(label), mWholeExpr))) @@ -7492,7 +7500,7 @@ and TcNewAnonRecdExpr cenv (overallTy: TType) env tpenv (isStruct, unsortedField let g = cenv.g let unsortedFieldSynExprsGiven = unsortedFieldIdsAndSynExprsGiven |> List.map (fun (_, _, fieldExpr) -> fieldExpr) - let unsortedFieldIds = unsortedFieldIdsAndSynExprsGiven |> List.map (fun (fieldId, _, _) -> fieldId) |> List.toArray + let unsortedFieldIds = unsortedFieldIdsAndSynExprsGiven |> List.map (fun (fieldId, _, _) -> fieldId[0]) |> List.toArray let anonInfo, sortedFieldTys = UnifyAnonRecdTypeAndInferCharacteristics env.eContextInfo cenv env.DisplayEnv mWholeExpr overallTy isStruct unsortedFieldIds // Sort into canonical order @@ -7506,8 +7514,9 @@ and TcNewAnonRecdExpr cenv (overallTy: TType) env tpenv (isStruct, unsortedField let sortedFieldExprs = sortedIndexedArgs |> List.map snd sortedFieldExprs |> List.iteri (fun j (fieldId, _, _) -> - let item = Item.AnonRecdField(anonInfo, sortedFieldTys, j, fieldId.idRange) - CallNameResolutionSink cenv.tcSink (fieldId.idRange, env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, env.eAccessRights)) + let m = rangeOfLid fieldId + let item = Item.AnonRecdField(anonInfo, sortedFieldTys, j, m) + CallNameResolutionSink cenv.tcSink (m, env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, env.eAccessRights)) let unsortedFieldTys = sortedFieldTys @@ -7532,7 +7541,6 @@ and TcCopyAndUpdateAnonRecdExpr cenv (overallTy: TType) env tpenv (isStruct, ori // Unlike in the case of record type copy-and-update {| a with X = 1 |} does not force a.X to exist or have had type 'int' let g = cenv.g - let unsortedFieldSynExprsGiven = unsortedFieldIdsAndSynExprsGiven |> List.map (fun (_, _, e) -> e) let origExprTy = NewInferenceType g let origExprChecked, tpenv = TcExpr cenv (MustEqual origExprTy) env tpenv origExpr let oldv, oldve = mkCompGenLocal mWholeExpr "inputRecord" origExprTy @@ -7541,6 +7549,18 @@ and TcCopyAndUpdateAnonRecdExpr cenv (overallTy: TType) env tpenv (isStruct, ori if not (isAppTy g origExprTy || isAnonRecdTy g origExprTy) then error (Error (FSComp.SR.tcCopyAndUpdateNeedsRecordType(), mOrigExpr)) + // Expand expressions with respect to potential nesting + let unsortedFieldIdsAndSynExprsGiven = + unsortedFieldIdsAndSynExprsGiven + |> List.choose (fun (lid, _, e) -> + match lid with + | [] -> None + | [ id ] -> Some (false, ([], id), Some e) // todo remove options + | lid -> TransformAstForNestedUpdates cenv env origExprTy lid (Some e) (origExpr, (range0, range0))) + |> GroupUpdatesToNestedFields + + let unsortedFieldSynExprsGiven = unsortedFieldIdsAndSynExprsGiven |> List.map (fun (_, _, e) -> e.Value) //todo + let origExprIsStruct = match tryDestAnonRecdTy g origExprTy with | ValueSome (anonInfo, _) -> evalTupInfoIsStruct anonInfo.TupInfo @@ -7556,7 +7576,7 @@ and TcCopyAndUpdateAnonRecdExpr cenv (overallTy: TType) env tpenv (isStruct, ori /// - Choice2Of2 for a binding coming from the original expression let unsortedIdAndExprsAll = [| - for id, _, e in unsortedFieldIdsAndSynExprsGiven do + for _, (_, id), e in unsortedFieldIdsAndSynExprsGiven do yield (id, Choice1Of2 e) match tryDestAnonRecdTy g origExprTy with | ValueSome (anonInfo, tinst) -> @@ -7607,6 +7627,12 @@ and TcCopyAndUpdateAnonRecdExpr cenv (overallTy: TType) env tpenv (isStruct, ori // Check the expressions in unsorted order let unsortedFieldExprsGiven, tpenv = + let env = + if unsortedFieldIdsAndSynExprsGiven |> List.exists (fun (isNestedUpdate, _, _) -> isNestedUpdate) then + { env with eIsInNestedCopyAndUpdate = true } + else + env + TcExprsWithFlexes cenv env mWholeExpr tpenv flexes unsortedFieldTysGiven unsortedFieldSynExprsGiven let unsortedFieldExprsGiven = unsortedFieldExprsGiven |> List.toArray diff --git a/src/Compiler/Checking/CheckExpressions.fsi b/src/Compiler/Checking/CheckExpressions.fsi index 0e079eeec33..f3e9ad559d4 100644 --- a/src/Compiler/Checking/CheckExpressions.fsi +++ b/src/Compiler/Checking/CheckExpressions.fsi @@ -892,7 +892,7 @@ val BuildFieldMap: env: TcEnv -> isPartial: bool -> ty: TType -> - ((Ident list * Ident) * 'T) list -> + flds: ((Ident list * Ident) * 'T) list -> m: range -> TypeInst * TyconRef * Map * (string * 'T) list diff --git a/src/Compiler/Checking/NameResolution.fs b/src/Compiler/Checking/NameResolution.fs index cd22917a2fb..d93b35677f8 100644 --- a/src/Compiler/Checking/NameResolution.fs +++ b/src/Compiler/Checking/NameResolution.fs @@ -3696,6 +3696,7 @@ let ResolveField sink ncenv nenv ad ty mp id allFields = let ResolveNestedField sink (ncenv: NameResolver) nenv ad ty lid = let typeNameResInfo = TypeNameResolutionInfo.Default let g = ncenv.g + let isAnonRecd = isAnonRecdTy g ty let lookupFld ty (id: Ident) = let m = id.idRange @@ -3708,6 +3709,8 @@ let ResolveNestedField sink (ncenv: NameResolver) nenv ad ty lid = | _ -> let otherRecdFlds ty = let typeName = NicePrint.minimalStringOfType nenv.eDisplayEnv ty + + // todo investigate refactoring [ for KeyValue (_, v) in nenv.eFieldLabels do match v |> List.tryFind (fun r -> r.TyconRef.DisplayName = typeName) with @@ -3717,7 +3720,7 @@ let ResolveNestedField sink (ncenv: NameResolver) nenv ad ty lid = let lookup() = let frefs = - match (Map.tryFind id.idText nenv.eFieldLabels) with + match Map.tryFind id.idText nenv.eFieldLabels with | Some field -> success field | None -> raze (SuggestLabelsOfRelatedRecords g nenv id (otherRecdFlds ty)) @@ -3791,11 +3794,21 @@ let ResolveNestedField sink (ncenv: NameResolver) nenv ad ty lid = Choice1Of2(FieldResolution(rfinfo, dep)), ref.FieldName, ref.RecdField.FormalType, rest) let item, fldIdText, fldTy, rest = - fldSearch () +++ moduleOrNsSearch ad +++ tyconSearch ad +++ moduleOrNsSearch AccessibleFromSomeFSharpCode +++ tyconSearch AccessibleFromSomeFSharpCode + let search = + if isAnonRecd then + fldSearch () + else + fldSearch () +++ moduleOrNsSearch ad +++ tyconSearch ad +++ moduleOrNsSearch AccessibleFromSomeFSharpCode +++ tyconSearch AccessibleFromSomeFSharpCode + + search |> AtMostOneResult id.idRange |> ForceRaise - let idsBeforeField = lid |> List.takeWhile (fun id -> id.idText <> fldIdText) + let idsBeforeField = + if isAnonRecd then + [] + else + lid |> List.takeWhile (fun id -> id.idText <> fldIdText) match rest with | [] -> idsBeforeField, [ item ] diff --git a/src/Compiler/SyntaxTree/SyntaxTree.fs b/src/Compiler/SyntaxTree/SyntaxTree.fs index 78d276948ff..08c545757ff 100644 --- a/src/Compiler/SyntaxTree/SyntaxTree.fs +++ b/src/Compiler/SyntaxTree/SyntaxTree.fs @@ -482,7 +482,7 @@ type SynExpr = | AnonRecd of isStruct: bool * copyInfo: (SynExpr * BlockSeparator) option * - recordFields: (Ident * range option * SynExpr) list * + recordFields: (LongIdent * range option * SynExpr) list * range: range * trivia: SynExprAnonRecdTrivia diff --git a/src/Compiler/SyntaxTree/SyntaxTree.fsi b/src/Compiler/SyntaxTree/SyntaxTree.fsi index 222c0131088..21030a5ab2d 100644 --- a/src/Compiler/SyntaxTree/SyntaxTree.fsi +++ b/src/Compiler/SyntaxTree/SyntaxTree.fsi @@ -554,7 +554,7 @@ type SynExpr = | AnonRecd of isStruct: bool * copyInfo: (SynExpr * BlockSeparator) option * - recordFields: (Ident * range option * SynExpr) list * + recordFields: (LongIdent * range option * SynExpr) list * range: range * trivia: SynExprAnonRecdTrivia diff --git a/src/Compiler/pars.fsy b/src/Compiler/pars.fsy index c432a682f25..dc564b44c6f 100644 --- a/src/Compiler/pars.fsy +++ b/src/Compiler/pars.fsy @@ -4923,8 +4923,9 @@ braceBarExprCore: { let orig, flds = $2 let flds = flds |> List.choose (function - | SynExprRecordField((SynLongIdent([id], _, _), _), mEquals, Some e, _) -> Some (id, mEquals, e) - | SynExprRecordField((SynLongIdent([id], _, _), _), mEquals, None, _) -> Some (id, mEquals, arbExpr("anonField", id.idRange)) + | SynExprRecordField((SynLongIdent(lid, _, _), _), mEquals, Some e, _) when orig.IsSome -> Some (lid, mEquals, e) // copy-and-update, long identifier signifies nesting + | SynExprRecordField((SynLongIdent([id], _, _), _), mEquals, Some e, _) -> Some ([id], mEquals, e) // record construction, long identifier not valid + | SynExprRecordField((SynLongIdent(lid, _, _), _), mEquals, None, _) -> Some (lid, mEquals, arbExpr("anonField", rangeOfLongIdent lid)) | _ -> reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsInvalidAnonRecdType()); None) let mLeftBrace = rhs parseState 1 let mRightBrace = rhs parseState 3 @@ -4936,10 +4937,9 @@ braceBarExprCore: { reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnmatchedBraceBar()) let orig, flds = $2 let flds = - flds |> List.choose (function - | SynExprRecordField((SynLongIdent([id], _, _), _), mEquals, Some e, _) -> Some (id, mEquals, e) - | SynExprRecordField((SynLongIdent([id], _, _), _), mEquals, None, _) -> Some (id, mEquals, arbExpr("anonField", id.idRange)) - | _ -> reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsInvalidAnonRecdType()); None) + flds |> List.map (function + | SynExprRecordField((SynLongIdent(lid, _, _), _), mEquals, Some e, _) -> (lid, mEquals, e) + | SynExprRecordField((SynLongIdent(lid, _, _), _), mEquals, None, _) -> (lid, mEquals, arbExpr("anonField", rangeOfLongIdent lid))) let mLeftBrace = rhs parseState 1 let mExpr = rhs parseState 2 (fun (mStruct: range option) -> diff --git a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.debug.bsl b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.debug.bsl index 65c87df026a..068e378423f 100644 --- a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.debug.bsl +++ b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.debug.bsl @@ -6166,8 +6166,8 @@ FSharp.Compiler.Syntax.SynExpr+AnonRecd: FSharp.Compiler.SyntaxTrivia.SynExprAno FSharp.Compiler.Syntax.SynExpr+AnonRecd: FSharp.Compiler.SyntaxTrivia.SynExprAnonRecdTrivia trivia FSharp.Compiler.Syntax.SynExpr+AnonRecd: FSharp.Compiler.Text.Range get_range() FSharp.Compiler.Syntax.SynExpr+AnonRecd: FSharp.Compiler.Text.Range range -FSharp.Compiler.Syntax.SynExpr+AnonRecd: Microsoft.FSharp.Collections.FSharpList`1[System.Tuple`3[FSharp.Compiler.Syntax.Ident,Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range],FSharp.Compiler.Syntax.SynExpr]] get_recordFields() -FSharp.Compiler.Syntax.SynExpr+AnonRecd: Microsoft.FSharp.Collections.FSharpList`1[System.Tuple`3[FSharp.Compiler.Syntax.Ident,Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range],FSharp.Compiler.Syntax.SynExpr]] recordFields +FSharp.Compiler.Syntax.SynExpr+AnonRecd: Microsoft.FSharp.Collections.FSharpList`1[System.Tuple`3[Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.Ident],Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range],FSharp.Compiler.Syntax.SynExpr]] get_recordFields() +FSharp.Compiler.Syntax.SynExpr+AnonRecd: Microsoft.FSharp.Collections.FSharpList`1[System.Tuple`3[Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.Ident],Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range],FSharp.Compiler.Syntax.SynExpr]] recordFields FSharp.Compiler.Syntax.SynExpr+AnonRecd: Microsoft.FSharp.Core.FSharpOption`1[System.Tuple`2[FSharp.Compiler.Syntax.SynExpr,System.Tuple`2[FSharp.Compiler.Text.Range,Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Position]]]] copyInfo FSharp.Compiler.Syntax.SynExpr+AnonRecd: Microsoft.FSharp.Core.FSharpOption`1[System.Tuple`2[FSharp.Compiler.Syntax.SynExpr,System.Tuple`2[FSharp.Compiler.Text.Range,Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Position]]]] get_copyInfo() FSharp.Compiler.Syntax.SynExpr+App: Boolean get_isInfix() @@ -6905,7 +6905,7 @@ FSharp.Compiler.Syntax.SynExpr: Boolean get_IsWhile() FSharp.Compiler.Syntax.SynExpr: Boolean get_IsYieldOrReturn() FSharp.Compiler.Syntax.SynExpr: Boolean get_IsYieldOrReturnFrom() FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewAddressOf(Boolean, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Text.Range, FSharp.Compiler.Text.Range) -FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewAnonRecd(Boolean, Microsoft.FSharp.Core.FSharpOption`1[System.Tuple`2[FSharp.Compiler.Syntax.SynExpr,System.Tuple`2[FSharp.Compiler.Text.Range,Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Position]]]], Microsoft.FSharp.Collections.FSharpList`1[System.Tuple`3[FSharp.Compiler.Syntax.Ident,Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range],FSharp.Compiler.Syntax.SynExpr]], FSharp.Compiler.Text.Range, FSharp.Compiler.SyntaxTrivia.SynExprAnonRecdTrivia) +FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewAnonRecd(Boolean, Microsoft.FSharp.Core.FSharpOption`1[System.Tuple`2[FSharp.Compiler.Syntax.SynExpr,System.Tuple`2[FSharp.Compiler.Text.Range,Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Position]]]], Microsoft.FSharp.Collections.FSharpList`1[System.Tuple`3[Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.Ident],Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range],FSharp.Compiler.Syntax.SynExpr]], FSharp.Compiler.Text.Range, FSharp.Compiler.SyntaxTrivia.SynExprAnonRecdTrivia) FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewApp(FSharp.Compiler.Syntax.ExprAtomicFlag, Boolean, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewArbitraryAfterError(System.String, FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewArrayOrList(Boolean, Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynExpr], FSharp.Compiler.Text.Range) diff --git a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.release.bsl b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.release.bsl index 65c87df026a..a4219141841 100644 --- a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.release.bsl +++ b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.release.bsl @@ -6168,6 +6168,8 @@ FSharp.Compiler.Syntax.SynExpr+AnonRecd: FSharp.Compiler.Text.Range get_range() FSharp.Compiler.Syntax.SynExpr+AnonRecd: FSharp.Compiler.Text.Range range FSharp.Compiler.Syntax.SynExpr+AnonRecd: Microsoft.FSharp.Collections.FSharpList`1[System.Tuple`3[FSharp.Compiler.Syntax.Ident,Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range],FSharp.Compiler.Syntax.SynExpr]] get_recordFields() FSharp.Compiler.Syntax.SynExpr+AnonRecd: Microsoft.FSharp.Collections.FSharpList`1[System.Tuple`3[FSharp.Compiler.Syntax.Ident,Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range],FSharp.Compiler.Syntax.SynExpr]] recordFields +FSharp.Compiler.Syntax.SynExpr+AnonRecd: Microsoft.FSharp.Collections.FSharpList`1[System.Tuple`3[Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.Ident],Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range],FSharp.Compiler.Syntax.SynExpr]] get_recordFields() +FSharp.Compiler.Syntax.SynExpr+AnonRecd: Microsoft.FSharp.Collections.FSharpList`1[System.Tuple`3[Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.Ident],Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range],FSharp.Compiler.Syntax.SynExpr]] recordFields FSharp.Compiler.Syntax.SynExpr+AnonRecd: Microsoft.FSharp.Core.FSharpOption`1[System.Tuple`2[FSharp.Compiler.Syntax.SynExpr,System.Tuple`2[FSharp.Compiler.Text.Range,Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Position]]]] copyInfo FSharp.Compiler.Syntax.SynExpr+AnonRecd: Microsoft.FSharp.Core.FSharpOption`1[System.Tuple`2[FSharp.Compiler.Syntax.SynExpr,System.Tuple`2[FSharp.Compiler.Text.Range,Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Position]]]] get_copyInfo() FSharp.Compiler.Syntax.SynExpr+App: Boolean get_isInfix() @@ -6906,6 +6908,7 @@ FSharp.Compiler.Syntax.SynExpr: Boolean get_IsYieldOrReturn() FSharp.Compiler.Syntax.SynExpr: Boolean get_IsYieldOrReturnFrom() FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewAddressOf(Boolean, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Text.Range, FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewAnonRecd(Boolean, Microsoft.FSharp.Core.FSharpOption`1[System.Tuple`2[FSharp.Compiler.Syntax.SynExpr,System.Tuple`2[FSharp.Compiler.Text.Range,Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Position]]]], Microsoft.FSharp.Collections.FSharpList`1[System.Tuple`3[FSharp.Compiler.Syntax.Ident,Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range],FSharp.Compiler.Syntax.SynExpr]], FSharp.Compiler.Text.Range, FSharp.Compiler.SyntaxTrivia.SynExprAnonRecdTrivia) +FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewAnonRecd(Boolean, Microsoft.FSharp.Core.FSharpOption`1[System.Tuple`2[FSharp.Compiler.Syntax.SynExpr,System.Tuple`2[FSharp.Compiler.Text.Range,Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Position]]]], Microsoft.FSharp.Collections.FSharpList`1[System.Tuple`3[Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.Ident],Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range],FSharp.Compiler.Syntax.SynExpr]], FSharp.Compiler.Text.Range, FSharp.Compiler.SyntaxTrivia.SynExprAnonRecdTrivia) FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewApp(FSharp.Compiler.Syntax.ExprAtomicFlag, Boolean, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewArbitraryAfterError(System.String, FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewArrayOrList(Boolean, Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynExpr], FSharp.Compiler.Text.Range) From c9a2d2961ca97d86cbebad2ec1a9ed9833ef064b Mon Sep 17 00:00:00 2001 From: kerams Date: Mon, 27 Feb 2023 20:25:53 +0100 Subject: [PATCH 05/32] Format --- src/Compiler/Service/FSharpCheckerResults.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Compiler/Service/FSharpCheckerResults.fs b/src/Compiler/Service/FSharpCheckerResults.fs index a8211e19e3f..0c8f7f6ff8b 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fs +++ b/src/Compiler/Service/FSharpCheckerResults.fs @@ -652,7 +652,7 @@ type internal TypeCheckInfo let fields = ncenv.InfoReader.GetRecordOrClassFieldsOfType(None, ad, m, ty) |> List.filter (fun rfref -> not rfref.IsStatic && IsFieldInfoAccessible ad rfref) - + match plid with | [] -> if wasPathEmpty || isPastTypePrefix then From 7af7cbc5f534867287279d3836504f8499a369b5 Mon Sep 17 00:00:00 2001 From: kerams Date: Tue, 28 Feb 2023 17:06:02 +0100 Subject: [PATCH 06/32] Improve Intellisense for anonymous records --- src/Compiler/Checking/NameResolution.fs | 1 + src/Compiler/Service/FSharpCheckerResults.fs | 38 +++++++++++++------- 2 files changed, 26 insertions(+), 13 deletions(-) diff --git a/src/Compiler/Checking/NameResolution.fs b/src/Compiler/Checking/NameResolution.fs index d93b35677f8..1a447f0cf02 100644 --- a/src/Compiler/Checking/NameResolution.fs +++ b/src/Compiler/Checking/NameResolution.fs @@ -3808,6 +3808,7 @@ let ResolveNestedField sink (ncenv: NameResolver) nenv ad ty lid = if isAnonRecd then [] else + // todo questionable - match by range? lid |> List.takeWhile (fun id -> id.idText <> fldIdText) match rest with diff --git a/src/Compiler/Service/FSharpCheckerResults.fs b/src/Compiler/Service/FSharpCheckerResults.fs index 0c8f7f6ff8b..8c6cb3a4ec1 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fs +++ b/src/Compiler/Service/FSharpCheckerResults.fs @@ -643,12 +643,10 @@ type internal TypeCheckInfo let thereWereSomeQuals = not (Array.isEmpty quals) thereWereSomeQuals, quals - /// Returns the list of available record fields, taking into account to potential nesting + /// Returns the list of available record fields, taking into account potential nesting let GetRecdFieldsForCopyAndUpdateExpr (identRange: range, plid: string list) = - let _, quals = GetExprTypingForPosition(identRange.End) - - let rec dive (ty, nenv: NameResolutionEnv, ad, m) plid isPastTypePrefix wasPathEmpty = - if isRecdTy nenv.DisplayEnv.g ty then + let rec dive ty (denv: DisplayEnv) ad m plid isPastTypePrefix wasPathEmpty = + if isRecdTy denv.g ty then let fields = ncenv.InfoReader.GetRecordOrClassFieldsOfType(None, ad, m, ty) |> List.filter (fun rfref -> not rfref.IsStatic && IsFieldInfoAccessible ad rfref) @@ -656,24 +654,38 @@ type internal TypeCheckInfo match plid with | [] -> if wasPathEmpty || isPastTypePrefix then - Some(fields |> List.map Item.RecdField, nenv.DisplayEnv, m) + Some(fields |> List.map Item.RecdField, denv, m) else None | id :: rest -> match fields |> List.tryFind (fun f -> f.LogicalName = id) with - | Some f -> dive (f.RecdField.FormalType, nenv, ad, m) rest true wasPathEmpty + | Some f -> dive f.RecdField.FormalType denv ad m rest true wasPathEmpty | _ -> // Field name can be optionally qualified // If we haven't matched a field name yet, keep peeling off the prefix if isPastTypePrefix then - Some([], nenv.DisplayEnv, m) + Some([], denv, m) else - dive (ty, nenv, ad, m) rest false wasPathEmpty + dive ty denv ad m rest false wasPathEmpty else - Some([], nenv.DisplayEnv, m) - - match quals |> Array.tryFind (fun (_, _, _, rq) -> posEq identRange.Start rq.Start) with - | Some qual -> dive qual plid false plid.IsEmpty + match tryDestAnonRecdTy denv.g ty with + | ValueSome (anonInfo, tys) -> + match plid with + | [] -> + let items = [ + for i in 0 .. anonInfo.SortedIds.Length - 1 do + Item.AnonRecdField (anonInfo, tys, i, anonInfo.SortedIds[i].idRange) + ] + + Some(items, denv, m) + | id :: rest -> + match anonInfo.SortedNames |> Array.tryFindIndex (fun x -> x = id) with + | Some i -> dive tys[i] denv ad m rest true wasPathEmpty + | _ -> Some([], denv, m) + | ValueNone -> Some([], denv, m) + + match GetExprTypingForPosition identRange.End |> snd |> Array.tryFind (fun (_, _, _, rq) -> posEq identRange.Start rq.Start) with + | Some (ty, nenv, ad, m) -> dive ty nenv.DisplayEnv ad m plid false plid.IsEmpty | _ -> None /// Looks at the exact expression types at the position to the left of the From 04cff96097027d56fab880eee06a025df989ba6b Mon Sep 17 00:00:00 2001 From: kerams Date: Tue, 28 Feb 2023 17:35:44 +0100 Subject: [PATCH 07/32] Guard nested copy-and-update with a languafe feature --- src/Compiler/Checking/CheckExpressions.fs | 1 + src/Compiler/FSComp.txt | 1 + src/Compiler/Facilities/LanguageFeatures.fs | 3 +++ src/Compiler/Facilities/LanguageFeatures.fsi | 1 + src/Compiler/xlf/FSComp.txt.cs.xlf | 5 +++++ src/Compiler/xlf/FSComp.txt.de.xlf | 5 +++++ src/Compiler/xlf/FSComp.txt.es.xlf | 5 +++++ src/Compiler/xlf/FSComp.txt.fr.xlf | 5 +++++ src/Compiler/xlf/FSComp.txt.it.xlf | 5 +++++ src/Compiler/xlf/FSComp.txt.ja.xlf | 5 +++++ src/Compiler/xlf/FSComp.txt.ko.xlf | 5 +++++ src/Compiler/xlf/FSComp.txt.pl.xlf | 5 +++++ src/Compiler/xlf/FSComp.txt.pt-BR.xlf | 5 +++++ src/Compiler/xlf/FSComp.txt.ru.xlf | 5 +++++ src/Compiler/xlf/FSComp.txt.tr.xlf | 5 +++++ src/Compiler/xlf/FSComp.txt.zh-Hans.xlf | 5 +++++ src/Compiler/xlf/FSComp.txt.zh-Hant.xlf | 5 +++++ 17 files changed, 71 insertions(+) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index a0d49d0e579..5c73432430c 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -1937,6 +1937,7 @@ let TransformAstForNestedUpdates cenv env overallTy (lid: LongIdent) v withExpr | accessIds, [] -> Some (false, List.frontAndBack accessIds, v) | accessIds, [ (fldId, _) ] -> Some (false, List.frontAndBack (accessIds @ [ fldId ]), v) | accessIds, (fldId, _) :: rest -> + checkLanguageFeatureAndRecover cenv.g.langVersion LanguageFeature.NestedCopyAndUpdate (rangeOfLid lid) // todo remove the other some Some (true, (accessIds, fldId), Some (synExprRecd (recdExprCopyInfo (flds |> List.map fst) withExpr) fldId rest v)) diff --git a/src/Compiler/FSComp.txt b/src/Compiler/FSComp.txt index d17728dccf8..32ee5003cdd 100644 --- a/src/Compiler/FSComp.txt +++ b/src/Compiler/FSComp.txt @@ -1565,6 +1565,7 @@ featureTryWithInSeqExpressions,"Support for try-with in sequence expressions" featureWarningWhenCopyAndUpdateRecordChangesAllFields,"Raises warnings when an copy-and-update record expression changes all fields of a record." featureStaticMembersInInterfaces,"Static members in interfaces" featureNonInlineLiteralsAsPrintfFormat,"String values marked as literals and IL constants as printf format" +featureNestedCopyAndUpdate,"Nested record field copy-and-update" 3353,fsiInvalidDirective,"Invalid directive '#%s %s'" 3354,tcNotAFunctionButIndexerNamedIndexingNotYetEnabled,"This value supports indexing, e.g. '%s.[index]'. The syntax '%s[index]' requires /langversion:preview. See https://aka.ms/fsharp-index-notation." 3354,tcNotAFunctionButIndexerIndexingNotYetEnabled,"This expression supports indexing, e.g. 'expr.[index]'. The syntax 'expr[index]' requires /langversion:preview. See https://aka.ms/fsharp-index-notation." diff --git a/src/Compiler/Facilities/LanguageFeatures.fs b/src/Compiler/Facilities/LanguageFeatures.fs index 4c8730e6163..fa0acceb0df 100644 --- a/src/Compiler/Facilities/LanguageFeatures.fs +++ b/src/Compiler/Facilities/LanguageFeatures.fs @@ -65,6 +65,7 @@ type LanguageFeature = | WarningWhenCopyAndUpdateRecordChangesAllFields | StaticMembersInInterfaces | NonInlineLiteralsAsPrintfFormat + | NestedCopyAndUpdate /// LanguageVersion management type LanguageVersion(versionText) = @@ -146,6 +147,7 @@ type LanguageVersion(versionText) = LanguageFeature.WarningWhenCopyAndUpdateRecordChangesAllFields, previewVersion LanguageFeature.StaticMembersInInterfaces, previewVersion LanguageFeature.NonInlineLiteralsAsPrintfFormat, previewVersion + LanguageFeature.NestedCopyAndUpdate, previewVersion ] @@ -264,6 +266,7 @@ type LanguageVersion(versionText) = | LanguageFeature.WarningWhenCopyAndUpdateRecordChangesAllFields -> FSComp.SR.featureWarningWhenCopyAndUpdateRecordChangesAllFields () | LanguageFeature.StaticMembersInInterfaces -> FSComp.SR.featureStaticMembersInInterfaces () | LanguageFeature.NonInlineLiteralsAsPrintfFormat -> FSComp.SR.featureNonInlineLiteralsAsPrintfFormat () + | LanguageFeature.NestedCopyAndUpdate -> FSComp.SR.featureNestedCopyAndUpdate () /// Get a version string associated with the given feature. static member GetFeatureVersionString feature = diff --git a/src/Compiler/Facilities/LanguageFeatures.fsi b/src/Compiler/Facilities/LanguageFeatures.fsi index 650a1583cfb..c5c407e80b8 100644 --- a/src/Compiler/Facilities/LanguageFeatures.fsi +++ b/src/Compiler/Facilities/LanguageFeatures.fsi @@ -55,6 +55,7 @@ type LanguageFeature = | WarningWhenCopyAndUpdateRecordChangesAllFields | StaticMembersInInterfaces | NonInlineLiteralsAsPrintfFormat + | NestedCopyAndUpdate /// LanguageVersion management type LanguageVersion = diff --git a/src/Compiler/xlf/FSComp.txt.cs.xlf b/src/Compiler/xlf/FSComp.txt.cs.xlf index da1d76c755b..906a41d4be0 100644 --- a/src/Compiler/xlf/FSComp.txt.cs.xlf +++ b/src/Compiler/xlf/FSComp.txt.cs.xlf @@ -307,6 +307,11 @@ nameof + + Nested record field copy-and-update + Nested record field copy-and-update + + String values marked as literals and IL constants as printf format String values marked as literals and IL constants as printf format diff --git a/src/Compiler/xlf/FSComp.txt.de.xlf b/src/Compiler/xlf/FSComp.txt.de.xlf index 186ce458734..0042cac2dcd 100644 --- a/src/Compiler/xlf/FSComp.txt.de.xlf +++ b/src/Compiler/xlf/FSComp.txt.de.xlf @@ -307,6 +307,11 @@ nameof + + Nested record field copy-and-update + Nested record field copy-and-update + + String values marked as literals and IL constants as printf format String values marked as literals and IL constants as printf format diff --git a/src/Compiler/xlf/FSComp.txt.es.xlf b/src/Compiler/xlf/FSComp.txt.es.xlf index f15aea23087..8454aaaf76a 100644 --- a/src/Compiler/xlf/FSComp.txt.es.xlf +++ b/src/Compiler/xlf/FSComp.txt.es.xlf @@ -307,6 +307,11 @@ nameof + + Nested record field copy-and-update + Nested record field copy-and-update + + String values marked as literals and IL constants as printf format String values marked as literals and IL constants as printf format diff --git a/src/Compiler/xlf/FSComp.txt.fr.xlf b/src/Compiler/xlf/FSComp.txt.fr.xlf index 3643c1aa164..66e6189c687 100644 --- a/src/Compiler/xlf/FSComp.txt.fr.xlf +++ b/src/Compiler/xlf/FSComp.txt.fr.xlf @@ -307,6 +307,11 @@ nameof + + Nested record field copy-and-update + Nested record field copy-and-update + + String values marked as literals and IL constants as printf format String values marked as literals and IL constants as printf format diff --git a/src/Compiler/xlf/FSComp.txt.it.xlf b/src/Compiler/xlf/FSComp.txt.it.xlf index 0e7df41a2a9..a930f2c9748 100644 --- a/src/Compiler/xlf/FSComp.txt.it.xlf +++ b/src/Compiler/xlf/FSComp.txt.it.xlf @@ -307,6 +307,11 @@ nameof + + Nested record field copy-and-update + Nested record field copy-and-update + + String values marked as literals and IL constants as printf format String values marked as literals and IL constants as printf format diff --git a/src/Compiler/xlf/FSComp.txt.ja.xlf b/src/Compiler/xlf/FSComp.txt.ja.xlf index 284b52c46d5..6fb39206b9c 100644 --- a/src/Compiler/xlf/FSComp.txt.ja.xlf +++ b/src/Compiler/xlf/FSComp.txt.ja.xlf @@ -307,6 +307,11 @@ nameof + + Nested record field copy-and-update + Nested record field copy-and-update + + String values marked as literals and IL constants as printf format String values marked as literals and IL constants as printf format diff --git a/src/Compiler/xlf/FSComp.txt.ko.xlf b/src/Compiler/xlf/FSComp.txt.ko.xlf index dc86b3fea82..22dd7ee82bd 100644 --- a/src/Compiler/xlf/FSComp.txt.ko.xlf +++ b/src/Compiler/xlf/FSComp.txt.ko.xlf @@ -307,6 +307,11 @@ nameof + + Nested record field copy-and-update + Nested record field copy-and-update + + String values marked as literals and IL constants as printf format String values marked as literals and IL constants as printf format diff --git a/src/Compiler/xlf/FSComp.txt.pl.xlf b/src/Compiler/xlf/FSComp.txt.pl.xlf index 31ffd49b289..fb81f9705fd 100644 --- a/src/Compiler/xlf/FSComp.txt.pl.xlf +++ b/src/Compiler/xlf/FSComp.txt.pl.xlf @@ -307,6 +307,11 @@ nameof + + Nested record field copy-and-update + Nested record field copy-and-update + + String values marked as literals and IL constants as printf format String values marked as literals and IL constants as printf format diff --git a/src/Compiler/xlf/FSComp.txt.pt-BR.xlf b/src/Compiler/xlf/FSComp.txt.pt-BR.xlf index 95e059af656..5053ea10695 100644 --- a/src/Compiler/xlf/FSComp.txt.pt-BR.xlf +++ b/src/Compiler/xlf/FSComp.txt.pt-BR.xlf @@ -307,6 +307,11 @@ nameof + + Nested record field copy-and-update + Nested record field copy-and-update + + String values marked as literals and IL constants as printf format String values marked as literals and IL constants as printf format diff --git a/src/Compiler/xlf/FSComp.txt.ru.xlf b/src/Compiler/xlf/FSComp.txt.ru.xlf index c0103a792b6..9a91b271642 100644 --- a/src/Compiler/xlf/FSComp.txt.ru.xlf +++ b/src/Compiler/xlf/FSComp.txt.ru.xlf @@ -307,6 +307,11 @@ nameof + + Nested record field copy-and-update + Nested record field copy-and-update + + String values marked as literals and IL constants as printf format String values marked as literals and IL constants as printf format diff --git a/src/Compiler/xlf/FSComp.txt.tr.xlf b/src/Compiler/xlf/FSComp.txt.tr.xlf index 122ef5f06c9..4ca0ea46457 100644 --- a/src/Compiler/xlf/FSComp.txt.tr.xlf +++ b/src/Compiler/xlf/FSComp.txt.tr.xlf @@ -307,6 +307,11 @@ nameof + + Nested record field copy-and-update + Nested record field copy-and-update + + String values marked as literals and IL constants as printf format String values marked as literals and IL constants as printf format diff --git a/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf b/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf index c304296d55d..f66db30aba7 100644 --- a/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf +++ b/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf @@ -307,6 +307,11 @@ nameof + + Nested record field copy-and-update + Nested record field copy-and-update + + String values marked as literals and IL constants as printf format String values marked as literals and IL constants as printf format diff --git a/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf b/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf index a5a3e73039b..4a1793cc7c5 100644 --- a/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf +++ b/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf @@ -307,6 +307,11 @@ nameof + + Nested record field copy-and-update + Nested record field copy-and-update + + String values marked as literals and IL constants as printf format String values marked as literals and IL constants as printf format From 2a5024f9cded432323467a585c8b25f4879d7377 Mon Sep 17 00:00:00 2001 From: kerams Date: Tue, 28 Feb 2023 17:41:49 +0100 Subject: [PATCH 08/32] Fix tests --- ...p.Compiler.Service.SurfaceArea.netstandard20.release.bsl | 3 --- .../data/SyntaxTree/Expression/AnonymousRecords-01.fs.bsl | 4 ++-- .../data/SyntaxTree/Expression/AnonymousRecords-02.fs.bsl | 4 ++-- .../data/SyntaxTree/Expression/AnonymousRecords-03.fs.bsl | 2 +- .../Expression/SynExprAnonRecdWithStructKeyword.fs.bsl | 2 +- ...nRecordContainsTheRangeOfTheEqualsSignInTheFields.fs.bsl | 6 +++--- 6 files changed, 9 insertions(+), 12 deletions(-) diff --git a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.release.bsl b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.release.bsl index a4219141841..068e378423f 100644 --- a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.release.bsl +++ b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.release.bsl @@ -6166,8 +6166,6 @@ FSharp.Compiler.Syntax.SynExpr+AnonRecd: FSharp.Compiler.SyntaxTrivia.SynExprAno FSharp.Compiler.Syntax.SynExpr+AnonRecd: FSharp.Compiler.SyntaxTrivia.SynExprAnonRecdTrivia trivia FSharp.Compiler.Syntax.SynExpr+AnonRecd: FSharp.Compiler.Text.Range get_range() FSharp.Compiler.Syntax.SynExpr+AnonRecd: FSharp.Compiler.Text.Range range -FSharp.Compiler.Syntax.SynExpr+AnonRecd: Microsoft.FSharp.Collections.FSharpList`1[System.Tuple`3[FSharp.Compiler.Syntax.Ident,Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range],FSharp.Compiler.Syntax.SynExpr]] get_recordFields() -FSharp.Compiler.Syntax.SynExpr+AnonRecd: Microsoft.FSharp.Collections.FSharpList`1[System.Tuple`3[FSharp.Compiler.Syntax.Ident,Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range],FSharp.Compiler.Syntax.SynExpr]] recordFields FSharp.Compiler.Syntax.SynExpr+AnonRecd: Microsoft.FSharp.Collections.FSharpList`1[System.Tuple`3[Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.Ident],Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range],FSharp.Compiler.Syntax.SynExpr]] get_recordFields() FSharp.Compiler.Syntax.SynExpr+AnonRecd: Microsoft.FSharp.Collections.FSharpList`1[System.Tuple`3[Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.Ident],Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range],FSharp.Compiler.Syntax.SynExpr]] recordFields FSharp.Compiler.Syntax.SynExpr+AnonRecd: Microsoft.FSharp.Core.FSharpOption`1[System.Tuple`2[FSharp.Compiler.Syntax.SynExpr,System.Tuple`2[FSharp.Compiler.Text.Range,Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Position]]]] copyInfo @@ -6907,7 +6905,6 @@ FSharp.Compiler.Syntax.SynExpr: Boolean get_IsWhile() FSharp.Compiler.Syntax.SynExpr: Boolean get_IsYieldOrReturn() FSharp.Compiler.Syntax.SynExpr: Boolean get_IsYieldOrReturnFrom() FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewAddressOf(Boolean, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Text.Range, FSharp.Compiler.Text.Range) -FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewAnonRecd(Boolean, Microsoft.FSharp.Core.FSharpOption`1[System.Tuple`2[FSharp.Compiler.Syntax.SynExpr,System.Tuple`2[FSharp.Compiler.Text.Range,Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Position]]]], Microsoft.FSharp.Collections.FSharpList`1[System.Tuple`3[FSharp.Compiler.Syntax.Ident,Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range],FSharp.Compiler.Syntax.SynExpr]], FSharp.Compiler.Text.Range, FSharp.Compiler.SyntaxTrivia.SynExprAnonRecdTrivia) FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewAnonRecd(Boolean, Microsoft.FSharp.Core.FSharpOption`1[System.Tuple`2[FSharp.Compiler.Syntax.SynExpr,System.Tuple`2[FSharp.Compiler.Text.Range,Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Position]]]], Microsoft.FSharp.Collections.FSharpList`1[System.Tuple`3[Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.Ident],Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range],FSharp.Compiler.Syntax.SynExpr]], FSharp.Compiler.Text.Range, FSharp.Compiler.SyntaxTrivia.SynExprAnonRecdTrivia) FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewApp(FSharp.Compiler.Syntax.ExprAtomicFlag, Boolean, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewArbitraryAfterError(System.String, FSharp.Compiler.Text.Range) diff --git a/tests/service/data/SyntaxTree/Expression/AnonymousRecords-01.fs.bsl b/tests/service/data/SyntaxTree/Expression/AnonymousRecords-01.fs.bsl index 6afab716003..3044302d586 100644 --- a/tests/service/data/SyntaxTree/Expression/AnonymousRecords-01.fs.bsl +++ b/tests/service/data/SyntaxTree/Expression/AnonymousRecords-01.fs.bsl @@ -7,12 +7,12 @@ ImplFile [Expr (AnonRecd (false, None, - [(X, Some (1,5--1,6), Const (Int32 1, (1,7--1,8)))], + [([X], Some (1,5--1,6), Const (Int32 1, (1,7--1,8)))], (1,0--1,11), { OpeningBraceRange = (1,0--1,2) }), (1,0--1,11)); Expr (AnonRecd (true, None, - [(Y, Some (2,12--2,13), Const (Int32 2, (2,14--2,15)))], + [([Y], Some (2,12--2,13), Const (Int32 2, (2,14--2,15)))], (2,0--2,18), { OpeningBraceRange = (2,7--2,9) }), (2,0--2,18)); Expr (AnonRecd diff --git a/tests/service/data/SyntaxTree/Expression/AnonymousRecords-02.fs.bsl b/tests/service/data/SyntaxTree/Expression/AnonymousRecords-02.fs.bsl index 762a3ce6168..743f18fe3fb 100644 --- a/tests/service/data/SyntaxTree/Expression/AnonymousRecords-02.fs.bsl +++ b/tests/service/data/SyntaxTree/Expression/AnonymousRecords-02.fs.bsl @@ -7,8 +7,8 @@ ImplFile [Expr (AnonRecd (false, None, - [(X, Some (1,5--1,6), Const (Int32 0, (1,7--1,8)))], (1,0--2,0), - { OpeningBraceRange = (1,0--1,2) }), (1,0--2,0))], + [([X], Some (1,5--1,6), Const (Int32 0, (1,7--1,8)))], + (1,0--2,0), { OpeningBraceRange = (1,0--1,2) }), (1,0--2,0))], PreXmlDocEmpty, [], None, (1,0--2,0), { LeadingKeyword = None })], (true, false), { ConditionalDirectives = [] CodeComments = [] }, set [])) diff --git a/tests/service/data/SyntaxTree/Expression/AnonymousRecords-03.fs.bsl b/tests/service/data/SyntaxTree/Expression/AnonymousRecords-03.fs.bsl index 321d08b8859..9d074eff5f0 100644 --- a/tests/service/data/SyntaxTree/Expression/AnonymousRecords-03.fs.bsl +++ b/tests/service/data/SyntaxTree/Expression/AnonymousRecords-03.fs.bsl @@ -7,7 +7,7 @@ ImplFile [Expr (AnonRecd (true, None, - [(X, Some (1,12--1,13), Const (Int32 0, (1,14--1,15)))], + [([X], Some (1,12--1,13), Const (Int32 0, (1,14--1,15)))], (1,0--2,0), { OpeningBraceRange = (1,7--1,9) }), (1,0--2,0))], PreXmlDocEmpty, [], None, (1,0--2,0), { LeadingKeyword = None })], (true, false), { ConditionalDirectives = [] diff --git a/tests/service/data/SyntaxTree/Expression/SynExprAnonRecdWithStructKeyword.fs.bsl b/tests/service/data/SyntaxTree/Expression/SynExprAnonRecdWithStructKeyword.fs.bsl index 44387eb400f..0e88962ed59 100644 --- a/tests/service/data/SyntaxTree/Expression/SynExprAnonRecdWithStructKeyword.fs.bsl +++ b/tests/service/data/SyntaxTree/Expression/SynExprAnonRecdWithStructKeyword.fs.bsl @@ -6,7 +6,7 @@ ImplFile ([SynExprAnonRecdWithStructKeyword], false, AnonModule, [Expr (AnonRecd - (true, None, [(Foo, Some (3,11--3,12), Ident someValue)], + (true, None, [([Foo], Some (3,11--3,12), Ident someValue)], (2,0--5,16), { OpeningBraceRange = (3,4--3,6) }), (2,0--5,16)); Expr (AnonRecd diff --git a/tests/service/data/SyntaxTree/Expression/SynExprAnonRecordContainsTheRangeOfTheEqualsSignInTheFields.fs.bsl b/tests/service/data/SyntaxTree/Expression/SynExprAnonRecordContainsTheRangeOfTheEqualsSignInTheFields.fs.bsl index d9e0728c813..8cf0a14298b 100644 --- a/tests/service/data/SyntaxTree/Expression/SynExprAnonRecordContainsTheRangeOfTheEqualsSignInTheFields.fs.bsl +++ b/tests/service/data/SyntaxTree/Expression/SynExprAnonRecordContainsTheRangeOfTheEqualsSignInTheFields.fs.bsl @@ -10,9 +10,9 @@ ImplFile [Expr (AnonRecd (false, None, - [(X, Some (2,5--2,6), Const (Int32 5, (2,7--2,8))); - (Y, Some (3,8--3,9), Const (Int32 6, (3,10--3,11))); - (Z, Some (4,12--4,13), Const (Int32 7, (4,14--4,15)))], + [([X], Some (2,5--2,6), Const (Int32 5, (2,7--2,8))); + ([Y], Some (3,8--3,9), Const (Int32 6, (3,10--3,11))); + ([Z], Some (4,12--4,13), Const (Int32 7, (4,14--4,15)))], (2,0--4,18), { OpeningBraceRange = (2,0--2,2) }), (2,0--4,18))], PreXmlDocEmpty, [], None, (2,0--4,18), { LeadingKeyword = None })], (true, false), { ConditionalDirectives = [] From f1451260530cbc7f670243289b10eecd8697145a Mon Sep 17 00:00:00 2001 From: kerams Date: Tue, 28 Feb 2023 18:46:03 +0100 Subject: [PATCH 09/32] Refactor --- src/Compiler/Checking/CheckExpressions.fs | 40 +++++++++++------------ 1 file changed, 20 insertions(+), 20 deletions(-) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 7d8e7b3370a..f3765961fa1 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -1877,7 +1877,7 @@ let GroupUpdatesToNestedFields (fields: (bool * (Ident list * Ident) * SynExpr o groupIfNested [] fields) /// Expands a long identifier into nested copy-and-update expressions -let TransformAstForNestedUpdates cenv env overallTy (lid: LongIdent) v withExpr = +let TransformAstForNestedUpdates cenv env overallTy (lid: LongIdent) exprBeingAssigned withExpr = let recdExprCopyInfo ids withExpr id = let upToId origSepRng id lidwd = let rec buildLid res (id: Ident) = @@ -1917,12 +1917,11 @@ let TransformAstForNestedUpdates cenv env overallTy (lid: LongIdent) v withExpr Some (SynExpr.LongIdent (false, LongIdentWithDots(lid, rng), None, totalRange origId id), (rangeOfBlockSeperator id, None)) // TODO: id.idRange should be the range of the next separator | _ -> None - let rec synExprRecd copyInfo (id: Ident) fields v = + let rec synExprRecd copyInfo (id: Ident) fields exprBeingAssigned = match fields with | [] -> failwith "unreachable" | (fldId, isAnon) :: rest -> - // todo the unit - let nestedField = if rest.IsEmpty then Option.defaultValue (mkSynUnit range0) v else synExprRecd copyInfo fldId rest v + let nestedField = if rest.IsEmpty then exprBeingAssigned else synExprRecd copyInfo fldId rest exprBeingAssigned if isAnon then // The correct structness will later be taken from the anynymous type, which already exists @@ -1934,12 +1933,12 @@ let TransformAstForNestedUpdates cenv env overallTy (lid: LongIdent) v withExpr match access, flds with | [], [] -> None - | accessIds, [] -> Some (false, List.frontAndBack accessIds, v) - | accessIds, [ (fldId, _) ] -> Some (false, List.frontAndBack (accessIds @ [ fldId ]), v) + | accessIds, [] -> Some (false, List.frontAndBack accessIds, Some exprBeingAssigned) + | accessIds, [ (fldId, _) ] -> Some (false, List.frontAndBack (accessIds @ [ fldId ]), Some exprBeingAssigned) | accessIds, (fldId, _) :: rest -> checkLanguageFeatureAndRecover cenv.g.langVersion LanguageFeature.NestedCopyAndUpdate (rangeOfLid lid) - // todo remove the other some - Some (true, (accessIds, fldId), Some (synExprRecd (recdExprCopyInfo (flds |> List.map fst) withExpr) fldId rest v)) + + Some (true, (accessIds, fldId), Some (synExprRecd (recdExprCopyInfo (flds |> List.map fst) withExpr) fldId rest exprBeingAssigned)) let rec ApplyUnionCaseOrExn (makerForUnionCase, makerForExnTag) m (cenv: cenv) env overallTy item = let g = cenv.g @@ -7404,7 +7403,7 @@ and TcRecdExpr cenv overallTy env tpenv (inherits, withExprOpt, synRecdFields, m let fldsList, containsNestedUpdates = let flds = synRecdFields - |> List.choose (fun (SynExprRecordField (fieldName = (synLongId, isOk); expr = v)) -> + |> List.choose (fun (SynExprRecordField (fieldName = (synLongId, isOk); expr = exprBeingAssigned)) -> // if we met at least one field that is not syntactically correct - raise ReportedError to transfer control to the recovery routine if not isOk then // raising ReportedError None transfers control to the closest errorRecovery point but do not make any records into log @@ -7413,11 +7412,12 @@ and TcRecdExpr cenv overallTy env tpenv (inherits, withExprOpt, synRecdFields, m match withExprOpt with | Some withExpr -> - match synLongId.LongIdent with - | [] -> None - | [ id ] -> Some (false, ([], id), v) - | lid -> TransformAstForNestedUpdates cenv env overallTy lid v withExpr - | _ -> Some (false, List.frontAndBack synLongId.LongIdent, v)) + match synLongId.LongIdent, exprBeingAssigned with + | [], _ -> None + | [ id ], _ -> Some (false, ([], id), exprBeingAssigned) + | lid, Some exprBeingAssigned -> TransformAstForNestedUpdates cenv env overallTy lid exprBeingAssigned withExpr + | _ -> Some (false, List.frontAndBack synLongId.LongIdent, exprBeingAssigned) + | _ -> Some (false, List.frontAndBack synLongId.LongIdent, exprBeingAssigned)) let flds = if hasOrigExpr then GroupUpdatesToNestedFields flds else flds @@ -7497,8 +7497,8 @@ and TcAnonRecdExpr cenv (overallTy: TType) env tpenv (isStruct, optOrigSynExpr, | None -> TcNewAnonRecdExpr cenv overallTy env tpenv (isStruct, unsortedFieldIdsAndSynExprsGiven, mWholeExpr) - | Some (origExpr, _) -> - TcCopyAndUpdateAnonRecdExpr cenv overallTy env tpenv (isStruct, origExpr, unsortedFieldIdsAndSynExprsGiven, mWholeExpr) + | Some orig -> + TcCopyAndUpdateAnonRecdExpr cenv overallTy env tpenv (isStruct, orig, unsortedFieldIdsAndSynExprsGiven, mWholeExpr) and TcNewAnonRecdExpr cenv (overallTy: TType) env tpenv (isStruct, unsortedFieldIdsAndSynExprsGiven, mWholeExpr) = @@ -7534,7 +7534,7 @@ and TcNewAnonRecdExpr cenv (overallTy: TType) env tpenv (isStruct, unsortedField mkAnonRecd g mWholeExpr anonInfo unsortedFieldIds unsortedCheckedArgs unsortedFieldTys, tpenv -and TcCopyAndUpdateAnonRecdExpr cenv (overallTy: TType) env tpenv (isStruct, origExpr, unsortedFieldIdsAndSynExprsGiven, mWholeExpr) = +and TcCopyAndUpdateAnonRecdExpr cenv (overallTy: TType) env tpenv (isStruct, (origExpr, blockSeparator), unsortedFieldIdsAndSynExprsGiven, mWholeExpr) = // The fairly complex case '{| origExpr with X = 1; Y = 2 |}' // The origExpr may be either a record or anonymous record. // The origExpr may be either a struct or not. @@ -7556,11 +7556,11 @@ and TcCopyAndUpdateAnonRecdExpr cenv (overallTy: TType) env tpenv (isStruct, ori // Expand expressions with respect to potential nesting let unsortedFieldIdsAndSynExprsGiven = unsortedFieldIdsAndSynExprsGiven - |> List.choose (fun (lid, _, e) -> + |> List.choose (fun (lid, _, exprBeingAssigned) -> match lid with | [] -> None - | [ id ] -> Some (false, ([], id), Some e) // todo remove options - | lid -> TransformAstForNestedUpdates cenv env origExprTy lid (Some e) (origExpr, (range0, range0))) + | [ id ] -> Some (false, ([], id), Some exprBeingAssigned) + | lid -> TransformAstForNestedUpdates cenv env origExprTy lid exprBeingAssigned (origExpr, blockSeparator)) |> GroupUpdatesToNestedFields let unsortedFieldSynExprsGiven = unsortedFieldIdsAndSynExprsGiven |> List.map (fun (_, _, e) -> e.Value) //todo From 0081cea77c109518d2c76a7a5d939ff2d6d2b8e5 Mon Sep 17 00:00:00 2001 From: kerams Date: Tue, 28 Feb 2023 19:33:09 +0100 Subject: [PATCH 10/32] Refactor --- src/Compiler/Checking/CheckExpressions.fs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index f3765961fa1..d655e9fa49c 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -16,7 +16,6 @@ open FSharp.Compiler open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AccessibilityLogic open FSharp.Compiler.AttributeChecking -open FSharp.Compiler.CompilerGlobalState open FSharp.Compiler.CheckBasics open FSharp.Compiler.ConstraintSolver open FSharp.Compiler.DiagnosticsLogger @@ -7563,7 +7562,7 @@ and TcCopyAndUpdateAnonRecdExpr cenv (overallTy: TType) env tpenv (isStruct, (or | lid -> TransformAstForNestedUpdates cenv env origExprTy lid exprBeingAssigned (origExpr, blockSeparator)) |> GroupUpdatesToNestedFields - let unsortedFieldSynExprsGiven = unsortedFieldIdsAndSynExprsGiven |> List.map (fun (_, _, e) -> e.Value) //todo + let unsortedFieldSynExprsGiven = unsortedFieldIdsAndSynExprsGiven |> List.choose p33 let origExprIsStruct = match tryDestAnonRecdTy g origExprTy with From f973574e157b3cfa10a6352c8a36b70650cd73ec Mon Sep 17 00:00:00 2001 From: kerams Date: Tue, 28 Feb 2023 19:34:26 +0100 Subject: [PATCH 11/32] Format --- src/Compiler/Service/FSharpCheckerResults.fs | 17 +++++++++++------ 1 file changed, 11 insertions(+), 6 deletions(-) diff --git a/src/Compiler/Service/FSharpCheckerResults.fs b/src/Compiler/Service/FSharpCheckerResults.fs index 8c6cb3a4ec1..3663e31b2eb 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fs +++ b/src/Compiler/Service/FSharpCheckerResults.fs @@ -672,11 +672,12 @@ type internal TypeCheckInfo | ValueSome (anonInfo, tys) -> match plid with | [] -> - let items = [ - for i in 0 .. anonInfo.SortedIds.Length - 1 do - Item.AnonRecdField (anonInfo, tys, i, anonInfo.SortedIds[i].idRange) - ] - + let items = + [ + for i in 0 .. anonInfo.SortedIds.Length - 1 do + Item.AnonRecdField(anonInfo, tys, i, anonInfo.SortedIds[i].idRange) + ] + Some(items, denv, m) | id :: rest -> match anonInfo.SortedNames |> Array.tryFindIndex (fun x -> x = id) with @@ -684,7 +685,11 @@ type internal TypeCheckInfo | _ -> Some([], denv, m) | ValueNone -> Some([], denv, m) - match GetExprTypingForPosition identRange.End |> snd |> Array.tryFind (fun (_, _, _, rq) -> posEq identRange.Start rq.Start) with + match + GetExprTypingForPosition identRange.End + |> snd + |> Array.tryFind (fun (_, _, _, rq) -> posEq identRange.Start rq.Start) + with | Some (ty, nenv, ad, m) -> dive ty nenv.DisplayEnv ad m plid false plid.IsEmpty | _ -> None From 670f5c56d6046c7621d21bcb0184d22ce25fa3ec Mon Sep 17 00:00:00 2001 From: kerams Date: Tue, 28 Feb 2023 22:02:44 +0100 Subject: [PATCH 12/32] Fix resolution priority --- src/Compiler/Checking/NameResolution.fs | 21 +++++++++------------ 1 file changed, 9 insertions(+), 12 deletions(-) diff --git a/src/Compiler/Checking/NameResolution.fs b/src/Compiler/Checking/NameResolution.fs index 1a447f0cf02..04c0bb1b933 100644 --- a/src/Compiler/Checking/NameResolution.fs +++ b/src/Compiler/Checking/NameResolution.fs @@ -3710,7 +3710,6 @@ let ResolveNestedField sink (ncenv: NameResolver) nenv ad ty lid = let otherRecdFlds ty = let typeName = NicePrint.minimalStringOfType nenv.eDisplayEnv ty - // todo investigate refactoring [ for KeyValue (_, v) in nenv.eFieldLabels do match v |> List.tryFind (fun r -> r.TyconRef.DisplayName = typeName) with @@ -3760,8 +3759,8 @@ let ResolveNestedField sink (ncenv: NameResolver) nenv ad ty lid = match x with | Choice1Of2 (FieldResolution (rfinfo, dep)) -> let ref = rfinfo.RecdFieldRef - Choice1Of2(FieldResolution(rfinfo, dep)), ref.FieldName, ref.RecdField.FormalType, rest - | Choice2Of2 (anonInfo, tys, index) -> Choice2Of2(anonInfo, tys, index), anonInfo.SortedNames[index], tys[index], rest) + Choice1Of2(FieldResolution(rfinfo, dep)), id.idRange, ref.RecdField.FormalType, rest + | Choice2Of2 (anonInfo, tys, index) -> Choice2Of2(anonInfo, tys, index), id.idRange, tys[index], rest) | _ -> NoResultsOrUsefulErrors let tyconSearch ad () = @@ -3770,15 +3769,15 @@ let ResolveNestedField sink (ncenv: NameResolver) nenv ad ty lid = let m = tn.idRange let tcrefs = LookupTypeNameInEnvNoArity OpenQualified tn.idText nenv if isNil tcrefs then NoResultsOrUsefulErrors else - let tcrefs = tcrefs |> List.map (fun tcref -> (ResolutionInfo.Empty, tcref)) + let tcrefs = tcrefs |> List.map (fun tcref -> ResolutionInfo.Empty, tcref) ResolveLongIdentInTyconRefs ResultCollectionSettings.AllResults ncenv nenv LookupKind.RecdField 1 m ad id rest typeNameResInfo tn.idRange tcrefs |?> List.choose (fun x -> match x with | _, Item.RecdField (RecdFieldInfo (_, rfref)), rest -> - (Choice1Of2(FieldResolution(FreshenRecdFieldRef ncenv m rfref, false)), rfref.FieldName, rfref.RecdField.FormalType, rest) |> Some + (Choice1Of2(FieldResolution(FreshenRecdFieldRef ncenv m rfref, false)), m, rfref.RecdField.FormalType, rest) |> Some | _, Item.AnonRecdField (anonInfo, tys, i, _), rest -> - (Choice2Of2(anonInfo, tys, i), anonInfo.SortedNames[i], tys[i], rest) |> Some + (Choice2Of2(anonInfo, tys, i), m, tys[i], rest) |> Some | _ -> None) | _ -> NoResultsOrUsefulErrors @@ -3790,15 +3789,14 @@ let ResolveNestedField sink (ncenv: NameResolver) nenv ad ty lid = ResolveLongIdentAsModuleOrNamespaceThen sink ResultCollectionSettings.AtMostOneResult ncenv.amap m OpenQualified nenv ad id rest false (ResolveFieldInModuleOrNamespace ncenv nenv ad) |?> List.map (fun (_, FieldResolution(rfinfo, dep), rest) -> - let ref = rfinfo.RecdFieldRef - Choice1Of2(FieldResolution(rfinfo, dep)), ref.FieldName, ref.RecdField.FormalType, rest) + Choice1Of2(FieldResolution(rfinfo, dep)), m, rfinfo.RecdFieldRef.RecdField.FormalType, rest) - let item, fldIdText, fldTy, rest = + let item, fldRange, fldTy, rest = let search = if isAnonRecd then fldSearch () else - fldSearch () +++ moduleOrNsSearch ad +++ tyconSearch ad +++ moduleOrNsSearch AccessibleFromSomeFSharpCode +++ tyconSearch AccessibleFromSomeFSharpCode + moduleOrNsSearch ad () +++ tyconSearch ad +++ moduleOrNsSearch AccessibleFromSomeFSharpCode +++ tyconSearch AccessibleFromSomeFSharpCode +++ fldSearch search |> AtMostOneResult id.idRange @@ -3808,8 +3806,7 @@ let ResolveNestedField sink (ncenv: NameResolver) nenv ad ty lid = if isAnonRecd then [] else - // todo questionable - match by range? - lid |> List.takeWhile (fun id -> id.idText <> fldIdText) + lid |> List.takeWhile (fun id -> id.idRange <> fldRange) match rest with | [] -> idsBeforeField, [ item ] From 71abfae5173aaa5ddd6b5f67740542222383f928 Mon Sep 17 00:00:00 2001 From: kerams Date: Wed, 1 Mar 2023 14:24:21 +0100 Subject: [PATCH 13/32] Fix and refactor --- src/Compiler/Checking/NameResolution.fs | 203 +++++++++--------- .../Record - Anon - Field 01.fs.bsl | 2 +- 2 files changed, 99 insertions(+), 106 deletions(-) diff --git a/src/Compiler/Checking/NameResolution.fs b/src/Compiler/Checking/NameResolution.fs index 04c0bb1b933..c8ebc49ece1 100644 --- a/src/Compiler/Checking/NameResolution.fs +++ b/src/Compiler/Checking/NameResolution.fs @@ -3696,7 +3696,7 @@ let ResolveField sink ncenv nenv ad ty mp id allFields = let ResolveNestedField sink (ncenv: NameResolver) nenv ad ty lid = let typeNameResInfo = TypeNameResolutionInfo.Default let g = ncenv.g - let isAnonRecd = isAnonRecdTy g ty + let isAnonRecdTy = isAnonRecdTy g ty let lookupFld ty (id: Ident) = let m = id.idRange @@ -3704,8 +3704,8 @@ let ResolveNestedField sink (ncenv: NameResolver) nenv ad ty lid = match tryDestAnonRecdTy g ty with | ValueSome (anonInfo, tys) -> match anonInfo.SortedNames |> Array.tryFindIndex (fun x -> x = id.idText) with - | Some index -> Result [ Choice2Of2 (anonInfo, tys, index) ] - | _ -> NoResultsOrUsefulErrors + | Some index -> OneSuccess (Choice2Of2 (anonInfo, tys, index)) + | _ -> raze (Error(FSComp.SR.nrRecordDoesNotContainSuchLabel(NicePrint.minimalStringOfType nenv.eDisplayEnv ty, id.idText), m)) | _ -> let otherRecdFlds ty = let typeName = NicePrint.minimalStringOfType nenv.eDisplayEnv ty @@ -3717,10 +3717,22 @@ let ResolveNestedField sink (ncenv: NameResolver) nenv ad ty lid = | None -> () ] - let lookup() = + if isRecdTy g ty then + match ncenv.InfoReader.TryFindRecdOrClassFieldInfoOfType(id.idText, m, ty) with + | ValueSome (RecdFieldInfo (_, rfref)) -> OneSuccess (Choice1Of2(FieldResolution(FreshenRecdFieldRef ncenv m rfref, false))) + | _ -> + // record label doesn't belong to record type -> suggest other labels of same record + let suggestLabels addToBuffer = + for label in SuggestOtherLabelsOfSameRecordType g nenv ty id (otherRecdFlds ty) do + addToBuffer label + + let typeName = NicePrint.minimalStringOfType nenv.eDisplayEnv ty + let errorText = FSComp.SR.nrRecordDoesNotContainSuchLabel(typeName,id.idText) + raze (ErrorWithSuggestions(errorText, m, id.idText, suggestLabels)) + else let frefs = match Map.tryFind id.idText nenv.eFieldLabels with - | Some field -> success field + | Some fields -> success fields | None -> raze (SuggestLabelsOfRelatedRecords g nenv id (otherRecdFlds ty)) // Eliminate duplicates arising from multiple 'open' @@ -3728,114 +3740,95 @@ let ResolveNestedField sink (ncenv: NameResolver) nenv ad ty lid = |?> ListSet.setify (fun fref1 fref2 -> tyconRefEq g fref1.TyconRef fref2.TyconRef) |?> List.map (fun rfref -> Choice1Of2(FieldResolution(FreshenRecdFieldRef ncenv m rfref, false))) - if isAppTy g ty then - match ncenv.InfoReader.TryFindRecdOrClassFieldInfoOfType(id.idText, m, ty) with - | ValueSome (RecdFieldInfo (_, rfref)) -> success [ Choice1Of2(FieldResolution(FreshenRecdFieldRef ncenv m rfref, false)) ] - | _ -> - if isRecdTy g ty then - // record label doesn't belong to record type -> suggest other labels of same record - let suggestLabels addToBuffer = - for label in SuggestOtherLabelsOfSameRecordType g nenv ty id (otherRecdFlds ty) do - addToBuffer label - - let typeName = NicePrint.minimalStringOfType nenv.eDisplayEnv ty - let errorText = FSComp.SR.nrRecordDoesNotContainSuchLabel(typeName,id.idText) - raze (ErrorWithSuggestions(errorText, m, id.idText, suggestLabels)) - else - lookup() - else - lookup() + let isAnonRecdField field = + match field with + | Choice1Of2 _ -> false + | Choice2Of2 _ -> true - let access, flds = - match lid with - | [] -> [], [] - | [ id ] -> [], lookupFld ty id |> ForceRaise - | id :: _ -> - let fldSearch () = - match lid with - | id :: rest -> - lookupFld ty id - |?> List.map (fun x -> - match x with - | Choice1Of2 (FieldResolution (rfinfo, dep)) -> - let ref = rfinfo.RecdFieldRef - Choice1Of2(FieldResolution(rfinfo, dep)), id.idRange, ref.RecdField.FormalType, rest - | Choice2Of2 (anonInfo, tys, index) -> Choice2Of2(anonInfo, tys, index), id.idRange, tys[index], rest) - | _ -> NoResultsOrUsefulErrors + match lid with + | [] -> [], [] + | [ id ] -> + let res = + lookupFld ty id + |> ForceRaise + |> List.map (fun x -> id, isAnonRecdField x) - let tyconSearch ad () = - match lid with - | tn :: id :: rest -> - let m = tn.idRange - let tcrefs = LookupTypeNameInEnvNoArity OpenQualified tn.idText nenv - if isNil tcrefs then NoResultsOrUsefulErrors else - let tcrefs = tcrefs |> List.map (fun tcref -> ResolutionInfo.Empty, tcref) - - ResolveLongIdentInTyconRefs ResultCollectionSettings.AllResults ncenv nenv LookupKind.RecdField 1 m ad id rest typeNameResInfo tn.idRange tcrefs - |?> List.choose (fun x -> - match x with - | _, Item.RecdField (RecdFieldInfo (_, rfref)), rest -> - (Choice1Of2(FieldResolution(FreshenRecdFieldRef ncenv m rfref, false)), m, rfref.RecdField.FormalType, rest) |> Some - | _, Item.AnonRecdField (anonInfo, tys, i, _), rest -> - (Choice2Of2(anonInfo, tys, i), m, tys[i], rest) |> Some - | _ -> None) - | _ -> NoResultsOrUsefulErrors + [], res + | id :: _ -> + let fldSearch () = + match lid with + | id :: rest -> + lookupFld ty id + |?> List.map (fun x -> + match x with + | Choice1Of2 (FieldResolution (rfinfo, dep)) -> + let ref = rfinfo.RecdFieldRef + Choice1Of2(FieldResolution(rfinfo, dep)), id, ref.RecdField.FormalType, rest + | Choice2Of2 (anonInfo, tys, index) -> Choice2Of2(anonInfo, tys, index), id, tys[index], rest) + | _ -> NoResultsOrUsefulErrors - let moduleOrNsSearch ad () = - match lid with - | [] -> NoResultsOrUsefulErrors - | id :: rest -> - let m = id.idRange + let tyconSearch ad () = + match lid with + | tyconId :: fieldId :: rest -> + let tcrefs = LookupTypeNameInEnvNoArity OpenQualified tyconId.idText nenv + if isNil tcrefs then NoResultsOrUsefulErrors else + let tcrefs = tcrefs |> List.map (fun tcref -> ResolutionInfo.Empty, tcref) + + ResolveLongIdentInTyconRefs ResultCollectionSettings.AllResults ncenv nenv LookupKind.RecdField 1 tyconId.idRange ad fieldId rest typeNameResInfo fieldId.idRange tcrefs + |?> List.choose (fun x -> + match x with + | _, Item.RecdField (RecdFieldInfo (_, rfref)), rest -> + (Choice1Of2(FieldResolution(FreshenRecdFieldRef ncenv fieldId.idRange rfref, false)), fieldId, rfref.RecdField.FormalType, rest) |> Some + | _, Item.AnonRecdField (anonInfo, tys, i, _), rest -> + (Choice2Of2(anonInfo, tys, i), fieldId, tys[i], rest) |> Some + | _ -> None) + | _ -> NoResultsOrUsefulErrors - ResolveLongIdentAsModuleOrNamespaceThen sink ResultCollectionSettings.AtMostOneResult ncenv.amap m OpenQualified nenv ad id rest false (ResolveFieldInModuleOrNamespace ncenv nenv ad) - |?> List.map (fun (_, FieldResolution(rfinfo, dep), rest) -> - Choice1Of2(FieldResolution(rfinfo, dep)), m, rfinfo.RecdFieldRef.RecdField.FormalType, rest) + let moduleOrNsSearch ad () = + match lid with + | [] -> NoResultsOrUsefulErrors + | modOrNsId :: rest -> + ResolveLongIdentAsModuleOrNamespaceThen sink ResultCollectionSettings.AtMostOneResult ncenv.amap modOrNsId.idRange OpenQualified nenv ad modOrNsId rest false (ResolveFieldInModuleOrNamespace ncenv nenv ad) + |?> List.map (fun (_, FieldResolution(rfinfo, dep), restAfterField) -> + let fieldId = rest.[ rest.Length - restAfterField.Length - 1 ] + Choice1Of2(FieldResolution(rfinfo, dep)), fieldId, rfinfo.RecdFieldRef.RecdField.FormalType, restAfterField) + + let item, fld, fldTy, rest = + let search = + if isAnonRecdTy then + fldSearch () + else + moduleOrNsSearch ad () +++ tyconSearch ad +++ moduleOrNsSearch AccessibleFromSomeFSharpCode +++ tyconSearch AccessibleFromSomeFSharpCode +++ fldSearch - let item, fldRange, fldTy, rest = - let search = - if isAnonRecd then - fldSearch () - else - moduleOrNsSearch ad () +++ tyconSearch ad +++ moduleOrNsSearch AccessibleFromSomeFSharpCode +++ tyconSearch AccessibleFromSomeFSharpCode +++ fldSearch + search + |> AtMostOneResult id.idRange + |> ForceRaise - search - |> AtMostOneResult id.idRange - |> ForceRaise + let idsBeforeField = + if isAnonRecdTy then + [] + else + lid |> List.takeWhile (fun id -> id.idRange <> fld.idRange) - let idsBeforeField = - if isAnonRecd then - [] - else - lid |> List.takeWhile (fun id -> id.idRange <> fldRange) + match rest with + | [] -> idsBeforeField, [ (fld, isAnonRecdField item) ] + | _ -> + let rec nestedFieldSearch flds ty = + function + | [] -> flds + | id :: rest -> + let resolved = lookupFld ty id |> ForceRaise + let fldTy = + match resolved with + | [ Choice1Of2 (FieldResolution (rfinfo, _)) ] -> rfinfo.RecdField.FormalType + | [ Choice2Of2 (_, tys, index) ] -> tys[index] + | _ -> ty - match rest with - | [] -> idsBeforeField, [ item ] - | _ -> - let rec nestedFieldSearch flds ty = - function - | [] -> flds - | id :: rest -> - let resolved = lookupFld ty id |> ForceRaise - let fldTy = - match resolved with - | [ Choice1Of2 (FieldResolution (rfinfo, _)) ] -> rfinfo.RecdField.FormalType - | [ Choice2Of2 (_, tys, index) ] -> tys[index] - | _ -> ty - nestedFieldSearch (flds @ resolved) fldTy rest - - idsBeforeField, item :: (nestedFieldSearch [] fldTy rest) - - let flds = - flds - |> List.map (fun x -> - let fieldName, isAnon = - match x with - | Choice1Of2 (FieldResolution (rfinfo, _)) -> rfinfo.RecdFieldRef.FieldName, false - | Choice2Of2 (anonInfo, _, i) -> anonInfo.SortedNames[i], true - - lid |> List.find (fun id -> id.idText = fieldName), isAnon) - - access, flds + let resolved = resolved |> List.map (fun x -> id, isAnonRecdField x) + + nestedFieldSearch (flds @ resolved) fldTy rest + + idsBeforeField, (fld, isAnonRecdField item) :: (nestedFieldSearch [] fldTy rest) /// Resolve F#/IL "." syntax in expressions (2). /// diff --git a/tests/service/data/SyntaxTree/Expression/Record - Anon - Field 01.fs.bsl b/tests/service/data/SyntaxTree/Expression/Record - Anon - Field 01.fs.bsl index f8825418def..282dc9023ce 100644 --- a/tests/service/data/SyntaxTree/Expression/Record - Anon - Field 01.fs.bsl +++ b/tests/service/data/SyntaxTree/Expression/Record - Anon - Field 01.fs.bsl @@ -7,7 +7,7 @@ ImplFile [Expr (AnonRecd (false, None, - [(A, Some (1,5--1,6), Const (Int32 1, (1,7--1,8)))], + [([A], Some (1,5--1,6), Const (Int32 1, (1,7--1,8)))], (1,0--1,11), { OpeningBraceRange = (1,0--1,2) }), (1,0--1,11))], PreXmlDocEmpty, [], None, (1,0--1,11), { LeadingKeyword = None })], (true, false), { ConditionalDirectives = [] From d2eced14db74f92ede80380ea528f221e1741cc1 Mon Sep 17 00:00:00 2001 From: kerams Date: Wed, 1 Mar 2023 17:25:44 +0100 Subject: [PATCH 14/32] Refactor --- src/Compiler/Checking/CheckExpressions.fs | 30 ++++++++++------------- src/Compiler/Checking/NameResolution.fs | 28 ++++++++++----------- 2 files changed, 27 insertions(+), 31 deletions(-) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index d655e9fa49c..d0937f314db 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -1913,7 +1913,7 @@ let TransformAstForNestedUpdates cenv env overallTy (lid: LongIdent) exprBeingAs match withExpr with | SynExpr.Ident origId, (sepRange, _) -> let lid, rng = upToId sepRange id (origId :: ids) - Some (SynExpr.LongIdent (false, LongIdentWithDots(lid, rng), None, totalRange origId id), (rangeOfBlockSeperator id, None)) // TODO: id.idRange should be the range of the next separator + Some (SynExpr.LongIdent (false, LongIdentWithDots(lid, rng), None, totalRange origId id), (rangeOfBlockSeperator id, None)) | _ -> None let rec synExprRecd copyInfo (id: Ident) fields exprBeingAssigned = @@ -1931,13 +1931,13 @@ let TransformAstForNestedUpdates cenv env overallTy (lid: LongIdent) exprBeingAs let access, flds = ResolveNestedField cenv.tcSink cenv.nameResolver env.eNameResEnv env.eAccessRights overallTy lid match access, flds with - | [], [] -> None - | accessIds, [] -> Some (false, List.frontAndBack accessIds, Some exprBeingAssigned) - | accessIds, [ (fldId, _) ] -> Some (false, List.frontAndBack (accessIds @ [ fldId ]), Some exprBeingAssigned) + | [], [] -> failwith "unreachable" + | accessIds, [] -> false, List.frontAndBack accessIds, Some exprBeingAssigned + | accessIds, [ (fldId, _) ] -> false, List.frontAndBack (accessIds @ [ fldId ]), Some exprBeingAssigned | accessIds, (fldId, _) :: rest -> checkLanguageFeatureAndRecover cenv.g.langVersion LanguageFeature.NestedCopyAndUpdate (rangeOfLid lid) - Some (true, (accessIds, fldId), Some (synExprRecd (recdExprCopyInfo (flds |> List.map fst) withExpr) fldId rest exprBeingAssigned)) + true, (accessIds, fldId), Some (synExprRecd (recdExprCopyInfo (flds |> List.map fst) withExpr) fldId rest exprBeingAssigned) let rec ApplyUnionCaseOrExn (makerForUnionCase, makerForExnTag) m (cenv: cenv) env overallTy item = let g = cenv.g @@ -7402,21 +7402,17 @@ and TcRecdExpr cenv overallTy env tpenv (inherits, withExprOpt, synRecdFields, m let fldsList, containsNestedUpdates = let flds = synRecdFields - |> List.choose (fun (SynExprRecordField (fieldName = (synLongId, isOk); expr = exprBeingAssigned)) -> + |> List.map (fun (SynExprRecordField (fieldName = (synLongId, isOk); expr = exprBeingAssigned)) -> // if we met at least one field that is not syntactically correct - raise ReportedError to transfer control to the recovery routine if not isOk then // raising ReportedError None transfers control to the closest errorRecovery point but do not make any records into log // we assume that parse errors were already reported raise (ReportedError None) - match withExprOpt with - | Some withExpr -> - match synLongId.LongIdent, exprBeingAssigned with - | [], _ -> None - | [ id ], _ -> Some (false, ([], id), exprBeingAssigned) - | lid, Some exprBeingAssigned -> TransformAstForNestedUpdates cenv env overallTy lid exprBeingAssigned withExpr - | _ -> Some (false, List.frontAndBack synLongId.LongIdent, exprBeingAssigned) - | _ -> Some (false, List.frontAndBack synLongId.LongIdent, exprBeingAssigned)) + match withExprOpt, synLongId.LongIdent, exprBeingAssigned with + | _, [ id ], _ -> false, ([], id), exprBeingAssigned + | Some withExpr, lid, Some exprBeingAssigned -> TransformAstForNestedUpdates cenv env overallTy lid exprBeingAssigned withExpr + | _ -> false, List.frontAndBack synLongId.LongIdent, exprBeingAssigned) let flds = if hasOrigExpr then GroupUpdatesToNestedFields flds else flds @@ -7555,10 +7551,10 @@ and TcCopyAndUpdateAnonRecdExpr cenv (overallTy: TType) env tpenv (isStruct, (or // Expand expressions with respect to potential nesting let unsortedFieldIdsAndSynExprsGiven = unsortedFieldIdsAndSynExprsGiven - |> List.choose (fun (lid, _, exprBeingAssigned) -> + |> List.map (fun (lid, _, exprBeingAssigned) -> match lid with - | [] -> None - | [ id ] -> Some (false, ([], id), Some exprBeingAssigned) + | [] -> error(Error(FSComp.SR.nrUnexpectedEmptyLongId(), mWholeExpr)) + | [ id ] -> false, ([], id), Some exprBeingAssigned | lid -> TransformAstForNestedUpdates cenv env origExprTy lid exprBeingAssigned (origExpr, blockSeparator)) |> GroupUpdatesToNestedFields diff --git a/src/Compiler/Checking/NameResolution.fs b/src/Compiler/Checking/NameResolution.fs index c8ebc49ece1..07b90c7e1fe 100644 --- a/src/Compiler/Checking/NameResolution.fs +++ b/src/Compiler/Checking/NameResolution.fs @@ -3740,7 +3740,7 @@ let ResolveNestedField sink (ncenv: NameResolver) nenv ad ty lid = |?> ListSet.setify (fun fref1 fref2 -> tyconRefEq g fref1.TyconRef fref2.TyconRef) |?> List.map (fun rfref -> Choice1Of2(FieldResolution(FreshenRecdFieldRef ncenv m rfref, false))) - let isAnonRecdField field = + let isAnonRecdFieldF field = match field with | Choice1Of2 _ -> false | Choice2Of2 _ -> true @@ -3751,7 +3751,7 @@ let ResolveNestedField sink (ncenv: NameResolver) nenv ad ty lid = let res = lookupFld ty id |> ForceRaise - |> List.map (fun x -> id, isAnonRecdField x) + |> List.map (fun x -> id, isAnonRecdFieldF x) [], res | id :: _ -> @@ -3761,10 +3761,10 @@ let ResolveNestedField sink (ncenv: NameResolver) nenv ad ty lid = lookupFld ty id |?> List.map (fun x -> match x with - | Choice1Of2 (FieldResolution (rfinfo, dep)) -> + | Choice1Of2 (FieldResolution (rfinfo, _)) -> let ref = rfinfo.RecdFieldRef - Choice1Of2(FieldResolution(rfinfo, dep)), id, ref.RecdField.FormalType, rest - | Choice2Of2 (anonInfo, tys, index) -> Choice2Of2(anonInfo, tys, index), id, tys[index], rest) + false, id, ref.RecdField.FormalType, rest + | Choice2Of2 (_, tys, index) -> true, id, tys[index], rest) | _ -> NoResultsOrUsefulErrors let tyconSearch ad () = @@ -3778,9 +3778,9 @@ let ResolveNestedField sink (ncenv: NameResolver) nenv ad ty lid = |?> List.choose (fun x -> match x with | _, Item.RecdField (RecdFieldInfo (_, rfref)), rest -> - (Choice1Of2(FieldResolution(FreshenRecdFieldRef ncenv fieldId.idRange rfref, false)), fieldId, rfref.RecdField.FormalType, rest) |> Some - | _, Item.AnonRecdField (anonInfo, tys, i, _), rest -> - (Choice2Of2(anonInfo, tys, i), fieldId, tys[i], rest) |> Some + (false, fieldId, rfref.RecdField.FormalType, rest) |> Some + | _, Item.AnonRecdField (_, tys, i, _), rest -> + (true, fieldId, tys[i], rest) |> Some | _ -> None) | _ -> NoResultsOrUsefulErrors @@ -3789,11 +3789,11 @@ let ResolveNestedField sink (ncenv: NameResolver) nenv ad ty lid = | [] -> NoResultsOrUsefulErrors | modOrNsId :: rest -> ResolveLongIdentAsModuleOrNamespaceThen sink ResultCollectionSettings.AtMostOneResult ncenv.amap modOrNsId.idRange OpenQualified nenv ad modOrNsId rest false (ResolveFieldInModuleOrNamespace ncenv nenv ad) - |?> List.map (fun (_, FieldResolution(rfinfo, dep), restAfterField) -> + |?> List.map (fun (_, FieldResolution(rfinfo, _), restAfterField) -> let fieldId = rest.[ rest.Length - restAfterField.Length - 1 ] - Choice1Of2(FieldResolution(rfinfo, dep)), fieldId, rfinfo.RecdFieldRef.RecdField.FormalType, restAfterField) + false, fieldId, rfinfo.RecdFieldRef.RecdField.FormalType, restAfterField) - let item, fld, fldTy, rest = + let isAnonRecdField, fld, fldTy, rest = let search = if isAnonRecdTy then fldSearch () @@ -3811,7 +3811,7 @@ let ResolveNestedField sink (ncenv: NameResolver) nenv ad ty lid = lid |> List.takeWhile (fun id -> id.idRange <> fld.idRange) match rest with - | [] -> idsBeforeField, [ (fld, isAnonRecdField item) ] + | [] -> idsBeforeField, [ (fld, isAnonRecdField) ] | _ -> let rec nestedFieldSearch flds ty = function @@ -3824,11 +3824,11 @@ let ResolveNestedField sink (ncenv: NameResolver) nenv ad ty lid = | [ Choice2Of2 (_, tys, index) ] -> tys[index] | _ -> ty - let resolved = resolved |> List.map (fun x -> id, isAnonRecdField x) + let resolved = resolved |> List.map (fun x -> id, isAnonRecdFieldF x) nestedFieldSearch (flds @ resolved) fldTy rest - idsBeforeField, (fld, isAnonRecdField item) :: (nestedFieldSearch [] fldTy rest) + idsBeforeField, (fld, isAnonRecdField) :: (nestedFieldSearch [] fldTy rest) /// Resolve F#/IL "." syntax in expressions (2). /// From 39ea7c696f6b67d3efde1cbe106e24be63a67f96 Mon Sep 17 00:00:00 2001 From: kerams Date: Wed, 1 Mar 2023 22:06:49 +0100 Subject: [PATCH 15/32] Add first batch of tests --- src/Compiler/Checking/CheckExpressions.fs | 10 +- src/Compiler/Checking/NameResolution.fs | 28 ++-- src/Compiler/Checking/NameResolution.fsi | 2 +- .../FSharp.Compiler.ComponentTests.fsproj | 3 +- .../Language/CopyAndUpdateTests.fs | 133 ++++++++++++++++++ 5 files changed, 154 insertions(+), 22 deletions(-) create mode 100644 tests/FSharp.Compiler.ComponentTests/Language/CopyAndUpdateTests.fs diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index d0937f314db..72b4b116ae6 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -1919,14 +1919,12 @@ let TransformAstForNestedUpdates cenv env overallTy (lid: LongIdent) exprBeingAs let rec synExprRecd copyInfo (id: Ident) fields exprBeingAssigned = match fields with | [] -> failwith "unreachable" - | (fldId, isAnon) :: rest -> + | (fldId, anonInfo) :: rest -> let nestedField = if rest.IsEmpty then exprBeingAssigned else synExprRecd copyInfo fldId rest exprBeingAssigned - if isAnon then - // The correct structness will later be taken from the anynymous type, which already exists - SynExpr.AnonRecd(false, copyInfo id, [ ([ fldId ], None, nestedField) ], id.idRange, { OpeningBraceRange = range0 }) - else - SynExpr.Record(None, copyInfo id, [ SynExprRecordField((LongIdentWithDots ([ fldId ], []), true), None, Some nestedField, None) ], id.idRange) + match anonInfo with + | Some { AnonRecdTypeInfo.TupInfo = TupInfo.Const isStruct } -> SynExpr.AnonRecd(isStruct, copyInfo id, [ ([ fldId ], None, nestedField) ], id.idRange, { OpeningBraceRange = range0 }) + | _ -> SynExpr.Record(None, copyInfo id, [ SynExprRecordField((LongIdentWithDots ([ fldId ], []), true), None, Some nestedField, None) ], id.idRange) let access, flds = ResolveNestedField cenv.tcSink cenv.nameResolver env.eNameResEnv env.eAccessRights overallTy lid diff --git a/src/Compiler/Checking/NameResolution.fs b/src/Compiler/Checking/NameResolution.fs index 07b90c7e1fe..88aabb1037e 100644 --- a/src/Compiler/Checking/NameResolution.fs +++ b/src/Compiler/Checking/NameResolution.fs @@ -3740,10 +3740,10 @@ let ResolveNestedField sink (ncenv: NameResolver) nenv ad ty lid = |?> ListSet.setify (fun fref1 fref2 -> tyconRefEq g fref1.TyconRef fref2.TyconRef) |?> List.map (fun rfref -> Choice1Of2(FieldResolution(FreshenRecdFieldRef ncenv m rfref, false))) - let isAnonRecdFieldF field = + let anonRecdInfoF field = match field with - | Choice1Of2 _ -> false - | Choice2Of2 _ -> true + | Choice1Of2 _ -> None + | Choice2Of2 (anonInfo, _, _) -> Some anonInfo match lid with | [] -> [], [] @@ -3751,7 +3751,7 @@ let ResolveNestedField sink (ncenv: NameResolver) nenv ad ty lid = let res = lookupFld ty id |> ForceRaise - |> List.map (fun x -> id, isAnonRecdFieldF x) + |> List.map (fun x -> id, anonRecdInfoF x) [], res | id :: _ -> @@ -3763,8 +3763,8 @@ let ResolveNestedField sink (ncenv: NameResolver) nenv ad ty lid = match x with | Choice1Of2 (FieldResolution (rfinfo, _)) -> let ref = rfinfo.RecdFieldRef - false, id, ref.RecdField.FormalType, rest - | Choice2Of2 (_, tys, index) -> true, id, tys[index], rest) + None, id, ref.RecdField.FormalType, rest + | Choice2Of2 (anonInfo, tys, index) -> Some anonInfo, id, tys[index], rest) | _ -> NoResultsOrUsefulErrors let tyconSearch ad () = @@ -3778,9 +3778,9 @@ let ResolveNestedField sink (ncenv: NameResolver) nenv ad ty lid = |?> List.choose (fun x -> match x with | _, Item.RecdField (RecdFieldInfo (_, rfref)), rest -> - (false, fieldId, rfref.RecdField.FormalType, rest) |> Some - | _, Item.AnonRecdField (_, tys, i, _), rest -> - (true, fieldId, tys[i], rest) |> Some + (None, fieldId, rfref.RecdField.FormalType, rest) |> Some + | _, Item.AnonRecdField (anonInfo, tys, i, _), rest -> + (Some anonInfo, fieldId, tys[i], rest) |> Some | _ -> None) | _ -> NoResultsOrUsefulErrors @@ -3791,9 +3791,9 @@ let ResolveNestedField sink (ncenv: NameResolver) nenv ad ty lid = ResolveLongIdentAsModuleOrNamespaceThen sink ResultCollectionSettings.AtMostOneResult ncenv.amap modOrNsId.idRange OpenQualified nenv ad modOrNsId rest false (ResolveFieldInModuleOrNamespace ncenv nenv ad) |?> List.map (fun (_, FieldResolution(rfinfo, _), restAfterField) -> let fieldId = rest.[ rest.Length - restAfterField.Length - 1 ] - false, fieldId, rfinfo.RecdFieldRef.RecdField.FormalType, restAfterField) + None, fieldId, rfinfo.RecdFieldRef.RecdField.FormalType, restAfterField) - let isAnonRecdField, fld, fldTy, rest = + let anonRecdInfo, fld, fldTy, rest = let search = if isAnonRecdTy then fldSearch () @@ -3811,7 +3811,7 @@ let ResolveNestedField sink (ncenv: NameResolver) nenv ad ty lid = lid |> List.takeWhile (fun id -> id.idRange <> fld.idRange) match rest with - | [] -> idsBeforeField, [ (fld, isAnonRecdField) ] + | [] -> idsBeforeField, [ (fld, anonRecdInfo) ] | _ -> let rec nestedFieldSearch flds ty = function @@ -3824,11 +3824,11 @@ let ResolveNestedField sink (ncenv: NameResolver) nenv ad ty lid = | [ Choice2Of2 (_, tys, index) ] -> tys[index] | _ -> ty - let resolved = resolved |> List.map (fun x -> id, isAnonRecdFieldF x) + let resolved = resolved |> List.map (fun x -> id, anonRecdInfoF x) nestedFieldSearch (flds @ resolved) fldTy rest - idsBeforeField, (fld, isAnonRecdField) :: (nestedFieldSearch [] fldTy rest) + idsBeforeField, (fld, anonRecdInfo) :: (nestedFieldSearch [] fldTy rest) /// Resolve F#/IL "." syntax in expressions (2). /// diff --git a/src/Compiler/Checking/NameResolution.fsi b/src/Compiler/Checking/NameResolution.fsi index 2e176168627..9a3adeac6c9 100755 --- a/src/Compiler/Checking/NameResolution.fsi +++ b/src/Compiler/Checking/NameResolution.fsi @@ -750,7 +750,7 @@ val internal ResolveNestedField: ad: AccessorDomain -> ty: TType -> lid: Ident list -> - Ident list * (Ident * bool) list + Ident list * (Ident * AnonRecdTypeInfo option) list /// Resolve a long identifier occurring in an expression position val internal ResolveExprLongIdent: diff --git a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj index 63cdc5f6491..c1e7c09b214 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj +++ b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj @@ -185,7 +185,8 @@ - + + diff --git a/tests/FSharp.Compiler.ComponentTests/Language/CopyAndUpdateTests.fs b/tests/FSharp.Compiler.ComponentTests/Language/CopyAndUpdateTests.fs new file mode 100644 index 00000000000..c87ba884fe4 --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Language/CopyAndUpdateTests.fs @@ -0,0 +1,133 @@ +module FSharp.Compiler.ComponentTests.Language.CopyAndUpdateTests + +open Xunit +open FSharp.Test.Compiler + +[] +let ``Cannot update the same field twice in nested copy-and-update``() = + FSharp """ +type NestdRecTy = { B: string } + +type RecTy = { D: NestdRecTy; E: string option } + +let t2 x = { x with D.B = "a"; D.B = "b" } + """ + |> withLangVersionPreview + |> typecheck + |> shouldFail + |> withDiagnostics [ + (Error 668, Line 6, Col 21, Line 6, Col 22, "The field 'B' appears twice in this record expression or pattern") + ] + +[] +let ``Cannot use nested copy-and-update in lang version70``() = + FSharp """ +type NestdRecTy = { B: string } + +type RecTy = { D: NestdRecTy; E: string option } + +let t2 x = { x with D.B = "a" } + """ + |> withLangVersion70 + |> typecheck + |> shouldFail + |> withDiagnostics [ + (Error 3350, Line 6, Col 21, Line 6, Col 24, "Feature 'Nested record field copy-and-update' is not available in F# 7.0. Please use language version 'PREVIEW' or greater.") + ] + +[] +let ``Nested copy-and-update merges same level updates``() = + FSharp """ +module CopyAndUpdateTests + +type AnotherNestedRecTy = { A: int } + +type NestdRecTy = { B: AnotherNestedRecTy; C: string } + +type RecTy = { D: NestdRecTy; E: string option } + +let t2 x = { x with D.B.A = 1; D.C = "ads" } + """ + |> withLangVersionPreview + |> withNoDebug + |> withOptimize + |> compile + |> shouldSucceed + |> verifyIL [ +(* + public static CopyAndUpdateTests.RecTy t2(CopyAndUpdateTests.RecTy x) + { + return new CopyAndUpdateTests.RecTy(new CopyAndUpdateTests.NestdRecTy(new CopyAndUpdateTests.AnotherNestedRecTy(1), "ads"), x.E@); + } +*) + """ +.method public static class CopyAndUpdateTests/RecTy + t2(class CopyAndUpdateTests/RecTy x) cil managed +{ + + .maxstack 8 + IL_0000: ldc.i4.1 + IL_0001: newobj instance void CopyAndUpdateTests/AnotherNestedRecTy::.ctor(int32) + IL_0006: ldstr "ads" + IL_000b: newobj instance void CopyAndUpdateTests/NestdRecTy::.ctor(class CopyAndUpdateTests/AnotherNestedRecTy, + string) + IL_0010: ldarg.0 + IL_0011: ldfld class [FSharp.Core]Microsoft.FSharp.Core.FSharpOption`1 CopyAndUpdateTests/RecTy::E@ + IL_0016: newobj instance void CopyAndUpdateTests/RecTy::.ctor(class CopyAndUpdateTests/NestdRecTy, + class [FSharp.Core]Microsoft.FSharp.Core.FSharpOption`1) + IL_001b: ret +} + """ + ] + +[] +let ``Nested copy-and-update correctly updates fields in nominal record``() = + FSharp """ +module CopyAndUpdateTests + +type AnotherNestedRecTy = { A: int } + +type NestdRecTy = { B: string; C: AnotherNestedRecTy } + +type RecTy = { D: NestdRecTy; E: string option } + +let t1 = { D = { B = "t1"; C = { A = 1 } }; E = None } + +let actual1 = { t1 with D.B = "t2" } +let expected1 = { D = { B = "t2"; C = { A = 1 } }; E = None } + +let actual2 = { t1 with D.C.A = 3; E = Some "a" } +let expected2 = { D = { B = "t1"; C = { A = 3 } }; E = Some "a" } + +if actual1 <> expected1 then + failwith "actual1 does not equal expected1" + +if actual2 <> expected2 then + failwith "actual2 does not equal expected2" + """ + |> withLangVersionPreview + |> compileExeAndRun + |> shouldSucceed + +[] +let ``Nested copy-and-update correctly updates fields in anonymous record``() = + FSharp """ +module CopyAndUpdateTests + +let t1 = {| D = {| B = "t1"; C = struct {| A = 1 |} |}; E = Option.None |} + +let actual1 = {| t1 with D.B = "t2" |} +let expected1 = {| D = {| B = "t2"; C = struct {| A = 1 |} |}; E = None |} + +let actual2 = {| t1 with D.C.A = 3; E = Some "a" |} +let expected2 = {| D = {| B = "t1"; C = struct {| A = 3 |} |}; E = Some "a" |} + +if actual1 <> expected1 then + failwith "actual1 does not equal expected1" + +if actual2 <> expected2 then + failwith "actual2 does not equal expected2" + """ + |> withLangVersionPreview + |> compileExeAndRun + |> shouldSucceed \ No newline at end of file From 95236e706717b1574eab04a6f5f85501b1bd1555 Mon Sep 17 00:00:00 2001 From: kerams Date: Thu, 2 Mar 2023 11:49:44 +0100 Subject: [PATCH 16/32] Add field qualification test --- src/Compiler/Checking/NameResolution.fs | 34 ++++++++--------- src/Compiler/Checking/NameResolution.fsi | 2 +- .../Language/CopyAndUpdateTests.fs | 37 +++++++++++++++++++ 3 files changed, 53 insertions(+), 20 deletions(-) diff --git a/src/Compiler/Checking/NameResolution.fs b/src/Compiler/Checking/NameResolution.fs index 88aabb1037e..2f936293ade 100644 --- a/src/Compiler/Checking/NameResolution.fs +++ b/src/Compiler/Checking/NameResolution.fs @@ -3693,10 +3693,10 @@ let ResolveField sink ncenv nenv ad ty mp id allFields = rfref) /// Resolve a long identifier representing a nested record field -let ResolveNestedField sink (ncenv: NameResolver) nenv ad ty lid = +let ResolveNestedField sink (ncenv: NameResolver) nenv ad recdTy lid = let typeNameResInfo = TypeNameResolutionInfo.Default let g = ncenv.g - let isAnonRecdTy = isAnonRecdTy g ty + let isAnonRecdTy = isAnonRecdTy g recdTy let lookupFld ty (id: Ident) = let m = id.idRange @@ -3704,7 +3704,7 @@ let ResolveNestedField sink (ncenv: NameResolver) nenv ad ty lid = match tryDestAnonRecdTy g ty with | ValueSome (anonInfo, tys) -> match anonInfo.SortedNames |> Array.tryFindIndex (fun x -> x = id.idText) with - | Some index -> OneSuccess (Choice2Of2 (anonInfo, tys, index)) + | Some index -> OneSuccess (Choice2Of2 (anonInfo, tys[index])) | _ -> raze (Error(FSComp.SR.nrRecordDoesNotContainSuchLabel(NicePrint.minimalStringOfType nenv.eDisplayEnv ty, id.idText), m)) | _ -> let otherRecdFlds ty = @@ -3719,7 +3719,7 @@ let ResolveNestedField sink (ncenv: NameResolver) nenv ad ty lid = if isRecdTy g ty then match ncenv.InfoReader.TryFindRecdOrClassFieldInfoOfType(id.idText, m, ty) with - | ValueSome (RecdFieldInfo (_, rfref)) -> OneSuccess (Choice1Of2(FieldResolution(FreshenRecdFieldRef ncenv m rfref, false))) + | ValueSome (RecdFieldInfo (_, rfref)) -> OneSuccess (Choice1Of2 rfref) | _ -> // record label doesn't belong to record type -> suggest other labels of same record let suggestLabels addToBuffer = @@ -3738,18 +3738,18 @@ let ResolveNestedField sink (ncenv: NameResolver) nenv ad ty lid = // Eliminate duplicates arising from multiple 'open' frefs |?> ListSet.setify (fun fref1 fref2 -> tyconRefEq g fref1.TyconRef fref2.TyconRef) - |?> List.map (fun rfref -> Choice1Of2(FieldResolution(FreshenRecdFieldRef ncenv m rfref, false))) + |?> List.map Choice1Of2 let anonRecdInfoF field = match field with | Choice1Of2 _ -> None - | Choice2Of2 (anonInfo, _, _) -> Some anonInfo + | Choice2Of2 (anonInfo, _) -> Some anonInfo match lid with | [] -> [], [] | [ id ] -> let res = - lookupFld ty id + lookupFld recdTy id |> ForceRaise |> List.map (fun x -> id, anonRecdInfoF x) @@ -3758,13 +3758,11 @@ let ResolveNestedField sink (ncenv: NameResolver) nenv ad ty lid = let fldSearch () = match lid with | id :: rest -> - lookupFld ty id + lookupFld recdTy id |?> List.map (fun x -> match x with - | Choice1Of2 (FieldResolution (rfinfo, _)) -> - let ref = rfinfo.RecdFieldRef - None, id, ref.RecdField.FormalType, rest - | Choice2Of2 (anonInfo, tys, index) -> Some anonInfo, id, tys[index], rest) + | Choice1Of2 rfref -> None, id, rfref.RecdField.FormalType, rest + | Choice2Of2 (anonInfo, fldTy) -> Some anonInfo, id, fldTy, rest) | _ -> NoResultsOrUsefulErrors let tyconSearch ad () = @@ -3777,10 +3775,8 @@ let ResolveNestedField sink (ncenv: NameResolver) nenv ad ty lid = ResolveLongIdentInTyconRefs ResultCollectionSettings.AllResults ncenv nenv LookupKind.RecdField 1 tyconId.idRange ad fieldId rest typeNameResInfo fieldId.idRange tcrefs |?> List.choose (fun x -> match x with - | _, Item.RecdField (RecdFieldInfo (_, rfref)), rest -> - (None, fieldId, rfref.RecdField.FormalType, rest) |> Some - | _, Item.AnonRecdField (anonInfo, tys, i, _), rest -> - (Some anonInfo, fieldId, tys[i], rest) |> Some + | _, Item.RecdField (RecdFieldInfo (_, rfref)), rest -> Some (None, fieldId, rfref.RecdField.FormalType, rest) + | _, Item.AnonRecdField (anonInfo, tys, i, _), rest -> Some (Some anonInfo, fieldId, tys[i], rest) | _ -> None) | _ -> NoResultsOrUsefulErrors @@ -3791,7 +3787,7 @@ let ResolveNestedField sink (ncenv: NameResolver) nenv ad ty lid = ResolveLongIdentAsModuleOrNamespaceThen sink ResultCollectionSettings.AtMostOneResult ncenv.amap modOrNsId.idRange OpenQualified nenv ad modOrNsId rest false (ResolveFieldInModuleOrNamespace ncenv nenv ad) |?> List.map (fun (_, FieldResolution(rfinfo, _), restAfterField) -> let fieldId = rest.[ rest.Length - restAfterField.Length - 1 ] - None, fieldId, rfinfo.RecdFieldRef.RecdField.FormalType, restAfterField) + None, fieldId, rfinfo.RecdField.FormalType, restAfterField) let anonRecdInfo, fld, fldTy, rest = let search = @@ -3820,8 +3816,8 @@ let ResolveNestedField sink (ncenv: NameResolver) nenv ad ty lid = let resolved = lookupFld ty id |> ForceRaise let fldTy = match resolved with - | [ Choice1Of2 (FieldResolution (rfinfo, _)) ] -> rfinfo.RecdField.FormalType - | [ Choice2Of2 (_, tys, index) ] -> tys[index] + | [ Choice1Of2 rfref ] -> rfref.RecdField.FormalType + | [ Choice2Of2 (_, fldTy) ] -> fldTy | _ -> ty let resolved = resolved |> List.map (fun x -> id, anonRecdInfoF x) diff --git a/src/Compiler/Checking/NameResolution.fsi b/src/Compiler/Checking/NameResolution.fsi index 9a3adeac6c9..f0eed4a6bb8 100755 --- a/src/Compiler/Checking/NameResolution.fsi +++ b/src/Compiler/Checking/NameResolution.fsi @@ -748,7 +748,7 @@ val internal ResolveNestedField: ncenv: NameResolver -> nenv: NameResolutionEnv -> ad: AccessorDomain -> - ty: TType -> + recdTy: TType -> lid: Ident list -> Ident list * (Ident * AnonRecdTypeInfo option) list diff --git a/tests/FSharp.Compiler.ComponentTests/Language/CopyAndUpdateTests.fs b/tests/FSharp.Compiler.ComponentTests/Language/CopyAndUpdateTests.fs index c87ba884fe4..486cc9a3cca 100644 --- a/tests/FSharp.Compiler.ComponentTests/Language/CopyAndUpdateTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Language/CopyAndUpdateTests.fs @@ -130,4 +130,41 @@ if actual2 <> expected2 then """ |> withLangVersionPreview |> compileExeAndRun + |> shouldSucceed + +[] +let ``Qualified record field names are correctly recognized in nested copy-and-update``() = + FSharp """ +module CopyAndUpdateTests + +module U = + module U = + type G = { U: {| a: G |}; I: int } + +let moduleModulePrefix x = { x with U.U.U.a.U.a.U.a.I = 1 } + +let moduleModuleTypePrefix x = { x with U.U.G.U.a.I = 1 } + +open U + +let modulePrefix x = { x with U.U.a.I = 1 } + +let moduleTypePrefix x = { x with U.G.U.a.I = 1 } + +open U + +let typePrefix x = { x with G.U.a.I = 1 } + +let modulePrefix2 x = { x with U.U.a.I = 1 } + +let moduleTypePrefix2 x = { x with U.G.U.a.I = 1 } + +let noPrefix x = { x with U.a.I = 1 } + +let c3 = { U.G.U = Unchecked.defaultof<_>; I = 3 } + +let c4 = { U.U = Unchecked.defaultof<_>; I = 3 } + """ + |> withLangVersionPreview + |> typecheck |> shouldSucceed \ No newline at end of file From f9938ace70a65bbe5ecb79094e2aa698a74676bf Mon Sep 17 00:00:00 2001 From: kerams Date: Thu, 2 Mar 2023 12:55:28 +0100 Subject: [PATCH 17/32] Fix updates on recursive records --- src/Compiler/Checking/CheckExpressions.fs | 6 +++--- .../Language/CopyAndUpdateTests.fs | 21 +++++++++++++++++++ 2 files changed, 24 insertions(+), 3 deletions(-) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 72b4b116ae6..27eb0421f5a 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -1882,16 +1882,16 @@ let TransformAstForNestedUpdates cenv env overallTy (lid: LongIdent) exprBeingAs let rec buildLid res (id: Ident) = function | [] -> res - | (h: Ident) :: t -> if h.idText = id.idText then h :: res else buildLid (h :: res) id t + | (h: Ident) :: t -> if h.idRange = id.idRange then h :: res else buildLid (h :: res) id t let rec combineIds = function | [] | [_] -> [] - | id1::id2::rest -> (id1, id2) :: (id2 :: rest |> combineIds) + | id1 :: id2 :: rest -> (id1, id2) :: (id2 :: rest |> combineIds) let calcLidSeparatorRanges lid = match lid with - | [] | [_] -> [origSepRng] + | [] | [_] -> [ origSepRng ] | _ :: t -> origSepRng :: List.map (fun (s: Ident, e: Ident) -> mkRange s.idRange.FileName s.idRange.End e.idRange.Start) t let lid = buildLid [] id lidwd |> List.rev diff --git a/tests/FSharp.Compiler.ComponentTests/Language/CopyAndUpdateTests.fs b/tests/FSharp.Compiler.ComponentTests/Language/CopyAndUpdateTests.fs index 486cc9a3cca..03ec03d397e 100644 --- a/tests/FSharp.Compiler.ComponentTests/Language/CopyAndUpdateTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Language/CopyAndUpdateTests.fs @@ -167,4 +167,25 @@ let c4 = { U.U = Unchecked.defaultof<_>; I = 3 } """ |> withLangVersionPreview |> typecheck + |> shouldSucceed + +[] +let ``Nested copy-and-update works correctly on recursive records``() = + FSharp """ +module CopyAndUpdateTests + +type G = { U: {| a: G |}; I: int } + +let f x = { x with U.a.U.a.I = 0; I = -1 } + +let start = { I = 1; U = {| a = { I = 2; U = {| a = { I = 3; U = Unchecked.defaultof<_> } |} } |} } + +let actual = f start +let expected = { I = -1; U = {| a = { I = 2; U = {| a = { I = 0; U = Unchecked.defaultof<_> } |} } |} } + +if actual <> expected then + failwith "actual does not equal expected" + """ + |> withLangVersionPreview + |> compileExeAndRun |> shouldSucceed \ No newline at end of file From d79c431ed6e15fb4681e5ee243e7ce898f765fa1 Mon Sep 17 00:00:00 2001 From: kerams Date: Thu, 2 Mar 2023 15:23:45 +0100 Subject: [PATCH 18/32] Add more tests --- src/Compiler/Checking/CheckExpressions.fs | 2 +- src/Compiler/Checking/NameResolution.fs | 2 +- .../Language/CopyAndUpdateTests.fs | 47 ++++++++++++++++++- 3 files changed, 48 insertions(+), 3 deletions(-) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 27eb0421f5a..c7a89ff0138 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -1882,7 +1882,7 @@ let TransformAstForNestedUpdates cenv env overallTy (lid: LongIdent) exprBeingAs let rec buildLid res (id: Ident) = function | [] -> res - | (h: Ident) :: t -> if h.idRange = id.idRange then h :: res else buildLid (h :: res) id t + | (h: Ident) :: t -> if equals h.idRange id.idRange then h :: res else buildLid (h :: res) id t let rec combineIds = function diff --git a/src/Compiler/Checking/NameResolution.fs b/src/Compiler/Checking/NameResolution.fs index 2f936293ade..2c8145a3641 100644 --- a/src/Compiler/Checking/NameResolution.fs +++ b/src/Compiler/Checking/NameResolution.fs @@ -3804,7 +3804,7 @@ let ResolveNestedField sink (ncenv: NameResolver) nenv ad recdTy lid = if isAnonRecdTy then [] else - lid |> List.takeWhile (fun id -> id.idRange <> fld.idRange) + lid |> List.takeWhile (fun id -> not (equals id.idRange fld.idRange)) match rest with | [] -> idsBeforeField, [ (fld, anonRecdInfo) ] diff --git a/tests/FSharp.Compiler.ComponentTests/Language/CopyAndUpdateTests.fs b/tests/FSharp.Compiler.ComponentTests/Language/CopyAndUpdateTests.fs index 03ec03d397e..188e8890708 100644 --- a/tests/FSharp.Compiler.ComponentTests/Language/CopyAndUpdateTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Language/CopyAndUpdateTests.fs @@ -2,6 +2,7 @@ open Xunit open FSharp.Test.Compiler +open StructuredResultsAsserts [] let ``Cannot update the same field twice in nested copy-and-update``() = @@ -188,4 +189,48 @@ if actual <> expected then """ |> withLangVersionPreview |> compileExeAndRun - |> shouldSucceed \ No newline at end of file + |> shouldSucceed + +[] +let ``Anonymous record with nested copy-and-update can change shape``() = + FSharp """ +module CopyAndUpdateTests + +type RecTy = { D: int; E: string option } + +let start = {| R = { D = 2; E = Some "e" }; S = 3 |} + +let actual = {| start with R.E = None; S = "May I be a string now?"; T = 4 |} + +let expected = {| R = { D = 2; E = None }; S = "May I be a string now?"; T = 4 |} + +if actual <> expected then + failwith "actual does not equal expected" + """ + |> withLangVersionPreview + |> compileExeAndRun + |> shouldSucceed + +[] +let ``Anonymous record in a nominal record with nested copy-and-update cannot change shape``() = + FSharp """ +module CopyAndUpdateTests + +type RecTy = { D: int; E: {| A: int |} } + +let f x = { x with E.A = "May I be a string now?" } + """ + |> withLangVersionPreview + |> typecheck + |> shouldFail + |> withResult { + Error = Error 1 + Range = { StartLine = 6 + StartColumn = 26 + EndLine = 6 + EndColumn = 50 } + Message = "This expression was expected to have type + 'int' +but here has type + 'string' " + } \ No newline at end of file From 09fa90d420b663d1c03b6409fe2cb50deeb7cd09 Mon Sep 17 00:00:00 2001 From: kerams Date: Thu, 2 Mar 2023 21:54:11 +0100 Subject: [PATCH 19/32] Add more tests --- src/Compiler/Service/FSharpCheckerResults.fs | 8 +++-- .../Language/CopyAndUpdateTests.fs | 32 ++++++++++++++++++- .../CompletionProviderTests.fs | 27 ++++++++++++++++ 3 files changed, 64 insertions(+), 3 deletions(-) diff --git a/src/Compiler/Service/FSharpCheckerResults.fs b/src/Compiler/Service/FSharpCheckerResults.fs index 3663e31b2eb..c70b3b6b8ed 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fs +++ b/src/Compiler/Service/FSharpCheckerResults.fs @@ -661,8 +661,8 @@ type internal TypeCheckInfo match fields |> List.tryFind (fun f -> f.LogicalName = id) with | Some f -> dive f.RecdField.FormalType denv ad m rest true wasPathEmpty | _ -> - // Field name can be optionally qualified - // If we haven't matched a field name yet, keep peeling off the prefix + // Field name can be optionally qualified. + // If we haven't matched a field name yet, keep peeling off the prefix. if isPastTypePrefix then Some([], denv, m) else @@ -671,6 +671,10 @@ type internal TypeCheckInfo match tryDestAnonRecdTy denv.g ty with | ValueSome (anonInfo, tys) -> match plid with + // Because of an oversight in syntax visitor where the path is not computed correctly, + // we might receive an empty plid even though some identifiers were present. + // Return no completions instead of wrong fields. + | [] when wasPathEmpty -> Some([], denv, m) | [] -> let items = [ diff --git a/tests/FSharp.Compiler.ComponentTests/Language/CopyAndUpdateTests.fs b/tests/FSharp.Compiler.ComponentTests/Language/CopyAndUpdateTests.fs index 188e8890708..28aa0f62674 100644 --- a/tests/FSharp.Compiler.ComponentTests/Language/CopyAndUpdateTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Language/CopyAndUpdateTests.fs @@ -233,4 +233,34 @@ let f x = { x with E.A = "May I be a string now?" } 'int' but here has type 'string' " - } \ No newline at end of file + } + +[] +let ``Nested copy-and-update does not compile when referencing invalid fields``() = + FSharp """ +module CopyAndUpdateTests + +type NestdRecTy = { B: string; G: {| a: int |} } + +type RecTy = { D: NestdRecTy; E: string option } + +let t1 x = { x with D.B.A = "a" } +let t2 x = { x with D.C = "a" } +let t3 x = { x with D.G.b = "a" } +let t4 x = { x with C.D = "a" } +let t5 (x: {| a: int; b: NestdRecTy |}) = {| x with b.C = "a" |} +let t6 (x: {| a: int; b: NestdRecTy |}) = {| x with b.G.b = "a" |} +let t7 (x: {| a: int; b: NestdRecTy |}) = {| x with c.D = "a" |} + """ + |> withLangVersionPreview + |> typecheck + |> shouldFail + |> withDiagnostics [ + (Error 39, Line 8, Col 25, Line 8, Col 26, "The record label 'A' is not defined.") + (Error 1129, Line 9, Col 23, Line 9, Col 24, "The record type 'NestdRecTy' does not contain a label 'C'.") + (Error 1129, Line 10, Col 25, Line 10, Col 26, "The record type '{| a: int |}' does not contain a label 'b'.") + (Error 39, Line 11, Col 21, Line 11, Col 22, "The namespace or module 'C' is not defined.") + (Error 1129, Line 12, Col 55, Line 12, Col 56, "The record type 'NestdRecTy' does not contain a label 'C'.") + (Error 1129, Line 13, Col 57, Line 13, Col 58, "The record type '{| a: int |}' does not contain a label 'b'.") + (Error 1129, Line 14, Col 53, Line 14, Col 54, "The record type '{| a: int; b: NestdRecTy |}' does not contain a label 'c'.") + ] \ No newline at end of file diff --git a/vsintegration/tests/FSharp.Editor.Tests/CompletionProviderTests.fs b/vsintegration/tests/FSharp.Editor.Tests/CompletionProviderTests.fs index 029b393a3a2..4021ca2a9be 100644 --- a/vsintegration/tests/FSharp.Editor.Tests/CompletionProviderTests.fs +++ b/vsintegration/tests/FSharp.Editor.Tests/CompletionProviderTests.fs @@ -1380,3 +1380,30 @@ let t13 x = { x with RecTy.D. } VerifyCompletionListExactly(fileContents, "let t12 x = { x with F.RecTy.d", [ "D"; "E" ]) VerifyCompletionListExactly(fileContents, "let t13 x = { x with RecTy.D.", [ "B"; "C" ]) + + [] + let ``Completion list for nested copy and update contains correct record fields, mixed nominal and anonymous`` () = + let fileContents = + """ +type AnotherNestedRecTy = { A: int } + +type NestdRecTy = { B: string; C: {| C: AnotherNestedRecTy |} } + +type RecTy = { D: NestdRecTy; E: {| a: string |} } + +let t1 x = { x with D.C.C.A = 12; E.a = "a" } + +let t2 (x: {| D: NestdRecTy; E: {| a: string |} |}) = {| x with E.a = "a"; D.B = "z" |} +""" + + VerifyCompletionListExactly(fileContents, "let t1 x = { x with D.", [ "B"; "C" ]) + VerifyCompletionListExactly(fileContents, "let t1 x = { x with D.C.", [ "C" ]) + VerifyCompletionListExactly(fileContents, "let t1 x = { x with D.C.C.", [ "A" ]) + VerifyCompletionListExactly(fileContents, "let t1 x = { x with D.C.C.A = 12; ", [ "D"; "E" ]) + VerifyCompletionListExactly(fileContents, "let t1 x = { x with D.C.C.A = 12; E.", [ "a" ]) + + // Because of general deficiencies in establishing the completion context for anonymous record fields, + // we do not show any completions in these positions rather than the wrong ones. + VerifyNoCompletionList(fileContents, "let t2 (x: {| D: NestdRecTy; E: {| a: string |} |}) = {| x with ") + VerifyNoCompletionList(fileContents, "let t2 (x: {| D: NestdRecTy; E: {| a: string |} |}) = {| x with E.") + VerifyNoCompletionList(fileContents, "let t2 (x: {| D: NestdRecTy; E: {| a: string |} |}) = {| x with E.a = \"a\"; D.") \ No newline at end of file From 684c4547a834a786b2e61d594993cd644e211288 Mon Sep 17 00:00:00 2001 From: kerams Date: Fri, 3 Mar 2023 10:37:44 +0100 Subject: [PATCH 20/32] Improve Intellisense --- src/Compiler/Checking/CheckExpressions.fs | 20 ++++++----- src/Compiler/Service/FSharpCheckerResults.fs | 4 --- src/Compiler/Service/ServiceParseTreeWalk.fs | 6 ++-- src/Compiler/SyntaxTree/SyntaxTree.fs | 2 +- src/Compiler/SyntaxTree/SyntaxTree.fsi | 2 +- src/Compiler/pars.fsy | 10 +++--- .../Expression/AnonymousRecords-01.fs.bsl | 10 +++--- .../Expression/AnonymousRecords-02.fs.bsl | 5 +-- .../Expression/AnonymousRecords-03.fs.bsl | 5 +-- .../Expression/AnonymousRecords-06.fs | 1 + .../Expression/AnonymousRecords-06.fs.bsl | 34 +++++++++++++++++++ .../Record - Anon - Field 01.fs.bsl | 5 +-- .../SynExprAnonRecdWithStructKeyword.fs.bsl | 6 ++-- ...sTheRangeOfTheEqualsSignInTheFields.fs.bsl | 11 +++--- .../CompletionProviderTests.fs | 9 +++-- 15 files changed, 88 insertions(+), 42 deletions(-) create mode 100644 tests/service/data/SyntaxTree/Expression/AnonymousRecords-06.fs create mode 100644 tests/service/data/SyntaxTree/Expression/AnonymousRecords-06.fs.bsl diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index c7a89ff0138..0b7bad78206 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -1923,8 +1923,12 @@ let TransformAstForNestedUpdates cenv env overallTy (lid: LongIdent) exprBeingAs let nestedField = if rest.IsEmpty then exprBeingAssigned else synExprRecd copyInfo fldId rest exprBeingAssigned match anonInfo with - | Some { AnonRecdTypeInfo.TupInfo = TupInfo.Const isStruct } -> SynExpr.AnonRecd(isStruct, copyInfo id, [ ([ fldId ], None, nestedField) ], id.idRange, { OpeningBraceRange = range0 }) - | _ -> SynExpr.Record(None, copyInfo id, [ SynExprRecordField((LongIdentWithDots ([ fldId ], []), true), None, Some nestedField, None) ], id.idRange) + | Some { AnonRecdTypeInfo.TupInfo = TupInfo.Const isStruct } -> + let fields = [ LongIdentWithDots ([ fldId ], []), None, nestedField ] + SynExpr.AnonRecd(isStruct, copyInfo id, fields, id.idRange, { OpeningBraceRange = range0 }) + | _ -> + let fields = [ SynExprRecordField((LongIdentWithDots ([ fldId ], []), true), None, Some nestedField, None) ] + SynExpr.Record(None, copyInfo id, fields, id.idRange) let access, flds = ResolveNestedField cenv.tcSink cenv.nameResolver env.eNameResEnv env.eAccessRights overallTy lid @@ -7482,7 +7486,7 @@ and TcAnonRecdExpr cenv (overallTy: TType) env tpenv (isStruct, optOrigSynExpr, // Check for duplicate field IDs unsortedFieldIdsAndSynExprsGiven - |> List.countBy (fun (fId, _, _) -> textOfLid fId) + |> List.countBy (fun (fId, _, _) -> textOfLid fId.LongIdent) |> List.iter (fun (label, count) -> if count > 1 then error (Error (FSComp.SR.tcAnonRecdDuplicateFieldId(label), mWholeExpr))) @@ -7497,7 +7501,7 @@ and TcNewAnonRecdExpr cenv (overallTy: TType) env tpenv (isStruct, unsortedField let g = cenv.g let unsortedFieldSynExprsGiven = unsortedFieldIdsAndSynExprsGiven |> List.map (fun (_, _, fieldExpr) -> fieldExpr) - let unsortedFieldIds = unsortedFieldIdsAndSynExprsGiven |> List.map (fun (fieldId, _, _) -> fieldId[0]) |> List.toArray + let unsortedFieldIds = unsortedFieldIdsAndSynExprsGiven |> List.map (fun (synLongIdent, _, _) -> synLongIdent.LongIdent[0]) |> List.toArray let anonInfo, sortedFieldTys = UnifyAnonRecdTypeAndInferCharacteristics env.eContextInfo cenv env.DisplayEnv mWholeExpr overallTy isStruct unsortedFieldIds // Sort into canonical order @@ -7510,8 +7514,8 @@ and TcNewAnonRecdExpr cenv (overallTy: TType) env tpenv (isStruct, unsortedField let sigma = sortedIndexedArgs |> List.map fst |> List.toArray let sortedFieldExprs = sortedIndexedArgs |> List.map snd - sortedFieldExprs |> List.iteri (fun j (fieldId, _, _) -> - let m = rangeOfLid fieldId + sortedFieldExprs |> List.iteri (fun j (synLongIdent, _, _) -> + let m = rangeOfLid synLongIdent.LongIdent let item = Item.AnonRecdField(anonInfo, sortedFieldTys, j, m) CallNameResolutionSink cenv.tcSink (m, env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, env.eAccessRights)) @@ -7549,8 +7553,8 @@ and TcCopyAndUpdateAnonRecdExpr cenv (overallTy: TType) env tpenv (isStruct, (or // Expand expressions with respect to potential nesting let unsortedFieldIdsAndSynExprsGiven = unsortedFieldIdsAndSynExprsGiven - |> List.map (fun (lid, _, exprBeingAssigned) -> - match lid with + |> List.map (fun (synLongIdent, _, exprBeingAssigned) -> + match synLongIdent.LongIdent with | [] -> error(Error(FSComp.SR.nrUnexpectedEmptyLongId(), mWholeExpr)) | [ id ] -> false, ([], id), Some exprBeingAssigned | lid -> TransformAstForNestedUpdates cenv env origExprTy lid exprBeingAssigned (origExpr, blockSeparator)) diff --git a/src/Compiler/Service/FSharpCheckerResults.fs b/src/Compiler/Service/FSharpCheckerResults.fs index c70b3b6b8ed..2870980b173 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fs +++ b/src/Compiler/Service/FSharpCheckerResults.fs @@ -671,10 +671,6 @@ type internal TypeCheckInfo match tryDestAnonRecdTy denv.g ty with | ValueSome (anonInfo, tys) -> match plid with - // Because of an oversight in syntax visitor where the path is not computed correctly, - // we might receive an empty plid even though some identifiers were present. - // Return no completions instead of wrong fields. - | [] when wasPathEmpty -> Some([], denv, m) | [] -> let items = [ diff --git a/src/Compiler/Service/ServiceParseTreeWalk.fs b/src/Compiler/Service/ServiceParseTreeWalk.fs index cd9c4a6d923..9c81e015460 100644 --- a/src/Compiler/Service/ServiceParseTreeWalk.fs +++ b/src/Compiler/Service/ServiceParseTreeWalk.fs @@ -358,7 +358,7 @@ module SyntaxTraversal = | SynExpr.ArrayOrList (_, synExprList, _range) -> synExprList |> List.map (fun x -> dive x x.Range traverseSynExpr) |> pick expr - | SynExpr.AnonRecd (copyInfo = copyOpt; recordFields = synExprList) -> + | SynExpr.AnonRecd (copyInfo = copyOpt; recordFields = fields) -> [ match copyOpt with | Some (expr, (withRange, _)) -> @@ -373,7 +373,9 @@ module SyntaxTraversal = else None) | _ -> () - for _, _, x in synExprList do + + for field, _, x in fields do + yield dive () field.Range (fun () -> visitor.VisitRecordField(path, copyOpt |> Option.map fst, Some field)) yield dive x x.Range traverseSynExpr ] |> pick expr diff --git a/src/Compiler/SyntaxTree/SyntaxTree.fs b/src/Compiler/SyntaxTree/SyntaxTree.fs index 08c545757ff..e02559815a3 100644 --- a/src/Compiler/SyntaxTree/SyntaxTree.fs +++ b/src/Compiler/SyntaxTree/SyntaxTree.fs @@ -482,7 +482,7 @@ type SynExpr = | AnonRecd of isStruct: bool * copyInfo: (SynExpr * BlockSeparator) option * - recordFields: (LongIdent * range option * SynExpr) list * + recordFields: (SynLongIdent * range option * SynExpr) list * range: range * trivia: SynExprAnonRecdTrivia diff --git a/src/Compiler/SyntaxTree/SyntaxTree.fsi b/src/Compiler/SyntaxTree/SyntaxTree.fsi index 21030a5ab2d..c9619454ded 100644 --- a/src/Compiler/SyntaxTree/SyntaxTree.fsi +++ b/src/Compiler/SyntaxTree/SyntaxTree.fsi @@ -554,7 +554,7 @@ type SynExpr = | AnonRecd of isStruct: bool * copyInfo: (SynExpr * BlockSeparator) option * - recordFields: (LongIdent * range option * SynExpr) list * + recordFields: (SynLongIdent * range option * SynExpr) list * range: range * trivia: SynExprAnonRecdTrivia diff --git a/src/Compiler/pars.fsy b/src/Compiler/pars.fsy index dc564b44c6f..2b82efa20d8 100644 --- a/src/Compiler/pars.fsy +++ b/src/Compiler/pars.fsy @@ -4923,9 +4923,9 @@ braceBarExprCore: { let orig, flds = $2 let flds = flds |> List.choose (function - | SynExprRecordField((SynLongIdent(lid, _, _), _), mEquals, Some e, _) when orig.IsSome -> Some (lid, mEquals, e) // copy-and-update, long identifier signifies nesting - | SynExprRecordField((SynLongIdent([id], _, _), _), mEquals, Some e, _) -> Some ([id], mEquals, e) // record construction, long identifier not valid - | SynExprRecordField((SynLongIdent(lid, _, _), _), mEquals, None, _) -> Some (lid, mEquals, arbExpr("anonField", rangeOfLongIdent lid)) + | SynExprRecordField((synLongIdent, _), mEquals, Some e, _) when orig.IsSome -> Some (synLongIdent, mEquals, e) // copy-and-update, long identifier signifies nesting + | SynExprRecordField((SynLongIdent([ _id ], _, _) as synLongIdent, _), mEquals, Some e, _) -> Some (synLongIdent, mEquals, e) // record construction, long identifier not valid + | SynExprRecordField((synLongIdent, _), mEquals, None, _) -> Some (synLongIdent, mEquals, arbExpr("anonField", synLongIdent.Range)) | _ -> reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsInvalidAnonRecdType()); None) let mLeftBrace = rhs parseState 1 let mRightBrace = rhs parseState 3 @@ -4938,8 +4938,8 @@ braceBarExprCore: let orig, flds = $2 let flds = flds |> List.map (function - | SynExprRecordField((SynLongIdent(lid, _, _), _), mEquals, Some e, _) -> (lid, mEquals, e) - | SynExprRecordField((SynLongIdent(lid, _, _), _), mEquals, None, _) -> (lid, mEquals, arbExpr("anonField", rangeOfLongIdent lid))) + | SynExprRecordField((synLongIdent, _), mEquals, Some e, _) -> (synLongIdent, mEquals, e) + | SynExprRecordField((synLongIdent, _), mEquals, None, _) -> (synLongIdent, mEquals, arbExpr("anonField", synLongIdent.Range))) let mLeftBrace = rhs parseState 1 let mExpr = rhs parseState 2 (fun (mStruct: range option) -> diff --git a/tests/service/data/SyntaxTree/Expression/AnonymousRecords-01.fs.bsl b/tests/service/data/SyntaxTree/Expression/AnonymousRecords-01.fs.bsl index 3044302d586..40b916124b1 100644 --- a/tests/service/data/SyntaxTree/Expression/AnonymousRecords-01.fs.bsl +++ b/tests/service/data/SyntaxTree/Expression/AnonymousRecords-01.fs.bsl @@ -7,13 +7,15 @@ ImplFile [Expr (AnonRecd (false, None, - [([X], Some (1,5--1,6), Const (Int32 1, (1,7--1,8)))], - (1,0--1,11), { OpeningBraceRange = (1,0--1,2) }), (1,0--1,11)); + [(SynLongIdent ([X], [], [None]), Some (1,5--1,6), + Const (Int32 1, (1,7--1,8)))], (1,0--1,11), + { OpeningBraceRange = (1,0--1,2) }), (1,0--1,11)); Expr (AnonRecd (true, None, - [([Y], Some (2,12--2,13), Const (Int32 2, (2,14--2,15)))], - (2,0--2,18), { OpeningBraceRange = (2,7--2,9) }), (2,0--2,18)); + [(SynLongIdent ([Y], [], [None]), Some (2,12--2,13), + Const (Int32 2, (2,14--2,15)))], (2,0--2,18), + { OpeningBraceRange = (2,7--2,9) }), (2,0--2,18)); Expr (AnonRecd (false, None, [], (3,0--3,5), { OpeningBraceRange = (3,0--3,2) }), diff --git a/tests/service/data/SyntaxTree/Expression/AnonymousRecords-02.fs.bsl b/tests/service/data/SyntaxTree/Expression/AnonymousRecords-02.fs.bsl index 743f18fe3fb..4b708f29415 100644 --- a/tests/service/data/SyntaxTree/Expression/AnonymousRecords-02.fs.bsl +++ b/tests/service/data/SyntaxTree/Expression/AnonymousRecords-02.fs.bsl @@ -7,8 +7,9 @@ ImplFile [Expr (AnonRecd (false, None, - [([X], Some (1,5--1,6), Const (Int32 0, (1,7--1,8)))], - (1,0--2,0), { OpeningBraceRange = (1,0--1,2) }), (1,0--2,0))], + [(SynLongIdent ([X], [], [None]), Some (1,5--1,6), + Const (Int32 0, (1,7--1,8)))], (1,0--2,0), + { OpeningBraceRange = (1,0--1,2) }), (1,0--2,0))], PreXmlDocEmpty, [], None, (1,0--2,0), { LeadingKeyword = None })], (true, false), { ConditionalDirectives = [] CodeComments = [] }, set [])) diff --git a/tests/service/data/SyntaxTree/Expression/AnonymousRecords-03.fs.bsl b/tests/service/data/SyntaxTree/Expression/AnonymousRecords-03.fs.bsl index 9d074eff5f0..63f45685825 100644 --- a/tests/service/data/SyntaxTree/Expression/AnonymousRecords-03.fs.bsl +++ b/tests/service/data/SyntaxTree/Expression/AnonymousRecords-03.fs.bsl @@ -7,8 +7,9 @@ ImplFile [Expr (AnonRecd (true, None, - [([X], Some (1,12--1,13), Const (Int32 0, (1,14--1,15)))], - (1,0--2,0), { OpeningBraceRange = (1,7--1,9) }), (1,0--2,0))], + [(SynLongIdent ([X], [], [None]), Some (1,12--1,13), + Const (Int32 0, (1,14--1,15)))], (1,0--2,0), + { OpeningBraceRange = (1,7--1,9) }), (1,0--2,0))], PreXmlDocEmpty, [], None, (1,0--2,0), { LeadingKeyword = None })], (true, false), { ConditionalDirectives = [] CodeComments = [] }, set [])) diff --git a/tests/service/data/SyntaxTree/Expression/AnonymousRecords-06.fs b/tests/service/data/SyntaxTree/Expression/AnonymousRecords-06.fs new file mode 100644 index 00000000000..60a1f3f2178 --- /dev/null +++ b/tests/service/data/SyntaxTree/Expression/AnonymousRecords-06.fs @@ -0,0 +1 @@ +let f x = {| x with R.D = "s"; A = 3 |} diff --git a/tests/service/data/SyntaxTree/Expression/AnonymousRecords-06.fs.bsl b/tests/service/data/SyntaxTree/Expression/AnonymousRecords-06.fs.bsl new file mode 100644 index 00000000000..b0b647bcf92 --- /dev/null +++ b/tests/service/data/SyntaxTree/Expression/AnonymousRecords-06.fs.bsl @@ -0,0 +1,34 @@ +ImplFile + (ParsedImplFileInput + ("/root/Expression/AnonymousRecords-06.fs", false, + QualifiedNameOfFile AnonymousRecords-06, [], [], + [SynModuleOrNamespace + ([AnonymousRecords-06], false, AnonModule, + [Let + (false, + [SynBinding + (None, Normal, false, false, [], + PreXmlDoc ((1,0), FSharp.Compiler.Xml.XmlDocCollector), + SynValData + (None, + SynValInfo + ([[SynArgInfo ([], false, Some x)]], + SynArgInfo ([], false, None)), None), + LongIdent + (SynLongIdent ([f], [], [None]), None, None, + Pats [Named (SynIdent (x, None), false, None, (1,6--1,7))], + None, (1,4--1,7)), None, + AnonRecd + (false, Some (Ident x, ((1,15--1,19), None)), + [(SynLongIdent ([R; D], [(1,21--1,22)], [None; None]), + Some (1,24--1,25), + Const (String ("s", Regular, (1,26--1,29)), (1,26--1,29))); + (SynLongIdent ([A], [], [None]), Some (1,33--1,34), + Const (Int32 3, (1,35--1,36)))], (1,10--1,39), + { OpeningBraceRange = (1,10--1,12) }), (1,4--1,7), + NoneAtLet, { LeadingKeyword = Let (1,0--1,3) + InlineKeyword = None + EqualsRange = Some (1,8--1,9) })], (1,0--1,39))], + PreXmlDocEmpty, [], None, (1,0--2,0), { LeadingKeyword = None })], + (true, false), { ConditionalDirectives = [] + CodeComments = [] }, set [])) diff --git a/tests/service/data/SyntaxTree/Expression/Record - Anon - Field 01.fs.bsl b/tests/service/data/SyntaxTree/Expression/Record - Anon - Field 01.fs.bsl index 282dc9023ce..a1fcc21b59c 100644 --- a/tests/service/data/SyntaxTree/Expression/Record - Anon - Field 01.fs.bsl +++ b/tests/service/data/SyntaxTree/Expression/Record - Anon - Field 01.fs.bsl @@ -7,8 +7,9 @@ ImplFile [Expr (AnonRecd (false, None, - [([A], Some (1,5--1,6), Const (Int32 1, (1,7--1,8)))], - (1,0--1,11), { OpeningBraceRange = (1,0--1,2) }), (1,0--1,11))], + [(SynLongIdent ([A], [], [None]), Some (1,5--1,6), + Const (Int32 1, (1,7--1,8)))], (1,0--1,11), + { OpeningBraceRange = (1,0--1,2) }), (1,0--1,11))], PreXmlDocEmpty, [], None, (1,0--1,11), { LeadingKeyword = None })], (true, false), { ConditionalDirectives = [] CodeComments = [] }, set [])) diff --git a/tests/service/data/SyntaxTree/Expression/SynExprAnonRecdWithStructKeyword.fs.bsl b/tests/service/data/SyntaxTree/Expression/SynExprAnonRecdWithStructKeyword.fs.bsl index 0e88962ed59..40047163be4 100644 --- a/tests/service/data/SyntaxTree/Expression/SynExprAnonRecdWithStructKeyword.fs.bsl +++ b/tests/service/data/SyntaxTree/Expression/SynExprAnonRecdWithStructKeyword.fs.bsl @@ -6,8 +6,10 @@ ImplFile ([SynExprAnonRecdWithStructKeyword], false, AnonModule, [Expr (AnonRecd - (true, None, [([Foo], Some (3,11--3,12), Ident someValue)], - (2,0--5,16), { OpeningBraceRange = (3,4--3,6) }), (2,0--5,16)); + (true, None, + [(SynLongIdent ([Foo], [], [None]), Some (3,11--3,12), + Ident someValue)], (2,0--5,16), + { OpeningBraceRange = (3,4--3,6) }), (2,0--5,16)); Expr (AnonRecd (true, None, [], (7,0--7,12), { OpeningBraceRange = (7,7--7,9) }), diff --git a/tests/service/data/SyntaxTree/Expression/SynExprAnonRecordContainsTheRangeOfTheEqualsSignInTheFields.fs.bsl b/tests/service/data/SyntaxTree/Expression/SynExprAnonRecordContainsTheRangeOfTheEqualsSignInTheFields.fs.bsl index 8cf0a14298b..e9a90eeccde 100644 --- a/tests/service/data/SyntaxTree/Expression/SynExprAnonRecordContainsTheRangeOfTheEqualsSignInTheFields.fs.bsl +++ b/tests/service/data/SyntaxTree/Expression/SynExprAnonRecordContainsTheRangeOfTheEqualsSignInTheFields.fs.bsl @@ -10,10 +10,13 @@ ImplFile [Expr (AnonRecd (false, None, - [([X], Some (2,5--2,6), Const (Int32 5, (2,7--2,8))); - ([Y], Some (3,8--3,9), Const (Int32 6, (3,10--3,11))); - ([Z], Some (4,12--4,13), Const (Int32 7, (4,14--4,15)))], - (2,0--4,18), { OpeningBraceRange = (2,0--2,2) }), (2,0--4,18))], + [(SynLongIdent ([X], [], [None]), Some (2,5--2,6), + Const (Int32 5, (2,7--2,8))); + (SynLongIdent ([Y], [], [None]), Some (3,8--3,9), + Const (Int32 6, (3,10--3,11))); + (SynLongIdent ([Z], [], [None]), Some (4,12--4,13), + Const (Int32 7, (4,14--4,15)))], (2,0--4,18), + { OpeningBraceRange = (2,0--2,2) }), (2,0--4,18))], PreXmlDocEmpty, [], None, (2,0--4,18), { LeadingKeyword = None })], (true, false), { ConditionalDirectives = [] CodeComments = [] }, set [])) diff --git a/vsintegration/tests/FSharp.Editor.Tests/CompletionProviderTests.fs b/vsintegration/tests/FSharp.Editor.Tests/CompletionProviderTests.fs index 4021ca2a9be..4640d9673e5 100644 --- a/vsintegration/tests/FSharp.Editor.Tests/CompletionProviderTests.fs +++ b/vsintegration/tests/FSharp.Editor.Tests/CompletionProviderTests.fs @@ -1402,8 +1402,7 @@ let t2 (x: {| D: NestdRecTy; E: {| a: string |} |}) = {| x with E.a = "a"; D.B = VerifyCompletionListExactly(fileContents, "let t1 x = { x with D.C.C.A = 12; ", [ "D"; "E" ]) VerifyCompletionListExactly(fileContents, "let t1 x = { x with D.C.C.A = 12; E.", [ "a" ]) - // Because of general deficiencies in establishing the completion context for anonymous record fields, - // we do not show any completions in these positions rather than the wrong ones. - VerifyNoCompletionList(fileContents, "let t2 (x: {| D: NestdRecTy; E: {| a: string |} |}) = {| x with ") - VerifyNoCompletionList(fileContents, "let t2 (x: {| D: NestdRecTy; E: {| a: string |} |}) = {| x with E.") - VerifyNoCompletionList(fileContents, "let t2 (x: {| D: NestdRecTy; E: {| a: string |} |}) = {| x with E.a = \"a\"; D.") \ No newline at end of file + VerifyCompletionListExactly(fileContents, "let t2 (x: {| D: NestdRecTy; E: {| a: string |} |}) = {| x with ", [ "D"; "E" ]) + VerifyCompletionListExactly(fileContents, "let t2 (x: {| D: NestdRecTy; E: {| a: string |} |}) = {| x with E.", [ "a" ]) + VerifyCompletionListExactly(fileContents, "let t2 (x: {| D: NestdRecTy; E: {| a: string |} |}) = {| x with E.a = \"a\"; ", [ "D"; "E" ]) + VerifyCompletionListExactly(fileContents, "let t2 (x: {| D: NestdRecTy; E: {| a: string |} |}) = {| x with E.a = \"a\"; D.", [ "B"; "C" ]) \ No newline at end of file From 28b3631e0b79870489ba35b0e105f6eb0bbad2f0 Mon Sep 17 00:00:00 2001 From: kerams Date: Fri, 3 Mar 2023 10:42:07 +0100 Subject: [PATCH 21/32] Format --- .../FSharp.Editor.Tests/CompletionProviderTests.fs | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/vsintegration/tests/FSharp.Editor.Tests/CompletionProviderTests.fs b/vsintegration/tests/FSharp.Editor.Tests/CompletionProviderTests.fs index 4640d9673e5..66c8123c0d4 100644 --- a/vsintegration/tests/FSharp.Editor.Tests/CompletionProviderTests.fs +++ b/vsintegration/tests/FSharp.Editor.Tests/CompletionProviderTests.fs @@ -1404,5 +1404,15 @@ let t2 (x: {| D: NestdRecTy; E: {| a: string |} |}) = {| x with E.a = "a"; D.B = VerifyCompletionListExactly(fileContents, "let t2 (x: {| D: NestdRecTy; E: {| a: string |} |}) = {| x with ", [ "D"; "E" ]) VerifyCompletionListExactly(fileContents, "let t2 (x: {| D: NestdRecTy; E: {| a: string |} |}) = {| x with E.", [ "a" ]) - VerifyCompletionListExactly(fileContents, "let t2 (x: {| D: NestdRecTy; E: {| a: string |} |}) = {| x with E.a = \"a\"; ", [ "D"; "E" ]) - VerifyCompletionListExactly(fileContents, "let t2 (x: {| D: NestdRecTy; E: {| a: string |} |}) = {| x with E.a = \"a\"; D.", [ "B"; "C" ]) \ No newline at end of file + + VerifyCompletionListExactly( + fileContents, + "let t2 (x: {| D: NestdRecTy; E: {| a: string |} |}) = {| x with E.a = \"a\"; ", + [ "D"; "E" ] + ) + + VerifyCompletionListExactly( + fileContents, + "let t2 (x: {| D: NestdRecTy; E: {| a: string |} |}) = {| x with E.a = \"a\"; D.", + [ "B"; "C" ] + ) From c23718dddb396f90e35aea50be7f755ecd4121c4 Mon Sep 17 00:00:00 2001 From: kerams Date: Fri, 3 Mar 2023 19:16:07 +0100 Subject: [PATCH 22/32] Fix surface area --- ...arp.Compiler.Service.SurfaceArea.netstandard20.debug.bsl | 6 +++--- ...p.Compiler.Service.SurfaceArea.netstandard20.release.bsl | 6 +++--- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.debug.bsl b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.debug.bsl index 068e378423f..3edaccabd80 100644 --- a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.debug.bsl +++ b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.debug.bsl @@ -6166,8 +6166,8 @@ FSharp.Compiler.Syntax.SynExpr+AnonRecd: FSharp.Compiler.SyntaxTrivia.SynExprAno FSharp.Compiler.Syntax.SynExpr+AnonRecd: FSharp.Compiler.SyntaxTrivia.SynExprAnonRecdTrivia trivia FSharp.Compiler.Syntax.SynExpr+AnonRecd: FSharp.Compiler.Text.Range get_range() FSharp.Compiler.Syntax.SynExpr+AnonRecd: FSharp.Compiler.Text.Range range -FSharp.Compiler.Syntax.SynExpr+AnonRecd: Microsoft.FSharp.Collections.FSharpList`1[System.Tuple`3[Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.Ident],Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range],FSharp.Compiler.Syntax.SynExpr]] get_recordFields() -FSharp.Compiler.Syntax.SynExpr+AnonRecd: Microsoft.FSharp.Collections.FSharpList`1[System.Tuple`3[Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.Ident],Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range],FSharp.Compiler.Syntax.SynExpr]] recordFields +FSharp.Compiler.Syntax.SynExpr+AnonRecd: Microsoft.FSharp.Collections.FSharpList`1[System.Tuple`3[FSharp.Compiler.Syntax.SynLongIdent,Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range],FSharp.Compiler.Syntax.SynExpr]] get_recordFields() +FSharp.Compiler.Syntax.SynExpr+AnonRecd: Microsoft.FSharp.Collections.FSharpList`1[System.Tuple`3[FSharp.Compiler.Syntax.SynLongIdent,Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range],FSharp.Compiler.Syntax.SynExpr]] recordFields FSharp.Compiler.Syntax.SynExpr+AnonRecd: Microsoft.FSharp.Core.FSharpOption`1[System.Tuple`2[FSharp.Compiler.Syntax.SynExpr,System.Tuple`2[FSharp.Compiler.Text.Range,Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Position]]]] copyInfo FSharp.Compiler.Syntax.SynExpr+AnonRecd: Microsoft.FSharp.Core.FSharpOption`1[System.Tuple`2[FSharp.Compiler.Syntax.SynExpr,System.Tuple`2[FSharp.Compiler.Text.Range,Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Position]]]] get_copyInfo() FSharp.Compiler.Syntax.SynExpr+App: Boolean get_isInfix() @@ -6905,7 +6905,7 @@ FSharp.Compiler.Syntax.SynExpr: Boolean get_IsWhile() FSharp.Compiler.Syntax.SynExpr: Boolean get_IsYieldOrReturn() FSharp.Compiler.Syntax.SynExpr: Boolean get_IsYieldOrReturnFrom() FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewAddressOf(Boolean, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Text.Range, FSharp.Compiler.Text.Range) -FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewAnonRecd(Boolean, Microsoft.FSharp.Core.FSharpOption`1[System.Tuple`2[FSharp.Compiler.Syntax.SynExpr,System.Tuple`2[FSharp.Compiler.Text.Range,Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Position]]]], Microsoft.FSharp.Collections.FSharpList`1[System.Tuple`3[Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.Ident],Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range],FSharp.Compiler.Syntax.SynExpr]], FSharp.Compiler.Text.Range, FSharp.Compiler.SyntaxTrivia.SynExprAnonRecdTrivia) +FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewAnonRecd(Boolean, Microsoft.FSharp.Core.FSharpOption`1[System.Tuple`2[FSharp.Compiler.Syntax.SynExpr,System.Tuple`2[FSharp.Compiler.Text.Range,Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Position]]]], Microsoft.FSharp.Collections.FSharpList`1[System.Tuple`3[FSharp.Compiler.Syntax.SynLongIdent,Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range],FSharp.Compiler.Syntax.SynExpr]], FSharp.Compiler.Text.Range, FSharp.Compiler.SyntaxTrivia.SynExprAnonRecdTrivia) FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewApp(FSharp.Compiler.Syntax.ExprAtomicFlag, Boolean, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewArbitraryAfterError(System.String, FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewArrayOrList(Boolean, Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynExpr], FSharp.Compiler.Text.Range) diff --git a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.release.bsl b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.release.bsl index 068e378423f..3edaccabd80 100644 --- a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.release.bsl +++ b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.release.bsl @@ -6166,8 +6166,8 @@ FSharp.Compiler.Syntax.SynExpr+AnonRecd: FSharp.Compiler.SyntaxTrivia.SynExprAno FSharp.Compiler.Syntax.SynExpr+AnonRecd: FSharp.Compiler.SyntaxTrivia.SynExprAnonRecdTrivia trivia FSharp.Compiler.Syntax.SynExpr+AnonRecd: FSharp.Compiler.Text.Range get_range() FSharp.Compiler.Syntax.SynExpr+AnonRecd: FSharp.Compiler.Text.Range range -FSharp.Compiler.Syntax.SynExpr+AnonRecd: Microsoft.FSharp.Collections.FSharpList`1[System.Tuple`3[Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.Ident],Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range],FSharp.Compiler.Syntax.SynExpr]] get_recordFields() -FSharp.Compiler.Syntax.SynExpr+AnonRecd: Microsoft.FSharp.Collections.FSharpList`1[System.Tuple`3[Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.Ident],Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range],FSharp.Compiler.Syntax.SynExpr]] recordFields +FSharp.Compiler.Syntax.SynExpr+AnonRecd: Microsoft.FSharp.Collections.FSharpList`1[System.Tuple`3[FSharp.Compiler.Syntax.SynLongIdent,Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range],FSharp.Compiler.Syntax.SynExpr]] get_recordFields() +FSharp.Compiler.Syntax.SynExpr+AnonRecd: Microsoft.FSharp.Collections.FSharpList`1[System.Tuple`3[FSharp.Compiler.Syntax.SynLongIdent,Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range],FSharp.Compiler.Syntax.SynExpr]] recordFields FSharp.Compiler.Syntax.SynExpr+AnonRecd: Microsoft.FSharp.Core.FSharpOption`1[System.Tuple`2[FSharp.Compiler.Syntax.SynExpr,System.Tuple`2[FSharp.Compiler.Text.Range,Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Position]]]] copyInfo FSharp.Compiler.Syntax.SynExpr+AnonRecd: Microsoft.FSharp.Core.FSharpOption`1[System.Tuple`2[FSharp.Compiler.Syntax.SynExpr,System.Tuple`2[FSharp.Compiler.Text.Range,Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Position]]]] get_copyInfo() FSharp.Compiler.Syntax.SynExpr+App: Boolean get_isInfix() @@ -6905,7 +6905,7 @@ FSharp.Compiler.Syntax.SynExpr: Boolean get_IsWhile() FSharp.Compiler.Syntax.SynExpr: Boolean get_IsYieldOrReturn() FSharp.Compiler.Syntax.SynExpr: Boolean get_IsYieldOrReturnFrom() FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewAddressOf(Boolean, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Text.Range, FSharp.Compiler.Text.Range) -FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewAnonRecd(Boolean, Microsoft.FSharp.Core.FSharpOption`1[System.Tuple`2[FSharp.Compiler.Syntax.SynExpr,System.Tuple`2[FSharp.Compiler.Text.Range,Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Position]]]], Microsoft.FSharp.Collections.FSharpList`1[System.Tuple`3[Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.Ident],Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range],FSharp.Compiler.Syntax.SynExpr]], FSharp.Compiler.Text.Range, FSharp.Compiler.SyntaxTrivia.SynExprAnonRecdTrivia) +FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewAnonRecd(Boolean, Microsoft.FSharp.Core.FSharpOption`1[System.Tuple`2[FSharp.Compiler.Syntax.SynExpr,System.Tuple`2[FSharp.Compiler.Text.Range,Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Position]]]], Microsoft.FSharp.Collections.FSharpList`1[System.Tuple`3[FSharp.Compiler.Syntax.SynLongIdent,Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range],FSharp.Compiler.Syntax.SynExpr]], FSharp.Compiler.Text.Range, FSharp.Compiler.SyntaxTrivia.SynExprAnonRecdTrivia) FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewApp(FSharp.Compiler.Syntax.ExprAtomicFlag, Boolean, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewArbitraryAfterError(System.String, FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewArrayOrList(Boolean, Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynExpr], FSharp.Compiler.Text.Range) From 08f44b3310d3c14466f033f37d448e8661df7d42 Mon Sep 17 00:00:00 2001 From: kerams Date: Fri, 3 Mar 2023 21:15:51 +0100 Subject: [PATCH 23/32] Refactor --- src/Compiler/Checking/CheckBasics.fs | 3 -- src/Compiler/Checking/CheckBasics.fsi | 3 -- src/Compiler/Checking/CheckDeclarations.fs | 3 +- src/Compiler/Checking/CheckExpressions.fs | 54 ++++++++++------------ 4 files changed, 26 insertions(+), 37 deletions(-) diff --git a/src/Compiler/Checking/CheckBasics.fs b/src/Compiler/Checking/CheckBasics.fs index d24598734a6..6df98110001 100644 --- a/src/Compiler/Checking/CheckBasics.fs +++ b/src/Compiler/Checking/CheckBasics.fs @@ -242,9 +242,6 @@ type TcEnv = // Do we lay down an implicit debug point? eIsControlFlow: bool - - /// Type checking an expanded nested copy-and-update record expression - eIsInNestedCopyAndUpdate: bool } member tenv.DisplayEnv = tenv.eNameResEnv.DisplayEnv diff --git a/src/Compiler/Checking/CheckBasics.fsi b/src/Compiler/Checking/CheckBasics.fsi index 40caf01d0a5..6081eab8ef6 100644 --- a/src/Compiler/Checking/CheckBasics.fsi +++ b/src/Compiler/Checking/CheckBasics.fsi @@ -127,9 +127,6 @@ type TcEnv = eLambdaArgInfos: ArgReprInfo list list eIsControlFlow: bool - - /// Type checking an expanded nested copy-and-update record expression - eIsInNestedCopyAndUpdate: bool } member DisplayEnv: DisplayEnv diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index f0f728ecc3a..7ee34cb5cd8 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -5224,8 +5224,7 @@ let emptyTcEnv g = eCtorInfo = None eCallerMemberName = None eLambdaArgInfos = [] - eIsControlFlow = false - eIsInNestedCopyAndUpdate = false } + eIsControlFlow = false } let CreateInitialTcEnv(g, amap, scopem, assemblyName, ccus) = (emptyTcEnv g, ccus) ||> List.collectFold (fun env (ccu, autoOpens, internalsVisible) -> diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 0b7bad78206..c176c0e3a61 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -1852,23 +1852,23 @@ let BuildFieldMap (cenv: cenv) env isPartial ty (flds: ((Ident list * Ident) * ' tinst, tcref, fldsmap, List.rev rfldsList /// Merges updates to nested record fields on the same level in record copy-and-update -let GroupUpdatesToNestedFields (fields: (bool * (Ident list * Ident) * SynExpr option) list) = +let GroupUpdatesToNestedFields (fields: ((Ident list * Ident) * SynExpr option) list) = let rec groupIfNested res xs = match xs with | [] -> res | x :: [] -> x :: res | x :: y :: ys -> match x, y with - | (aIsNestedUpdate, lidwid, Some (SynExpr.Record (baseInfo, copyInfo, aFlds, m))), (bIsNestedUpdate, _, Some (SynExpr.Record (recordFields = bFlds))) -> - let reducedRecd = (aIsNestedUpdate || bIsNestedUpdate, lidwid, Some(SynExpr.Record (baseInfo, copyInfo, aFlds @ bFlds, m))) + | (lidwid, Some (SynExpr.Record (baseInfo, copyInfo, aFlds, m))), (_, Some (SynExpr.Record (recordFields = bFlds))) -> + let reducedRecd = (lidwid, Some(SynExpr.Record (baseInfo, copyInfo, aFlds @ bFlds, m))) groupIfNested (reducedRecd :: res) ys - | (aIsNestedUpdate, lidwid, Some (SynExpr.AnonRecd (isStruct, copyInfo, aFlds, m, trivia))), (bIsNestedUpdate, _, Some (SynExpr.AnonRecd (recordFields = bFlds))) -> - let reducedRecd = (aIsNestedUpdate || bIsNestedUpdate, lidwid, Some(SynExpr.AnonRecd (isStruct, copyInfo, aFlds @ bFlds, m, trivia))) + | (lidwid, Some (SynExpr.AnonRecd (isStruct, copyInfo, aFlds, m, trivia))), (_, Some (SynExpr.AnonRecd (recordFields = bFlds))) -> + let reducedRecd = (lidwid, Some(SynExpr.AnonRecd (isStruct, copyInfo, aFlds @ bFlds, m, trivia))) groupIfNested (reducedRecd :: res) ys | _ -> groupIfNested (x :: res) (y :: ys) fields - |> List.groupBy (fun (_, (_, field), _) -> field.idText) + |> List.groupBy (fun ((_, field), _) -> field.idText) |> List.collect (fun (_, fields) -> if fields.Length < 2 then fields @@ -1921,25 +1921,26 @@ let TransformAstForNestedUpdates cenv env overallTy (lid: LongIdent) exprBeingAs | [] -> failwith "unreachable" | (fldId, anonInfo) :: rest -> let nestedField = if rest.IsEmpty then exprBeingAssigned else synExprRecd copyInfo fldId rest exprBeingAssigned + let m = id.idRange.MakeSynthetic() match anonInfo with | Some { AnonRecdTypeInfo.TupInfo = TupInfo.Const isStruct } -> let fields = [ LongIdentWithDots ([ fldId ], []), None, nestedField ] - SynExpr.AnonRecd(isStruct, copyInfo id, fields, id.idRange, { OpeningBraceRange = range0 }) + SynExpr.AnonRecd(isStruct, copyInfo id, fields, m, { OpeningBraceRange = range0 }) | _ -> let fields = [ SynExprRecordField((LongIdentWithDots ([ fldId ], []), true), None, Some nestedField, None) ] - SynExpr.Record(None, copyInfo id, fields, id.idRange) + SynExpr.Record(None, copyInfo id, fields, m) let access, flds = ResolveNestedField cenv.tcSink cenv.nameResolver env.eNameResEnv env.eAccessRights overallTy lid match access, flds with | [], [] -> failwith "unreachable" - | accessIds, [] -> false, List.frontAndBack accessIds, Some exprBeingAssigned - | accessIds, [ (fldId, _) ] -> false, List.frontAndBack (accessIds @ [ fldId ]), Some exprBeingAssigned + | accessIds, [] -> List.frontAndBack accessIds, Some exprBeingAssigned + | accessIds, [ (fldId, _) ] -> List.frontAndBack (accessIds @ [ fldId ]), Some exprBeingAssigned | accessIds, (fldId, _) :: rest -> checkLanguageFeatureAndRecover cenv.g.langVersion LanguageFeature.NestedCopyAndUpdate (rangeOfLid lid) - true, (accessIds, fldId), Some (synExprRecd (recdExprCopyInfo (flds |> List.map fst) withExpr) fldId rest exprBeingAssigned) + (accessIds, fldId), Some (synExprRecd (recdExprCopyInfo (flds |> List.map fst) withExpr) fldId rest exprBeingAssigned) let rec ApplyUnionCaseOrExn (makerForUnionCase, makerForExnTag) m (cenv: cenv) env overallTy item = let g = cenv.g @@ -6657,7 +6658,9 @@ and TcRecordConstruction (cenv: cenv) (overallTy: TType) env tpenv withExprInfoO if not (Zset.subset ns2 ns1) then error(MissingFields(Zset.elements (Zset.diff ns2 ns1), m)) | _ -> - if oldFldsList.IsEmpty && not env.eIsInNestedCopyAndUpdate then + // `TransformAstForNestedUpdates` crates record constructions with synthetic ranges. + // Don't emit the warning for nested field updates, because it does not really make sense. + if oldFldsList.IsEmpty && not m.IsSynthetic then let enabledByLangFeature = g.langVersion.SupportsFeature LanguageFeature.WarningWhenCopyAndUpdateRecordChangesAllFields warning(ErrorEnabledWithLanguageFeature(FSComp.SR.tcCopyAndUpdateRecordChangesAllFields(fullDisplayTextOfTyconRef tcref), m, enabledByLangFeature)) @@ -7401,7 +7404,7 @@ and TcRecdExpr cenv overallTy env tpenv (inherits, withExprOpt, synRecdFields, m let hasOrigExpr = withExprOptChecked.IsSome - let fldsList, containsNestedUpdates = + let fldsList = let flds = synRecdFields |> List.map (fun (SynExprRecordField (fieldName = (synLongId, isOk); expr = exprBeingAssigned)) -> @@ -7412,23 +7415,23 @@ and TcRecdExpr cenv overallTy env tpenv (inherits, withExprOpt, synRecdFields, m raise (ReportedError None) match withExprOpt, synLongId.LongIdent, exprBeingAssigned with - | _, [ id ], _ -> false, ([], id), exprBeingAssigned + | _, [ id ], _ -> ([], id), exprBeingAssigned | Some withExpr, lid, Some exprBeingAssigned -> TransformAstForNestedUpdates cenv env overallTy lid exprBeingAssigned withExpr - | _ -> false, List.frontAndBack synLongId.LongIdent, exprBeingAssigned) + | _ -> List.frontAndBack synLongId.LongIdent, exprBeingAssigned) let flds = if hasOrigExpr then GroupUpdatesToNestedFields flds else flds match flds with - | [] -> [], false + | [] -> [] | _ -> - let tinst, tcref, _, fldsList = BuildFieldMap cenv env hasOrigExpr overallTy (flds |> List.map (fun (_, x, y) -> x, y)) mWholeExpr + let tinst, tcref, _, fldsList = BuildFieldMap cenv env hasOrigExpr overallTy flds mWholeExpr let gtyp = mkAppTy tcref tinst UnifyTypes cenv env mWholeExpr overallTy gtyp [ for n, v in fldsList do match v with | Some v -> yield n, v - | None -> () ], flds |> List.exists (fun (isNestedUpdate, _, _) -> isNestedUpdate) + | None -> () ] let withExprInfoOpt = match withExprOptChecked with @@ -7470,8 +7473,7 @@ and TcRecdExpr cenv overallTy env tpenv (inherits, withExprOpt, synRecdFields, m errorR(InternalError("Unexpected failure in getting super type", mWholeExpr)) None, tpenv - let envinner = if containsNestedUpdates then { env with eIsInNestedCopyAndUpdate = true } else env - let expr, tpenv = TcRecordConstruction cenv overallTy envinner tpenv withExprInfoOpt overallTy fldsList mWholeExpr + let expr, tpenv = TcRecordConstruction cenv overallTy env tpenv withExprInfoOpt overallTy fldsList mWholeExpr let expr = match superInitExprOpt with @@ -7556,11 +7558,11 @@ and TcCopyAndUpdateAnonRecdExpr cenv (overallTy: TType) env tpenv (isStruct, (or |> List.map (fun (synLongIdent, _, exprBeingAssigned) -> match synLongIdent.LongIdent with | [] -> error(Error(FSComp.SR.nrUnexpectedEmptyLongId(), mWholeExpr)) - | [ id ] -> false, ([], id), Some exprBeingAssigned + | [ id ] -> ([], id), Some exprBeingAssigned | lid -> TransformAstForNestedUpdates cenv env origExprTy lid exprBeingAssigned (origExpr, blockSeparator)) |> GroupUpdatesToNestedFields - let unsortedFieldSynExprsGiven = unsortedFieldIdsAndSynExprsGiven |> List.choose p33 + let unsortedFieldSynExprsGiven = unsortedFieldIdsAndSynExprsGiven |> List.choose snd let origExprIsStruct = match tryDestAnonRecdTy g origExprTy with @@ -7577,7 +7579,7 @@ and TcCopyAndUpdateAnonRecdExpr cenv (overallTy: TType) env tpenv (isStruct, (or /// - Choice2Of2 for a binding coming from the original expression let unsortedIdAndExprsAll = [| - for _, (_, id), e in unsortedFieldIdsAndSynExprsGiven do + for (_, id), e in unsortedFieldIdsAndSynExprsGiven do yield (id, Choice1Of2 e) match tryDestAnonRecdTy g origExprTy with | ValueSome (anonInfo, tinst) -> @@ -7628,12 +7630,6 @@ and TcCopyAndUpdateAnonRecdExpr cenv (overallTy: TType) env tpenv (isStruct, (or // Check the expressions in unsorted order let unsortedFieldExprsGiven, tpenv = - let env = - if unsortedFieldIdsAndSynExprsGiven |> List.exists (fun (isNestedUpdate, _, _) -> isNestedUpdate) then - { env with eIsInNestedCopyAndUpdate = true } - else - env - TcExprsWithFlexes cenv env mWholeExpr tpenv flexes unsortedFieldTysGiven unsortedFieldSynExprsGiven let unsortedFieldExprsGiven = unsortedFieldExprsGiven |> List.toArray From 139833cc6144ccc0510fd268b20b2f567089b509 Mon Sep 17 00:00:00 2001 From: kerams Date: Sat, 4 Mar 2023 09:02:51 +0100 Subject: [PATCH 24/32] Add diagnostic tests --- .../Diagnostics/Records.fs | 26 +++++++++++++++++++ .../Language/CopyAndUpdateTests.fs | 14 +++++----- 2 files changed, 33 insertions(+), 7 deletions(-) diff --git a/tests/FSharp.Compiler.ComponentTests/Diagnostics/Records.fs b/tests/FSharp.Compiler.ComponentTests/Diagnostics/Records.fs index e5640db0f03..b1f80781c48 100644 --- a/tests/FSharp.Compiler.ComponentTests/Diagnostics/Records.fs +++ b/tests/FSharp.Compiler.ComponentTests/Diagnostics/Records.fs @@ -65,4 +65,30 @@ let updateWarn r = { r with F1 = 1; F2 = "" } |> shouldFail |> withDiagnostics [ (Warning 3560, Line 6, Col 20, Line 6, Col 46, "This copy-and-update record expression changes all fields of record type 'Records.R'. Consider using the record construction syntax instead.") + ] + +[] +let ``Warning not emitted for generated record updates within a nested copy-and-update expression in a lang preview``() = + Fsx """ +type AnotherNestedRecTy = { A: int; B: int } + +type NestdRecTy = { C: {| c: AnotherNestedRecTy |} } + +type RecTy = { D: NestdRecTy; I: int } + +// vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv +let t1 (x: NestdRecTy) = { x with C.c = Unchecked.defaultof<_> } + +// Do not report for the nested NestdRecTy update +let t2 (x: RecTy) (a: AnotherNestedRecTy) = { x with D.C.c = { a with A = 3 } } + +// vvvvvvvvvvvvvvvvvvvvvvv +let t3 (x: RecTy) (a: AnotherNestedRecTy) = { x with D.C.c = { a with A = 3; B = 4 } } + """ + |> withLangVersionPreview + |> typecheck + |> shouldFail + |> withDiagnostics [ + (Warning 3560, Line 9, Col 26, Line 9, Col 65, "This copy-and-update record expression changes all fields of record type 'Test.NestdRecTy'. Consider using the record construction syntax instead.") + (Warning 3560, Line 15, Col 62, Line 15, Col 85, "This copy-and-update record expression changes all fields of record type 'Test.AnotherNestedRecTy'. Consider using the record construction syntax instead.") ] \ No newline at end of file diff --git a/tests/FSharp.Compiler.ComponentTests/Language/CopyAndUpdateTests.fs b/tests/FSharp.Compiler.ComponentTests/Language/CopyAndUpdateTests.fs index 28aa0f62674..76597a224a6 100644 --- a/tests/FSharp.Compiler.ComponentTests/Language/CopyAndUpdateTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Language/CopyAndUpdateTests.fs @@ -90,15 +90,15 @@ type AnotherNestedRecTy = { A: int } type NestdRecTy = { B: string; C: AnotherNestedRecTy } -type RecTy = { D: NestdRecTy; E: string option } +type RecTy = { D: NestdRecTy; E: string option; F: int } -let t1 = { D = { B = "t1"; C = { A = 1 } }; E = None } +let t1 = { D = { B = "t1"; C = { A = 1 } }; E = None; F = 42 } let actual1 = { t1 with D.B = "t2" } -let expected1 = { D = { B = "t2"; C = { A = 1 } }; E = None } +let expected1 = { D = { B = "t2"; C = { A = 1 } }; E = None; F = 42 } let actual2 = { t1 with D.C.A = 3; E = Some "a" } -let expected2 = { D = { B = "t1"; C = { A = 3 } }; E = Some "a" } +let expected2 = { D = { B = "t1"; C = { A = 3 } }; E = Some "a"; F = 42 } if actual1 <> expected1 then failwith "actual1 does not equal expected1" @@ -175,14 +175,14 @@ let ``Nested copy-and-update works correctly on recursive records``() = FSharp """ module CopyAndUpdateTests -type G = { U: {| a: G |}; I: int } +type G = { T: string; U: {| a: G |}; I: int } let f x = { x with U.a.U.a.I = 0; I = -1 } -let start = { I = 1; U = {| a = { I = 2; U = {| a = { I = 3; U = Unchecked.defaultof<_> } |} } |} } +let start = { T = "a"; I = 1; U = {| a = { T = "a"; I = 2; U = {| a = { T = "a"; I = 3; U = Unchecked.defaultof<_> } |} } |} } let actual = f start -let expected = { I = -1; U = {| a = { I = 2; U = {| a = { I = 0; U = Unchecked.defaultof<_> } |} } |} } +let expected = { T = "a"; I = -1; U = {| a = { T = "a"; I = 2; U = {| a = { T = "a"; I = 0; U = Unchecked.defaultof<_> } |} } |} } if actual <> expected then failwith "actual does not equal expected" From cf26fbb8ca529c59754ac203099a808c7e7f884a Mon Sep 17 00:00:00 2001 From: kerams Date: Sat, 4 Mar 2023 10:33:52 +0100 Subject: [PATCH 25/32] Deduplicate items in nested field update tooltips --- src/Compiler/Checking/CheckExpressions.fs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index c176c0e3a61..cf5bd02e7c7 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -1882,7 +1882,11 @@ let TransformAstForNestedUpdates cenv env overallTy (lid: LongIdent) exprBeingAs let rec buildLid res (id: Ident) = function | [] -> res - | (h: Ident) :: t -> if equals h.idRange id.idRange then h :: res else buildLid (h :: res) id t + | (h: Ident) :: t -> + // Mark these hidden field accesses as synthetic so that they don't make it + // into the name resolution sink. + let h = ident(h.idText, h.idRange.MakeSynthetic()) + if equals h.idRange id.idRange then h :: res else buildLid (h :: res) id t let rec combineIds = function From 679155e12771218330b73d0b47f2311a765b1b5b Mon Sep 17 00:00:00 2001 From: kerams Date: Tue, 7 Mar 2023 17:23:40 +0100 Subject: [PATCH 26/32] Refactor --- src/Compiler/Checking/CheckExpressions.fs | 22 ++++----- src/Compiler/Checking/NameResolution.fs | 58 ++++++++++++----------- 2 files changed, 41 insertions(+), 39 deletions(-) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index cf5bd02e7c7..fb49247c538 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -1893,14 +1893,14 @@ let TransformAstForNestedUpdates cenv env overallTy (lid: LongIdent) exprBeingAs | [] | [_] -> [] | id1 :: id2 :: rest -> (id1, id2) :: (id2 :: rest |> combineIds) - let calcLidSeparatorRanges lid = + let calcLidSeparatorRanges origSepRng lid = match lid with | [] | [_] -> [ origSepRng ] | _ :: t -> origSepRng :: List.map (fun (s: Ident, e: Ident) -> mkRange s.idRange.FileName s.idRange.End e.idRange.Start) t let lid = buildLid [] id lidwd |> List.rev - (lid, lid |> combineIds |> calcLidSeparatorRanges) + (lid, lid |> combineIds |> calcLidSeparatorRanges origSepRng) let totalRange (origId: Ident) (id: Ident) = mkRange origId.idRange.FileName origId.idRange.End id.idRange.Start @@ -1923,28 +1923,28 @@ let TransformAstForNestedUpdates cenv env overallTy (lid: LongIdent) exprBeingAs let rec synExprRecd copyInfo (id: Ident) fields exprBeingAssigned = match fields with | [] -> failwith "unreachable" - | (fldId, anonInfo) :: rest -> - let nestedField = if rest.IsEmpty then exprBeingAssigned else synExprRecd copyInfo fldId rest exprBeingAssigned + | (fieldId, anonInfo) :: rest -> + let nestedField = if rest.IsEmpty then exprBeingAssigned else synExprRecd copyInfo fieldId rest exprBeingAssigned let m = id.idRange.MakeSynthetic() match anonInfo with | Some { AnonRecdTypeInfo.TupInfo = TupInfo.Const isStruct } -> - let fields = [ LongIdentWithDots ([ fldId ], []), None, nestedField ] + let fields = [ LongIdentWithDots ([ fieldId ], []), None, nestedField ] SynExpr.AnonRecd(isStruct, copyInfo id, fields, m, { OpeningBraceRange = range0 }) | _ -> - let fields = [ SynExprRecordField((LongIdentWithDots ([ fldId ], []), true), None, Some nestedField, None) ] + let fields = [ SynExprRecordField((LongIdentWithDots ([ fieldId ], []), true), None, Some nestedField, None) ] SynExpr.Record(None, copyInfo id, fields, m) - let access, flds = ResolveNestedField cenv.tcSink cenv.nameResolver env.eNameResEnv env.eAccessRights overallTy lid + let access, fields = ResolveNestedField cenv.tcSink cenv.nameResolver env.eNameResEnv env.eAccessRights overallTy lid - match access, flds with + match access, fields with | [], [] -> failwith "unreachable" | accessIds, [] -> List.frontAndBack accessIds, Some exprBeingAssigned - | accessIds, [ (fldId, _) ] -> List.frontAndBack (accessIds @ [ fldId ]), Some exprBeingAssigned - | accessIds, (fldId, _) :: rest -> + | accessIds, [ (fieldId, _) ] -> List.frontAndBack (accessIds @ [ fieldId ]), Some exprBeingAssigned + | accessIds, (fieldId, _) :: rest -> checkLanguageFeatureAndRecover cenv.g.langVersion LanguageFeature.NestedCopyAndUpdate (rangeOfLid lid) - (accessIds, fldId), Some (synExprRecd (recdExprCopyInfo (flds |> List.map fst) withExpr) fldId rest exprBeingAssigned) + (accessIds, fieldId), Some (synExprRecd (recdExprCopyInfo (fields |> List.map fst) withExpr) fieldId rest exprBeingAssigned) let rec ApplyUnionCaseOrExn (makerForUnionCase, makerForExnTag) m (cenv: cenv) env overallTy item = let g = cenv.g diff --git a/src/Compiler/Checking/NameResolution.fs b/src/Compiler/Checking/NameResolution.fs index 2c8145a3641..c80e70e4fc6 100644 --- a/src/Compiler/Checking/NameResolution.fs +++ b/src/Compiler/Checking/NameResolution.fs @@ -3698,7 +3698,7 @@ let ResolveNestedField sink (ncenv: NameResolver) nenv ad recdTy lid = let g = ncenv.g let isAnonRecdTy = isAnonRecdTy g recdTy - let lookupFld ty (id: Ident) = + let lookupField ty (id: Ident) = let m = id.idRange match tryDestAnonRecdTy g ty with @@ -3707,7 +3707,7 @@ let ResolveNestedField sink (ncenv: NameResolver) nenv ad recdTy lid = | Some index -> OneSuccess (Choice2Of2 (anonInfo, tys[index])) | _ -> raze (Error(FSComp.SR.nrRecordDoesNotContainSuchLabel(NicePrint.minimalStringOfType nenv.eDisplayEnv ty, id.idText), m)) | _ -> - let otherRecdFlds ty = + let otherRecordFields ty = let typeName = NicePrint.minimalStringOfType nenv.eDisplayEnv ty [ @@ -3723,7 +3723,7 @@ let ResolveNestedField sink (ncenv: NameResolver) nenv ad recdTy lid = | _ -> // record label doesn't belong to record type -> suggest other labels of same record let suggestLabels addToBuffer = - for label in SuggestOtherLabelsOfSameRecordType g nenv ty id (otherRecdFlds ty) do + for label in SuggestOtherLabelsOfSameRecordType g nenv ty id (otherRecordFields ty) do addToBuffer label let typeName = NicePrint.minimalStringOfType nenv.eDisplayEnv ty @@ -3733,7 +3733,7 @@ let ResolveNestedField sink (ncenv: NameResolver) nenv ad recdTy lid = let frefs = match Map.tryFind id.idText nenv.eFieldLabels with | Some fields -> success fields - | None -> raze (SuggestLabelsOfRelatedRecords g nenv id (otherRecdFlds ty)) + | None -> raze (SuggestLabelsOfRelatedRecords g nenv id (otherRecordFields ty)) // Eliminate duplicates arising from multiple 'open' frefs @@ -3749,16 +3749,16 @@ let ResolveNestedField sink (ncenv: NameResolver) nenv ad recdTy lid = | [] -> [], [] | [ id ] -> let res = - lookupFld recdTy id + lookupField recdTy id |> ForceRaise |> List.map (fun x -> id, anonRecdInfoF x) [], res | id :: _ -> - let fldSearch () = + let fieldSearch () = match lid with | id :: rest -> - lookupFld recdTy id + lookupField recdTy id |?> List.map (fun x -> match x with | Choice1Of2 rfref -> None, id, rfref.RecdField.FormalType, rest @@ -3768,16 +3768,18 @@ let ResolveNestedField sink (ncenv: NameResolver) nenv ad recdTy lid = let tyconSearch ad () = match lid with | tyconId :: fieldId :: rest -> - let tcrefs = LookupTypeNameInEnvNoArity OpenQualified tyconId.idText nenv - if isNil tcrefs then NoResultsOrUsefulErrors else - let tcrefs = tcrefs |> List.map (fun tcref -> ResolutionInfo.Empty, tcref) + let tcrefs = + LookupTypeNameInEnvNoArity OpenQualified tyconId.idText nenv + |> List.map (fun tcref -> ResolutionInfo.Empty, tcref) - ResolveLongIdentInTyconRefs ResultCollectionSettings.AllResults ncenv nenv LookupKind.RecdField 1 tyconId.idRange ad fieldId rest typeNameResInfo fieldId.idRange tcrefs - |?> List.choose (fun x -> - match x with - | _, Item.RecdField (RecdFieldInfo (_, rfref)), rest -> Some (None, fieldId, rfref.RecdField.FormalType, rest) - | _, Item.AnonRecdField (anonInfo, tys, i, _), rest -> Some (Some anonInfo, fieldId, tys[i], rest) - | _ -> None) + if isNil tcrefs then + NoResultsOrUsefulErrors + else + ResolveLongIdentInTyconRefs ResultCollectionSettings.AllResults ncenv nenv LookupKind.RecdField 1 tyconId.idRange ad fieldId rest typeNameResInfo fieldId.idRange tcrefs + |?> List.choose (fun x -> + match x with + | _, Item.RecdField (RecdFieldInfo (_, rfref)), rest -> Some (None, fieldId, rfref.RecdField.FormalType, rest) + | _ -> None) | _ -> NoResultsOrUsefulErrors let moduleOrNsSearch ad () = @@ -3789,12 +3791,12 @@ let ResolveNestedField sink (ncenv: NameResolver) nenv ad recdTy lid = let fieldId = rest.[ rest.Length - restAfterField.Length - 1 ] None, fieldId, rfinfo.RecdField.FormalType, restAfterField) - let anonRecdInfo, fld, fldTy, rest = + let anonRecdInfo, fieldId, fieldTy, rest = let search = if isAnonRecdTy then - fldSearch () + fieldSearch () else - moduleOrNsSearch ad () +++ tyconSearch ad +++ moduleOrNsSearch AccessibleFromSomeFSharpCode +++ tyconSearch AccessibleFromSomeFSharpCode +++ fldSearch + moduleOrNsSearch ad () +++ tyconSearch ad +++ moduleOrNsSearch AccessibleFromSomeFSharpCode +++ tyconSearch AccessibleFromSomeFSharpCode +++ fieldSearch search |> AtMostOneResult id.idRange @@ -3804,27 +3806,27 @@ let ResolveNestedField sink (ncenv: NameResolver) nenv ad recdTy lid = if isAnonRecdTy then [] else - lid |> List.takeWhile (fun id -> not (equals id.idRange fld.idRange)) + lid |> List.takeWhile (fun id -> not (equals id.idRange fieldId.idRange)) match rest with - | [] -> idsBeforeField, [ (fld, anonRecdInfo) ] + | [] -> idsBeforeField, [ (fieldId, anonRecdInfo) ] | _ -> - let rec nestedFieldSearch flds ty = + let rec nestedFieldSearch fields ty = function - | [] -> flds + | [] -> fields | id :: rest -> - let resolved = lookupFld ty id |> ForceRaise - let fldTy = + let resolved = lookupField ty id |> ForceRaise + let fieldTy = match resolved with | [ Choice1Of2 rfref ] -> rfref.RecdField.FormalType - | [ Choice2Of2 (_, fldTy) ] -> fldTy + | [ Choice2Of2 (_, fieldTy) ] -> fieldTy | _ -> ty let resolved = resolved |> List.map (fun x -> id, anonRecdInfoF x) - nestedFieldSearch (flds @ resolved) fldTy rest + nestedFieldSearch (fields @ resolved) fieldTy rest - idsBeforeField, (fld, anonRecdInfo) :: (nestedFieldSearch [] fldTy rest) + idsBeforeField, (fieldId, anonRecdInfo) :: (nestedFieldSearch [] fieldTy rest) /// Resolve F#/IL "." syntax in expressions (2). /// From 6cccd109eddabd1ec14d620a791cf2ea852fcb76 Mon Sep 17 00:00:00 2001 From: kerams Date: Sat, 11 Mar 2023 07:08:30 +0100 Subject: [PATCH 27/32] Refactor --- src/Compiler/Checking/CheckExpressions.fs | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index fb49247c538..d6ecc8f25c4 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -1888,11 +1888,6 @@ let TransformAstForNestedUpdates cenv env overallTy (lid: LongIdent) exprBeingAs let h = ident(h.idText, h.idRange.MakeSynthetic()) if equals h.idRange id.idRange then h :: res else buildLid (h :: res) id t - let rec combineIds = - function - | [] | [_] -> [] - | id1 :: id2 :: rest -> (id1, id2) :: (id2 :: rest |> combineIds) - let calcLidSeparatorRanges origSepRng lid = match lid with | [] | [_] -> [ origSepRng ] @@ -1900,7 +1895,7 @@ let TransformAstForNestedUpdates cenv env overallTy (lid: LongIdent) exprBeingAs let lid = buildLid [] id lidwd |> List.rev - (lid, lid |> combineIds |> calcLidSeparatorRanges origSepRng) + (lid, List.pairwise lid |> calcLidSeparatorRanges origSepRng) let totalRange (origId: Ident) (id: Ident) = mkRange origId.idRange.FileName origId.idRange.End id.idRange.Start From 6f6997aa02bbfc33a0a3b7dbb067f5e0fdbc21b2 Mon Sep 17 00:00:00 2001 From: kerams Date: Mon, 13 Mar 2023 10:45:02 +0100 Subject: [PATCH 28/32] Refactor --- src/Compiler/Checking/CheckExpressions.fs | 5 ++--- src/Compiler/Checking/NameResolution.fs | 21 ++++++++++----------- 2 files changed, 12 insertions(+), 14 deletions(-) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index d6ecc8f25c4..94eab008c1c 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -1933,8 +1933,7 @@ let TransformAstForNestedUpdates cenv env overallTy (lid: LongIdent) exprBeingAs let access, fields = ResolveNestedField cenv.tcSink cenv.nameResolver env.eNameResEnv env.eAccessRights overallTy lid match access, fields with - | [], [] -> failwith "unreachable" - | accessIds, [] -> List.frontAndBack accessIds, Some exprBeingAssigned + | _, [] -> failwith "unreachable" | accessIds, [ (fieldId, _) ] -> List.frontAndBack (accessIds @ [ fieldId ]), Some exprBeingAssigned | accessIds, (fieldId, _) :: rest -> checkLanguageFeatureAndRecover cenv.g.langVersion LanguageFeature.NestedCopyAndUpdate (rangeOfLid lid) @@ -6657,7 +6656,7 @@ and TcRecordConstruction (cenv: cenv) (overallTy: TType) env tpenv withExprInfoO if not (Zset.subset ns2 ns1) then error(MissingFields(Zset.elements (Zset.diff ns2 ns1), m)) | _ -> - // `TransformAstForNestedUpdates` crates record constructions with synthetic ranges. + // `TransformAstForNestedUpdates` creates record constructions with synthetic ranges. // Don't emit the warning for nested field updates, because it does not really make sense. if oldFldsList.IsEmpty && not m.IsSynthetic then let enabledByLangFeature = g.langVersion.SupportsFeature LanguageFeature.WarningWhenCopyAndUpdateRecordChangesAllFields diff --git a/src/Compiler/Checking/NameResolution.fs b/src/Compiler/Checking/NameResolution.fs index c80e70e4fc6..cab81146c04 100644 --- a/src/Compiler/Checking/NameResolution.fs +++ b/src/Compiler/Checking/NameResolution.fs @@ -3730,15 +3730,14 @@ let ResolveNestedField sink (ncenv: NameResolver) nenv ad recdTy lid = let errorText = FSComp.SR.nrRecordDoesNotContainSuchLabel(typeName,id.idText) raze (ErrorWithSuggestions(errorText, m, id.idText, suggestLabels)) else - let frefs = - match Map.tryFind id.idText nenv.eFieldLabels with - | Some fields -> success fields - | None -> raze (SuggestLabelsOfRelatedRecords g nenv id (otherRecordFields ty)) - - // Eliminate duplicates arising from multiple 'open' - frefs - |?> ListSet.setify (fun fref1 fref2 -> tyconRefEq g fref1.TyconRef fref2.TyconRef) - |?> List.map Choice1Of2 + match Map.tryFind id.idText nenv.eFieldLabels with + | Some fields -> + // Eliminate duplicates arising from multiple 'open' + fields + |> ListSet.setify (fun fref1 fref2 -> tyconRefEq g fref1.TyconRef fref2.TyconRef) + |> List.map Choice1Of2 + |> success + | None -> raze (SuggestLabelsOfRelatedRecords g nenv id (otherRecordFields ty)) let anonRecdInfoF field = match field with @@ -3811,8 +3810,8 @@ let ResolveNestedField sink (ncenv: NameResolver) nenv ad recdTy lid = match rest with | [] -> idsBeforeField, [ (fieldId, anonRecdInfo) ] | _ -> - let rec nestedFieldSearch fields ty = - function + let rec nestedFieldSearch fields ty lid = + match lid with | [] -> fields | id :: rest -> let resolved = lookupField ty id |> ForceRaise From b6894c5ca787fe9582d5c0d43a83f471c7c1490d Mon Sep 17 00:00:00 2001 From: kerams Date: Tue, 14 Mar 2023 17:41:47 +0100 Subject: [PATCH 29/32] Address comments --- src/Compiler/Checking/CheckExpressions.fs | 24 ++++++++++++++++++----- src/Compiler/Checking/NameResolution.fs | 7 ++++++- 2 files changed, 25 insertions(+), 6 deletions(-) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 94eab008c1c..afdab18d3e6 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -1851,7 +1851,20 @@ let BuildFieldMap (cenv: cenv) env isPartial ty (flds: ((Ident list * Ident) * ' | _ -> error(Error(FSComp.SR.tcRecordFieldInconsistentTypes(), m))) tinst, tcref, fldsmap, List.rev rfldsList -/// Merges updates to nested record fields on the same level in record copy-and-update +/// Merges updates to nested record fields on the same level in record copy-and-update. +/// +/// `TransformAstForNestedUpdates` expands `{ x with A.B = 10; A.C = "" }` +/// +/// into +/// +/// { x with +/// A = { x.A with B = 10 }; +/// A = { x.A with C = "" } +/// } +/// +/// which we here convert to +/// +/// { x with A = { x.A with B = 10; C = "" } } let GroupUpdatesToNestedFields (fields: ((Ident list * Ident) * SynExpr option) list) = let rec groupIfNested res xs = match xs with @@ -1875,7 +1888,9 @@ let GroupUpdatesToNestedFields (fields: ((Ident list * Ident) * SynExpr option) else groupIfNested [] fields) -/// Expands a long identifier into nested copy-and-update expressions +/// Expands a long identifier into nested copy-and-update expressions. +/// +/// `{ x with A.B = 0 }` becomes `{ x with A = { x.A with B = 0 } }` let TransformAstForNestedUpdates cenv env overallTy (lid: LongIdent) exprBeingAssigned withExpr = let recdExprCopyInfo ids withExpr id = let upToId origSepRng id lidwd = @@ -7412,9 +7427,8 @@ and TcRecdExpr cenv overallTy env tpenv (inherits, withExprOpt, synRecdFields, m // we assume that parse errors were already reported raise (ReportedError None) - match withExprOpt, synLongId.LongIdent, exprBeingAssigned with - | _, [ id ], _ -> ([], id), exprBeingAssigned - | Some withExpr, lid, Some exprBeingAssigned -> TransformAstForNestedUpdates cenv env overallTy lid exprBeingAssigned withExpr + match withExprOpt, exprBeingAssigned with + | Some withExpr, Some exprBeingAssigned -> TransformAstForNestedUpdates cenv env overallTy synLongId.LongIdent exprBeingAssigned withExpr | _ -> List.frontAndBack synLongId.LongIdent, exprBeingAssigned) let flds = if hasOrigExpr then GroupUpdatesToNestedFields flds else flds diff --git a/src/Compiler/Checking/NameResolution.fs b/src/Compiler/Checking/NameResolution.fs index cab81146c04..e01fb2955c5 100644 --- a/src/Compiler/Checking/NameResolution.fs +++ b/src/Compiler/Checking/NameResolution.fs @@ -3692,7 +3692,12 @@ let ResolveField sink ncenv nenv ad ty mp id allFields = ResolutionInfo.SendEntityPathToSink(sink, ncenv, nenv, ItemOccurence.UseInType, ad, resInfo, checker) rfref) -/// Resolve a long identifier representing a nested record field +/// Resolve a long identifier representing a nested record field. +/// +/// Fields in copy-and-update expressions are specified using long identifiers - `{ x with A.B.C.D.E = 0 }`. +/// The name of the field to update may be prefixed by namespaces, modules and record type, and be suffixed by field +/// names of records nested within. Here we split the long identifier into a list of 0 or more identifiers +/// which act as the qualifiers, and a list of 1 or more identifiers which refer to actual record fields. let ResolveNestedField sink (ncenv: NameResolver) nenv ad recdTy lid = let typeNameResInfo = TypeNameResolutionInfo.Default let g = ncenv.g From 0868ffc88ee559b80a349307d5fbac6c4a2324c6 Mon Sep 17 00:00:00 2001 From: kerams Date: Tue, 14 Mar 2023 18:35:57 +0100 Subject: [PATCH 30/32] Ooops --- src/Compiler/Checking/CheckExpressions.fs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index afdab18d3e6..0d212615d9e 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -1949,7 +1949,7 @@ let TransformAstForNestedUpdates cenv env overallTy (lid: LongIdent) exprBeingAs match access, fields with | _, [] -> failwith "unreachable" - | accessIds, [ (fieldId, _) ] -> List.frontAndBack (accessIds @ [ fieldId ]), Some exprBeingAssigned + | accessIds, [ (fieldId, _) ] -> (accessIds, fieldId), Some exprBeingAssigned | accessIds, (fieldId, _) :: rest -> checkLanguageFeatureAndRecover cenv.g.langVersion LanguageFeature.NestedCopyAndUpdate (rangeOfLid lid) @@ -7427,8 +7427,9 @@ and TcRecdExpr cenv overallTy env tpenv (inherits, withExprOpt, synRecdFields, m // we assume that parse errors were already reported raise (ReportedError None) - match withExprOpt, exprBeingAssigned with - | Some withExpr, Some exprBeingAssigned -> TransformAstForNestedUpdates cenv env overallTy synLongId.LongIdent exprBeingAssigned withExpr + match withExprOpt, synLongId.LongIdent, exprBeingAssigned with + | _, [ id ], _ -> ([], id), exprBeingAssigned + | Some withExpr, lid, Some exprBeingAssigned -> TransformAstForNestedUpdates cenv env overallTy lid exprBeingAssigned withExpr | _ -> List.frontAndBack synLongId.LongIdent, exprBeingAssigned) let flds = if hasOrigExpr then GroupUpdatesToNestedFields flds else flds From 4fc7c3c495bf9cb68bd907eb725c5b129c1725b4 Mon Sep 17 00:00:00 2001 From: kerams Date: Wed, 15 Mar 2023 19:38:22 +0100 Subject: [PATCH 31/32] Address comments --- src/Compiler/Checking/CheckExpressions.fs | 105 +------------ .../Checking/CheckRecordSyntaxHelpers.fs | 140 ++++++++++++++++++ .../Checking/CheckRecordSyntaxHelpers.fsi | 20 +++ src/Compiler/FSharp.Compiler.Service.fsproj | 2 + .../Language/CopyAndUpdateTests.fs | 107 ++++++++++++- 5 files changed, 269 insertions(+), 105 deletions(-) create mode 100644 src/Compiler/Checking/CheckRecordSyntaxHelpers.fs create mode 100644 src/Compiler/Checking/CheckRecordSyntaxHelpers.fsi diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 0d212615d9e..a1cb3b8063b 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -17,6 +17,7 @@ open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AccessibilityLogic open FSharp.Compiler.AttributeChecking open FSharp.Compiler.CheckBasics +open FSharp.Compiler.CheckRecordSyntaxHelpers open FSharp.Compiler.ConstraintSolver open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Features @@ -1851,110 +1852,6 @@ let BuildFieldMap (cenv: cenv) env isPartial ty (flds: ((Ident list * Ident) * ' | _ -> error(Error(FSComp.SR.tcRecordFieldInconsistentTypes(), m))) tinst, tcref, fldsmap, List.rev rfldsList -/// Merges updates to nested record fields on the same level in record copy-and-update. -/// -/// `TransformAstForNestedUpdates` expands `{ x with A.B = 10; A.C = "" }` -/// -/// into -/// -/// { x with -/// A = { x.A with B = 10 }; -/// A = { x.A with C = "" } -/// } -/// -/// which we here convert to -/// -/// { x with A = { x.A with B = 10; C = "" } } -let GroupUpdatesToNestedFields (fields: ((Ident list * Ident) * SynExpr option) list) = - let rec groupIfNested res xs = - match xs with - | [] -> res - | x :: [] -> x :: res - | x :: y :: ys -> - match x, y with - | (lidwid, Some (SynExpr.Record (baseInfo, copyInfo, aFlds, m))), (_, Some (SynExpr.Record (recordFields = bFlds))) -> - let reducedRecd = (lidwid, Some(SynExpr.Record (baseInfo, copyInfo, aFlds @ bFlds, m))) - groupIfNested (reducedRecd :: res) ys - | (lidwid, Some (SynExpr.AnonRecd (isStruct, copyInfo, aFlds, m, trivia))), (_, Some (SynExpr.AnonRecd (recordFields = bFlds))) -> - let reducedRecd = (lidwid, Some(SynExpr.AnonRecd (isStruct, copyInfo, aFlds @ bFlds, m, trivia))) - groupIfNested (reducedRecd :: res) ys - | _ -> groupIfNested (x :: res) (y :: ys) - - fields - |> List.groupBy (fun ((_, field), _) -> field.idText) - |> List.collect (fun (_, fields) -> - if fields.Length < 2 then - fields - else - groupIfNested [] fields) - -/// Expands a long identifier into nested copy-and-update expressions. -/// -/// `{ x with A.B = 0 }` becomes `{ x with A = { x.A with B = 0 } }` -let TransformAstForNestedUpdates cenv env overallTy (lid: LongIdent) exprBeingAssigned withExpr = - let recdExprCopyInfo ids withExpr id = - let upToId origSepRng id lidwd = - let rec buildLid res (id: Ident) = - function - | [] -> res - | (h: Ident) :: t -> - // Mark these hidden field accesses as synthetic so that they don't make it - // into the name resolution sink. - let h = ident(h.idText, h.idRange.MakeSynthetic()) - if equals h.idRange id.idRange then h :: res else buildLid (h :: res) id t - - let calcLidSeparatorRanges origSepRng lid = - match lid with - | [] | [_] -> [ origSepRng ] - | _ :: t -> origSepRng :: List.map (fun (s: Ident, e: Ident) -> mkRange s.idRange.FileName s.idRange.End e.idRange.Start) t - - let lid = buildLid [] id lidwd |> List.rev - - (lid, List.pairwise lid |> calcLidSeparatorRanges origSepRng) - - let totalRange (origId: Ident) (id: Ident) = - mkRange origId.idRange.FileName origId.idRange.End id.idRange.Start - - let rangeOfBlockSeperator (id: Ident) = - let idEnd = id.idRange.End - let blockSeperatorStartCol = idEnd.Column - let blockSeperatorEndCol = blockSeperatorStartCol + 4 - let blockSeperatorStartPos = mkPos idEnd.Line blockSeperatorStartCol - let blockSeporatorEndPos = mkPos idEnd.Line blockSeperatorEndCol - - mkRange id.idRange.FileName blockSeperatorStartPos blockSeporatorEndPos - - match withExpr with - | SynExpr.Ident origId, (sepRange, _) -> - let lid, rng = upToId sepRange id (origId :: ids) - Some (SynExpr.LongIdent (false, LongIdentWithDots(lid, rng), None, totalRange origId id), (rangeOfBlockSeperator id, None)) - | _ -> None - - let rec synExprRecd copyInfo (id: Ident) fields exprBeingAssigned = - match fields with - | [] -> failwith "unreachable" - | (fieldId, anonInfo) :: rest -> - let nestedField = if rest.IsEmpty then exprBeingAssigned else synExprRecd copyInfo fieldId rest exprBeingAssigned - let m = id.idRange.MakeSynthetic() - - match anonInfo with - | Some { AnonRecdTypeInfo.TupInfo = TupInfo.Const isStruct } -> - let fields = [ LongIdentWithDots ([ fieldId ], []), None, nestedField ] - SynExpr.AnonRecd(isStruct, copyInfo id, fields, m, { OpeningBraceRange = range0 }) - | _ -> - let fields = [ SynExprRecordField((LongIdentWithDots ([ fieldId ], []), true), None, Some nestedField, None) ] - SynExpr.Record(None, copyInfo id, fields, m) - - let access, fields = ResolveNestedField cenv.tcSink cenv.nameResolver env.eNameResEnv env.eAccessRights overallTy lid - - match access, fields with - | _, [] -> failwith "unreachable" - | accessIds, [ (fieldId, _) ] -> (accessIds, fieldId), Some exprBeingAssigned - | accessIds, (fieldId, _) :: rest -> - checkLanguageFeatureAndRecover cenv.g.langVersion LanguageFeature.NestedCopyAndUpdate (rangeOfLid lid) - - (accessIds, fieldId), Some (synExprRecd (recdExprCopyInfo (fields |> List.map fst) withExpr) fieldId rest exprBeingAssigned) - let rec ApplyUnionCaseOrExn (makerForUnionCase, makerForExnTag) m (cenv: cenv) env overallTy item = let g = cenv.g let ad = env.eAccessRights diff --git a/src/Compiler/Checking/CheckRecordSyntaxHelpers.fs b/src/Compiler/Checking/CheckRecordSyntaxHelpers.fs new file mode 100644 index 00000000000..a8dd41f1eaf --- /dev/null +++ b/src/Compiler/Checking/CheckRecordSyntaxHelpers.fs @@ -0,0 +1,140 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +module internal FSharp.Compiler.CheckRecordSyntaxHelpers + +open FSharp.Compiler.CheckBasics +open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.Features +open FSharp.Compiler.NameResolution +open FSharp.Compiler.Syntax +open FSharp.Compiler.SyntaxTreeOps +open FSharp.Compiler.Text.Position +open FSharp.Compiler.Text.Range +open FSharp.Compiler.TypedTree + +/// Merges updates to nested record fields on the same level in record copy-and-update. +/// +/// `TransformAstForNestedUpdates` expands `{ x with A.B = 10; A.C = "" }` +/// +/// into +/// +/// { x with +/// A = { x.A with B = 10 }; +/// A = { x.A with C = "" } +/// } +/// +/// which we here convert to +/// +/// { x with A = { x.A with B = 10; C = "" } } +let GroupUpdatesToNestedFields (fields: ((Ident list * Ident) * SynExpr option) list) = + let rec groupIfNested res xs = + match xs with + | [] -> res + | x :: [] -> x :: res + | x :: y :: ys -> + match x, y with + | (lidwid, Some (SynExpr.Record (baseInfo, copyInfo, aFlds, m))), (_, Some (SynExpr.Record (recordFields = bFlds))) -> + let reducedRecd = + (lidwid, Some(SynExpr.Record(baseInfo, copyInfo, aFlds @ bFlds, m))) + + groupIfNested (reducedRecd :: res) ys + | (lidwid, Some (SynExpr.AnonRecd (isStruct, copyInfo, aFlds, m, trivia))), (_, Some (SynExpr.AnonRecd (recordFields = bFlds))) -> + let reducedRecd = + (lidwid, Some(SynExpr.AnonRecd(isStruct, copyInfo, aFlds @ bFlds, m, trivia))) + + groupIfNested (reducedRecd :: res) ys + | _ -> groupIfNested (x :: res) (y :: ys) + + fields + |> List.groupBy (fun ((_, field), _) -> field.idText) + |> List.collect (fun (_, fields) -> + if fields.Length < 2 then + fields + else + groupIfNested [] fields) + +/// Expands a long identifier into nested copy-and-update expressions. +/// +/// `{ x with A.B = 0 }` becomes `{ x with A = { x.A with B = 0 } }` +let TransformAstForNestedUpdates (cenv: TcFileState) env overallTy (lid: LongIdent) exprBeingAssigned withExpr = + let recdExprCopyInfo ids withExpr id = + let upToId origSepRng id lidwd = + let rec buildLid res (id: Ident) = + function + | [] -> res + | (h: Ident) :: t -> + // Mark these hidden field accesses as synthetic so that they don't make it + // into the name resolution sink. + let h = ident (h.idText, h.idRange.MakeSynthetic()) + + if equals h.idRange id.idRange then + h :: res + else + buildLid (h :: res) id t + + let calcLidSeparatorRanges origSepRng lid = + match lid with + | [] + | [ _ ] -> [ origSepRng ] + | _ :: t -> + origSepRng + :: List.map (fun (s: Ident, e: Ident) -> mkRange s.idRange.FileName s.idRange.End e.idRange.Start) t + + let lid = buildLid [] id lidwd |> List.rev + + (lid, List.pairwise lid |> calcLidSeparatorRanges origSepRng) + + let totalRange (origId: Ident) (id: Ident) = + mkRange origId.idRange.FileName origId.idRange.End id.idRange.Start + + let rangeOfBlockSeperator (id: Ident) = + let idEnd = id.idRange.End + let blockSeperatorStartCol = idEnd.Column + let blockSeperatorEndCol = blockSeperatorStartCol + 4 + let blockSeperatorStartPos = mkPos idEnd.Line blockSeperatorStartCol + let blockSeporatorEndPos = mkPos idEnd.Line blockSeperatorEndCol + + mkRange id.idRange.FileName blockSeperatorStartPos blockSeporatorEndPos + + match withExpr with + | SynExpr.Ident origId, (sepRange, _) -> + let lid, rng = upToId sepRange id (origId :: ids) + Some(SynExpr.LongIdent(false, LongIdentWithDots(lid, rng), None, totalRange origId id), (rangeOfBlockSeperator id, None)) + | _ -> None + + let rec synExprRecd copyInfo (id: Ident) fields exprBeingAssigned = + match fields with + | [] -> failwith "unreachable" + | (fieldId, anonInfo) :: rest -> + let nestedField = + if rest.IsEmpty then + exprBeingAssigned + else + synExprRecd copyInfo fieldId rest exprBeingAssigned + + let m = id.idRange.MakeSynthetic() + + match anonInfo with + | Some { + AnonRecdTypeInfo.TupInfo = TupInfo.Const isStruct + } -> + let fields = [ LongIdentWithDots([ fieldId ], []), None, nestedField ] + SynExpr.AnonRecd(isStruct, copyInfo id, fields, m, { OpeningBraceRange = range0 }) + | _ -> + let fields = + [ + SynExprRecordField((LongIdentWithDots([ fieldId ], []), true), None, Some nestedField, None) + ] + + SynExpr.Record(None, copyInfo id, fields, m) + + let access, fields = + ResolveNestedField cenv.tcSink cenv.nameResolver env.eNameResEnv env.eAccessRights overallTy lid + + match access, fields with + | _, [] -> failwith "unreachable" + | accessIds, [ (fieldId, _) ] -> (accessIds, fieldId), Some exprBeingAssigned + | accessIds, (fieldId, _) :: rest -> + checkLanguageFeatureAndRecover cenv.g.langVersion LanguageFeature.NestedCopyAndUpdate (rangeOfLid lid) + + (accessIds, fieldId), Some(synExprRecd (recdExprCopyInfo (fields |> List.map fst) withExpr) fieldId rest exprBeingAssigned) diff --git a/src/Compiler/Checking/CheckRecordSyntaxHelpers.fsi b/src/Compiler/Checking/CheckRecordSyntaxHelpers.fsi new file mode 100644 index 00000000000..b4eb4bc9948 --- /dev/null +++ b/src/Compiler/Checking/CheckRecordSyntaxHelpers.fsi @@ -0,0 +1,20 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +module internal FSharp.Compiler.CheckRecordSyntaxHelpers + +open FSharp.Compiler.CheckBasics +open FSharp.Compiler.Syntax +open FSharp.Compiler.Text +open FSharp.Compiler.TypedTree + +val GroupUpdatesToNestedFields: + fields: ((Ident list * Ident) * SynExpr option) list -> ((Ident list * Ident) * SynExpr option) list + +val TransformAstForNestedUpdates<'a> : + cenv: TcFileState -> + env: TcEnv -> + overallTy: TType -> + lid: LongIdent -> + exprBeingAssigned: SynExpr -> + withExpr: SynExpr * (range * 'a) -> + (Ident list * Ident) * SynExpr option diff --git a/src/Compiler/FSharp.Compiler.Service.fsproj b/src/Compiler/FSharp.Compiler.Service.fsproj index 2558f69a431..cc6f8b6dcaa 100644 --- a/src/Compiler/FSharp.Compiler.Service.fsproj +++ b/src/Compiler/FSharp.Compiler.Service.fsproj @@ -323,6 +323,8 @@ + + diff --git a/tests/FSharp.Compiler.ComponentTests/Language/CopyAndUpdateTests.fs b/tests/FSharp.Compiler.ComponentTests/Language/CopyAndUpdateTests.fs index 76597a224a6..544a387c0d5 100644 --- a/tests/FSharp.Compiler.ComponentTests/Language/CopyAndUpdateTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Language/CopyAndUpdateTests.fs @@ -100,6 +100,66 @@ let expected1 = { D = { B = "t2"; C = { A = 1 } }; E = None; F = 42 } let actual2 = { t1 with D.C.A = 3; E = Some "a" } let expected2 = { D = { B = "t1"; C = { A = 3 } }; E = Some "a"; F = 42 } +if actual1 <> expected1 then + failwith "actual1 does not equal expected1" + +if actual2 <> expected2 then + failwith "actual2 does not equal expected2" + """ + |> withLangVersionPreview + |> compileExeAndRun + |> shouldSucceed + +[] +let ``Nested copy-and-update correctly updates fields in nominal generic record``() = + FSharp """ +module CopyAndUpdateTests + +type AnotherNestedRecTy = { A: int } + +type NestdRecTy<'b> = { B: 'b; C: AnotherNestedRecTy } + +type RecTy<'b, 'e> = { D: NestdRecTy<'b>; E: 'e option; F: int } + +let t1 = { D = { B = "t1"; C = { A = 1 } }; E = Option.None; F = 42 } + +let actual1 = { t1 with D.B = "t2" } +let expected1 = { D = { B = "t2"; C = { A = 1 } }; E = None; F = 42 } + +let actual2 = { t1 with D.C.A = 3; E = Some "a" } +let expected2 = { D = { B = "t1"; C = { A = 3 } }; E = Some "a"; F = 42 } + +if actual1 <> expected1 then + failwith "actual1 does not equal expected1" + +if actual2 <> expected2 then + failwith "actual2 does not equal expected2" + """ + |> withLangVersionPreview + |> compileExeAndRun + |> shouldSucceed + +[] +let ``Nested copy-and-update correctly updates fields in nominal struct record``() = + FSharp """ +module CopyAndUpdateTests + +[] +type AnotherNestedRecTy = { A: int } + +type NestdRecTy = { B: string; C: AnotherNestedRecTy } + +[] +type RecTy = { D: NestdRecTy; E: string option; F: int } + +let t1 = { D = { B = "t1"; C = { A = 1 } }; E = None; F = 42 } + +let actual1 = { t1 with D.B = "t2" } +let expected1 = { D = { B = "t2"; C = { A = 1 } }; E = None; F = 42 } + +let actual2 = { t1 with D.C.A = 3; E = Some "a" } +let expected2 = { D = { B = "t1"; C = { A = 3 } }; E = Some "a"; F = 42 } + if actual1 <> expected1 then failwith "actual1 does not equal expected1" @@ -175,7 +235,7 @@ let ``Nested copy-and-update works correctly on recursive records``() = FSharp """ module CopyAndUpdateTests -type G = { T: string; U: {| a: G |}; I: int } +type G<'t> = { T: 't; U: {| a: G<'t> |}; I: int } let f x = { x with U.a.U.a.I = 0; I = -1 } @@ -191,6 +251,51 @@ if actual <> expected then |> compileExeAndRun |> shouldSucceed +[] +let ``Nested copy-and-update does not compile when assigning values of the wrong type``() = + FSharp """ +module CopyAndUpdateTests + +type AnotherNestedRecTy = { A: int } + +type NestdRecTy<'b> = { B: 'b; C: AnotherNestedRecTy } + +type RecTy<'b, 'e> = { D: NestdRecTy<'b>; E: 'e option; F: int } + +let t1 = { D = { B = "t1"; C = { A = 1 } }; E = Option.None; F = 42 } + +let actual1 = { t1 with D.B = 1 } + +let actual2 = { t1 with D.C.A = 3; E = Some 1.0 } + """ + |> withLangVersionPreview + |> typecheck + |> shouldFail + |> withResults [ + { + Error = Error 1 + Range = { StartLine = 12 + StartColumn = 31 + EndLine = 12 + EndColumn = 32 } + Message = @"This expression was expected to have type + 'string' +but here has type + 'int' " + } + { + Error = Error 1 + Range = { StartLine = 14 + StartColumn = 45 + EndLine = 14 + EndColumn = 48 } + Message = @"This expression was expected to have type + 'string' +but here has type + 'float' " + } + ] + [] let ``Anonymous record with nested copy-and-update can change shape``() = FSharp """ From a8cae6fb42c45e148ed52860c7335de4aacfed88 Mon Sep 17 00:00:00 2001 From: kerams Date: Fri, 17 Mar 2023 14:48:43 +0100 Subject: [PATCH 32/32] Add test with dotted field --- .../Language/CopyAndUpdateTests.fs | 21 +++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/tests/FSharp.Compiler.ComponentTests/Language/CopyAndUpdateTests.fs b/tests/FSharp.Compiler.ComponentTests/Language/CopyAndUpdateTests.fs index 544a387c0d5..ce1eb6b6703 100644 --- a/tests/FSharp.Compiler.ComponentTests/Language/CopyAndUpdateTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Language/CopyAndUpdateTests.fs @@ -110,6 +110,27 @@ if actual2 <> expected2 then |> compileExeAndRun |> shouldSucceed +[] +let ``Nested copy-and-update correctly updates fields in nominal record with dotted field``() = + FSharp """ +module CopyAndUpdateTests + +type A = { B: string } + +type Foo = { ``A.B``: string; A: A; C: int } + +let t1 = { ``A.B`` = "fooAB"; A = { B = "fooB" }; C = 42 } + +let actual = { t1 with Foo.``A.B`` = "barAB"; Foo.A.B = "barB" } +let expected = { ``A.B`` = "barAB"; A = { B = "barB" }; C = 42 } + +if actual <> expected then + failwith "actual does not equal expected" + """ + |> withLangVersionPreview + |> compileExeAndRun + |> shouldSucceed + [] let ``Nested copy-and-update correctly updates fields in nominal generic record``() = FSharp """