Skip to content
Open
Show file tree
Hide file tree
Changes from 1 commit
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions docs/release-notes/.FSharp.Compiler.Service/11.0.200.md
Original file line number Diff line number Diff line change
Expand Up @@ -31,6 +31,7 @@
* Preserve SRTP extension scopes across source files and competing witnesses through imported inline calls. Compile generic extension forwarding, including quotations, in unoptimized builds. Preserve applicable built-in operator priority in imported inline quotations. Do not reuse SRTP specializations across different selected witnesses. ([Issue #20683](https://github.com/dotnet/fsharp/issues/20683), [Issue #20684](https://github.com/dotnet/fsharp/issues/20684), [Issue #20685](https://github.com/dotnet/fsharp/issues/20685), [PR #20717](https://github.com/dotnet/fsharp/pull/20717))
* Transparent compiler: with `enablePartialTypeChecking`, a project that is only referenced by another project is type checked from its signatures. Implementation files that have a signature file are no longer parsed or type checked to produce the referenced assembly. `ParseAndCheckProject` still checks all files. ([PR #20703](https://github.com/dotnet/fsharp/pull/20703))
* With `enablePartialTypeChecking`, a project that is only referenced by another project no longer type checks its implementation files that have a signature file. Producing the referenced assembly only needs the signatures, but finalizing the project also collected the diagnostics of the skipped files, which type checked all of them and kept their results in memory. `ParseAndCheckProject` still reports the diagnostics of these files. ([PR #20699](https://github.com/dotnet/fsharp/pull/20699))
* Checker: check record spreads once

### Changed

Expand Down
241 changes: 109 additions & 132 deletions src/Compiler/Checking/CheckDeclarations.fs

Large diffs are not rendered by default.

11 changes: 6 additions & 5 deletions src/Compiler/Checking/Expressions/CheckExpressions.fs
Original file line number Diff line number Diff line change
Expand Up @@ -1999,8 +1999,9 @@ let BuildFieldMap (cenv: cenv) env isPartial ty (flds: (Ident * ExplicitOrSpread
| [FieldResolution(rfinfo2, showDeprecated)] ->

// Record the precise resolution of the field for intellisense
let item = Item.RecdField(rfinfo2)
CallNameResolutionSink cenv.tcSink (ident.idRange, env.NameEnv, item, emptyTyparInst, ItemOccurrence.Use, ad)
if fldExpr.IsExplicit then
let item = Item.RecdField(rfinfo2)
CallNameResolutionSink cenv.tcSink (ident.idRange, env.NameEnv, item, emptyTyparInst, ItemOccurrence.Use, ad)

let fref2 = rfinfo2.RecdFieldRef

Expand Down Expand Up @@ -8163,11 +8164,11 @@ and TcRecdExpr cenv overallTy env tpenv (inherits, withExprOpt, synRecdFields, m
// Check if the overall type is an anon record type and if so raise an copy-update syntax error
// let f (r: {| A: int; C: int |}) = { r with A = 1; B = 2; C = 3 }
if isAnonRecdTy cenv.g overallTy || isStructAnonRecdTy cenv.g overallTy then
for fldId, _ in flds do
for fldId, fld in flds do
match TryFindAnonRecdFieldOfType g overallTy fldId.idText with
| Some item ->
| Some item when fld.IsExplicit ->
CallNameResolutionSink cenv.tcSink (fldId.idRange, env.eNameResEnv, item, emptyTyparInst, ItemOccurrence.UseInType, env.eAccessRights)
| None -> ()
| _ -> ()
let firstPartRange = withStartEnd mWholeExpr.Start (mkPos mWholeExpr.StartLine (mWholeExpr.StartColumn + 1)) mWholeExpr
// Use the left { in the expression
errorR(Error(FSComp.SR.chkCopyUpdateSyntaxInAnonRecords(), firstPartRange))
Expand Down
155 changes: 59 additions & 96 deletions src/Compiler/Checking/Spreads.fs
Original file line number Diff line number Diff line change
Expand Up @@ -47,14 +47,39 @@ let private (|NestedUpdate|_|) expr2 expr1 =
Some(SynExpr.AnonRecd(isStruct, copyInfo, fields1 @ fields2, m, trivia))
| _ -> None

/// The fields of a nominal or anonymous record type, as name resolution items.
let fieldItemsOfSpreadSrcTy (ncenv: NameResolver) m ad spreadSrcTy =
let g = ncenv.g

if isRecdTy g spreadSrcTy then
ResolveRecordOrClassFieldsOfType ncenv m ad spreadSrcTy false
else
tryDestAnonRecdTy g spreadSrcTy
|> ValueOption.map (fun (anonInfo, tys) ->
anonInfo.SortedIds
|> List.ofArray
|> List.mapi (fun i id -> Item.AnonRecdField(anonInfo, tys, i, id.idRange)))
|> ValueOption.defaultValue []

/// Formats a field of an anonymous record type for a diagnostic.
let private stringOfAnonRecdField (denv: DisplayEnv) fieldName ty =
let g = denv.g

let typars =
tryAppTy g ty
|> ValueOption.map (snd >> List.choose (tryDestTyparTy g >> ValueOption.toOption))
|> ValueOption.defaultValue []

LayoutRender.showL (NicePrint.prettyLayoutOfMemberSig denv ([], fieldName, typars, [], ty))

/// Functions for checking type spreads.
[<RequireQualifiedAccess>]
module Types =
/// Functions for checking record type spreads.
[<RequireQualifiedAccess>]
module Records =
/// Typechecks the given list of record fields or spreads.
let check checkSpreadsLanguageFeature tcField tcSpread (fieldsAndSpreads: SynFieldOrSpread list) : _ list =
/// Collects the fields of a record type definition from its explicit fields and spreads, applying the shadowing rules.
let check fieldOfExplicit fieldsOfSpread (fieldsAndSpreads: ExplicitOrSpread<'Explicit, 'Spread> list) : _ list =
let rec loop fields i fieldsAndSpreads =
match fieldsAndSpreads with
| [] ->
Expand All @@ -64,14 +89,13 @@ module Types =
|> List.sortBy (fun (i, _) -> i)
|> List.map (fun (_, r) -> r)

| SynFieldOrSpread.Field(SynField(idOpt = None)) :: fieldsAndSpreads -> loop fields i fieldsAndSpreads

| SynFieldOrSpread.Field(SynField(idOpt = Some fieldId) as synField) :: fieldsAndSpreads ->
let field, errorAmbiguousShadowing, infoExplicitShadowing = tcField synField
| ExplicitOrSpread.Explicit explicitField :: fieldsAndSpreads ->
let fieldName, field, errorAmbiguousShadowing, infoExplicitShadowing =
fieldOfExplicit explicitField

let fields =
fields
|> Map.change fieldId.idText (function
|> Map.change fieldName (function
| None -> Some(LeftwardExplicit, [ i, field ])
| Some(LeftwardExplicit, dupes) ->
errorAmbiguousShadowing ()
Expand All @@ -82,16 +106,14 @@ module Types =

loop fields (i + 1) fieldsAndSpreads

| SynFieldOrSpread.Spread(SynTypeSpread(range = m) as synSpread) :: fieldsAndSpreads ->
checkSpreadsLanguageFeature m

| ExplicitOrSpread.Spread spread :: fieldsAndSpreads ->
let rec collectFieldsFromSpread fields i fieldsFromSpread =
match fieldsFromSpread with
| [] -> fields, i
| (fieldId, field, warnAmbiguousShadowing, infoSpreadShadowing) :: fieldsFromSpread ->
| (fieldName, field, warnAmbiguousShadowing, infoSpreadShadowing) :: fieldsFromSpread ->
let fields =
fields
|> Map.change fieldId (function
|> Map.change fieldName (function
| None -> Some(NoLeftwardExplicit, [ i, field ])
| Some(LeftwardExplicit, _dupes) ->
warnAmbiguousShadowing ()
Expand All @@ -102,14 +124,23 @@ module Types =

collectFieldsFromSpread fields (i + 1) fieldsFromSpread

let fields, i = collectFieldsFromSpread fields i (tcSpread synSpread)
let fields, i = collectFieldsFromSpread fields i (fieldsOfSpread spread)
loop fields i fieldsAndSpreads

loop Map.empty 0 fieldsAndSpreads

/// Functions for checking value spreads.
[<RequireQualifiedAccess>]
module Values =
let private shadowingDiagnostics m (fmtedSpreadField: unit -> string) =
let warnAmbiguousShadowing () =
warning (Error(FSComp.SR.tcRecordExprSpreadFieldShadowsExplicitField (fmtedSpreadField ()), m))

let infoSpreadShadowing () =
informationalWarning (Error(FSComp.SR.tcRecordExprSpreadFieldShadowsSpreadField (fmtedSpreadField ()), m))

warnAmbiguousShadowing, infoSpreadShadowing

/// Functions for checking record spreads.
[<RequireQualifiedAccess>]
module Records =
Expand Down Expand Up @@ -288,19 +319,8 @@ module Values =

spreadSrcAddrExpr, (fun expr -> wrap (mkCompGenLet m spreadSrcAddrVal oldAddr expr))

let recordFieldsFromSpread =
if isRecdTy g tyOfSpreadSrcExpr then
ResolveRecordOrClassFieldsOfType cenv.nameResolver m ad tyOfSpreadSrcExpr false
else
tryDestAnonRecdTy g tyOfSpreadSrcExpr
|> ValueOption.map (fun (anonInfo, tys) ->
anonInfo.SortedIds
|> List.ofArray
|> List.mapi (fun i id -> Item.AnonRecdField(anonInfo, tys, i, id.idRange)))
|> ValueOption.defaultValue []

let fields =
recordFieldsFromSpread
fieldItemsOfSpreadSrcTy cenv.nameResolver m ad tyOfSpreadSrcExpr
|> List.choose (fun field ->
match field with
| Item.RecdField fieldInfo ->
Expand All @@ -310,44 +330,21 @@ module Values =
let fieldId = ident (fieldInfo.RecdField.Id.idText, mExpr)
let ty = fieldInfo.FieldType

let warnAmbiguousShadowing () =
let fmtedSpreadField =
NicePrint.stringOfRecdField env.DisplayEnv cenv.infoReader fieldInfo.TyconRef fieldInfo.RecdField

warning (Error(FSComp.SR.tcRecordExprSpreadFieldShadowsExplicitField fmtedSpreadField, m))

let infoSpreadShadowing () =
let fmtedSpreadField =
NicePrint.stringOfRecdField env.DisplayEnv cenv.infoReader fieldInfo.TyconRef fieldInfo.RecdField

informationalWarning (Error(FSComp.SR.tcRecordExprSpreadFieldShadowsSpreadField fmtedSpreadField, m))
let warnAmbiguousShadowing, infoSpreadShadowing =
shadowingDiagnostics m (fun () ->
NicePrint.stringOfRecdField env.DisplayEnv cenv.infoReader fieldInfo.TyconRef fieldInfo.RecdField)

Some(fieldId, ExplicitOrSpread.Spread(ty, fieldExpr), warnAmbiguousShadowing, infoSpreadShadowing)

| Item.AnonRecdField(anonInfo, tys, fieldIndex, _) ->
let fieldExpr =
mkAnonRecdFieldGet g (anonInfo, spreadSrcAddrExpr, tys, fieldIndex, mExpr)

let fieldId = anonInfo.SortedIds[fieldIndex]
let fieldId = ident (anonInfo.SortedNames[fieldIndex], mExpr)
let ty = tys[fieldIndex]

let getFmtedSpreadField () =
let typars =
tryAppTy g ty
|> ValueOption.map (snd >> List.choose (tryDestTyparTy g >> ValueOption.toOption))
|> ValueOption.defaultValue []

LayoutRender.showL (
NicePrint.prettyLayoutOfMemberSig env.DisplayEnv ([], fieldId.idText, typars, [], ty)
)

let warnAmbiguousShadowing () =
warning (Error(FSComp.SR.tcRecordExprSpreadFieldShadowsExplicitField (getFmtedSpreadField ()), m))

let infoSpreadShadowing () =
informationalWarning (
Error(FSComp.SR.tcRecordExprSpreadFieldShadowsSpreadField (getFmtedSpreadField ()), m)
)
let warnAmbiguousShadowing, infoSpreadShadowing =
shadowingDiagnostics m (fun () -> stringOfAnonRecdField env.DisplayEnv fieldId.idText ty)

Some(fieldId, ExplicitOrSpread.Spread(ty, fieldExpr), warnAmbiguousShadowing, infoSpreadShadowing)

Expand Down Expand Up @@ -585,23 +582,12 @@ module Values =

spreadSrcAddrExpr, (fun expr -> wrap (mkCompGenLet m spreadSrcAddrVal oldAddr expr))

let recordFieldsFromSpread =
if isRecdTy g tyOfSpreadSrcExpr then
ResolveRecordOrClassFieldsOfType cenv.nameResolver m ad tyOfSpreadSrcExpr false
else
tryDestAnonRecdTy g tyOfSpreadSrcExpr
|> ValueOption.map (fun (anonInfo, tys) ->
anonInfo.SortedIds
|> List.ofArray
|> List.mapi (fun i id -> Item.AnonRecdField(anonInfo, tys, i, id.idRange)))
|> ValueOption.defaultValue []

let fields =
recordFieldsFromSpread
fieldItemsOfSpreadSrcTy cenv.nameResolver m ad tyOfSpreadSrcExpr
|> List.choose (fun field ->
match field with
| Item.RecdField fieldInfo ->
let fieldId = fieldInfo.RecdField.Id
let fieldId = fieldInfo.RecdField.Id.MakeSynthetic()

let ty =
possibleTargetTyAt fieldId.idText
Expand All @@ -620,22 +606,14 @@ module Values =
let fieldExpr = mkCoerceIfNeeded g ty (tyOfExpr g fieldExpr) fieldExpr
fieldExpr

let warnAmbiguousShadowing () =
let fmtedSpreadField =
NicePrint.stringOfRecdField env.DisplayEnv cenv.infoReader fieldInfo.TyconRef fieldInfo.RecdField

warning (Error(FSComp.SR.tcRecordExprSpreadFieldShadowsExplicitField fmtedSpreadField, m))

let infoSpreadShadowing () =
let fmtedSpreadField =
NicePrint.stringOfRecdField env.DisplayEnv cenv.infoReader fieldInfo.TyconRef fieldInfo.RecdField

informationalWarning (Error(FSComp.SR.tcRecordExprSpreadFieldShadowsSpreadField fmtedSpreadField, m))
let warnAmbiguousShadowing, infoSpreadShadowing =
shadowingDiagnostics m (fun () ->
NicePrint.stringOfRecdField env.DisplayEnv cenv.infoReader fieldInfo.TyconRef fieldInfo.RecdField)

Some(fieldId, ty, tcField, warnAmbiguousShadowing, infoSpreadShadowing)

| Item.AnonRecdField(anonInfo, tys, fieldIndex, _) ->
let fieldId = anonInfo.SortedIds[fieldIndex]
let fieldId = anonInfo.SortedIds[fieldIndex].MakeSynthetic()

let ty =
possibleTargetTyAt fieldId.idText
Expand All @@ -654,23 +632,8 @@ module Values =
let fieldExpr = mkCoerceIfNeeded g ty (tyOfExpr g fieldExpr) fieldExpr
fieldExpr

let getFmtedSpreadField () =
let typars =
tryAppTy g ty
|> ValueOption.map (snd >> List.choose (tryDestTyparTy g >> ValueOption.toOption))
|> ValueOption.defaultValue []

LayoutRender.showL (
NicePrint.prettyLayoutOfMemberSig env.DisplayEnv ([], fieldId.idText, typars, [], ty)
)

let warnAmbiguousShadowing () =
warning (Error(FSComp.SR.tcRecordExprSpreadFieldShadowsExplicitField (getFmtedSpreadField ()), m))

let infoSpreadShadowing () =
informationalWarning (
Error(FSComp.SR.tcRecordExprSpreadFieldShadowsSpreadField (getFmtedSpreadField ()), m)
)
let warnAmbiguousShadowing, infoSpreadShadowing =
shadowingDiagnostics m (fun () -> stringOfAnonRecdField env.DisplayEnv fieldId.idText ty)

Some(fieldId, ty, tcField, warnAmbiguousShadowing, infoSpreadShadowing)

Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -180,7 +180,7 @@ let GetAllUsesOfAllSymbols() : Task =
let! checkProjectResults = checker.ParseAndCheckProject(options)
let result = checkProjectResults.GetAllUsesOfAllSymbols()

if result.Length <> 79 then failwith $"Expected 79 symbolUses, got {result.Length}:\n%A{result}"
if result.Length <> 75 then failwith $"Expected 75 symbolUses, got {result.Length}:\n%A{result}"
}

[<Fact>]
Expand Down
Loading
Loading