Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
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
3 changes: 2 additions & 1 deletion docs/release-notes/.FSharp.Compiler.Service/11.0.0.md
Original file line number Diff line number Diff line change
Expand Up @@ -2,8 +2,9 @@

* Scripts: Fix resolving the dotnet host path when an SDK directory is specified. ([PR #18960](https://github.com/dotnet/fsharp/pull/18960))
* Fix excessive StackGuard thread jumping ([PR #18971](https://github.com/dotnet/fsharp/pull/18971))
* Checking: Fix checking nested fields for records and anonymous ([PR #18964](https://github.com/dotnet/fsharp/pull/18964))
* Fix name is bound multiple times is not reported in 'as' pattern ([PR #18984](https://github.com/dotnet/fsharp/pull/18984))
* Type relations cache: handle potentially "infinite" types ([PR #19010](https://github.com/dotnet/fsharp/pull/19010))
* Type relations cache: handle potentially "infinite" types ([PR #19010](https://github.com/dotnet/fsharp/pull/19010))

### Added

Expand Down
16 changes: 15 additions & 1 deletion src/Compiler/Checking/CheckRecordSyntaxHelpers.fs
Original file line number Diff line number Diff line change
Expand Up @@ -156,12 +156,26 @@ let TransformAstForNestedUpdates (cenv: TcFileState) (env: TcEnv) overallTy (lid
(accessIds, outerFieldId),
Some(synExprRecd (recdExprCopyInfo (fields |> List.map fst) withExpr) outerFieldId rest exprBeingAssigned)

/// This name is used when a complex expression is bound for use as a binding in a copy-and-update expression.
/// For example, in `{ f () with ... }`, `f ()` is replaced by `let bind@ = f ()`
let BindIdText = "bind@"

/// Finding the 'bind@' identifier is the only way to detect that an expression has already been bound.
let inline (|IsSimpleOrBoundExpr|_|) (withExprOpt: (SynExpr * BlockSeparator) option) =
match withExprOpt with
| None -> true
| Some(expr, _) ->
match expr with
| SynExpr.LongIdent(_, lIds, _, _) -> lIds.LongIdent |> List.exists (fun id -> id.idText = BindIdText)
| SynExpr.Ident _ -> true
| _ -> false

/// When the original expression in copy-and-update is more complex than `{ x with ... }`, like `{ f () with ... }`,
/// we bind it first, so that it's not evaluated multiple times during a nested update
let BindOriginalRecdExpr (withExpr: SynExpr * BlockSeparator) mkRecdExpr =
let originalExpr, blockSep = withExpr
let mOrigExprSynth = originalExpr.Range.MakeSynthetic()
let id = mkSynId mOrigExprSynth "bind@"
let id = mkSynId mOrigExprSynth BindIdText
let withExpr = SynExpr.Ident id, blockSep

let binding =
Expand Down
4 changes: 4 additions & 0 deletions src/Compiler/Checking/CheckRecordSyntaxHelpers.fsi
Original file line number Diff line number Diff line change
Expand Up @@ -19,5 +19,9 @@ val TransformAstForNestedUpdates<'a> :
withExpr: SynExpr * (range * 'a) ->
(Ident list * Ident) * SynExpr option

val BindIdText: string

val inline (|IsSimpleOrBoundExpr|_|): withExprOpt: (SynExpr * BlockSeparator) option -> bool

val BindOriginalRecdExpr:
withExpr: SynExpr * BlockSeparator -> mkRecdExpr: ((SynExpr * BlockSeparator) option -> SynExpr) -> SynExpr
10 changes: 4 additions & 6 deletions src/Compiler/Checking/Expressions/CheckExpressions.fs
Original file line number Diff line number Diff line change
Expand Up @@ -5895,9 +5895,8 @@ and TcExprUndelayed (cenv: cenv) (overallTy: OverallTy) env tpenv (synExpr: SynE
TcExprTuple cenv overallTy env tpenv (isExplicitStruct, args, m)

| SynExpr.AnonRecd (isStruct, withExprOpt, unsortedFieldExprs, mWholeExpr, trivia) ->
match withExprOpt with
| None
| Some(SynExpr.Ident _, _) ->
match withExprOpt with
| None | IsSimpleOrBoundExpr ->
TcNonControlFlowExpr env <| fun env ->
TcPossiblyPropagatingExprLeafThenConvert (fun ty -> isAnonRecdTy g ty || isTyparTy g ty) cenv overallTy env mWholeExpr (fun overallTy ->
TcAnonRecdExpr cenv overallTy env tpenv (isStruct, withExprOpt, unsortedFieldExprs, mWholeExpr)
Expand Down Expand Up @@ -5929,10 +5928,9 @@ and TcExprUndelayed (cenv: cenv) (overallTy: OverallTy) env tpenv (synExpr: SynE
let binds = unionBindingAndMembers binds members
TcExprObjectExpr cenv overallTy env tpenv (synObjTy, argopt, binds, extraImpls, mNewExpr, m)

| SynExpr.Record (inherits, withExprOpt, synRecdFields, mWholeExpr) ->
| SynExpr.Record (inherits, withExprOpt, synRecdFields, mWholeExpr) ->
match withExprOpt with
| None
| Some(SynExpr.Ident _, _) ->
| None | IsSimpleOrBoundExpr ->
TcNonControlFlowExpr env <| fun env ->
TcExprRecord cenv overallTy env tpenv (inherits, withExprOpt, synRecdFields, mWholeExpr)
| Some withExpr ->
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -480,3 +480,56 @@ if actual <> expected then
|> withLangVersion80
|> compileExeAndRun
|> verifyOutput "once"

[<Fact>]
let ``N-Nested copy-and-update works when the starting expression is not a simple identifier``() =
FSharp """
module CopyAndUpdateTests
type SubSubTest = {
Z: int
}

type SubTest = {
Y: SubSubTest
}

type Test = {
X: SubTest
}

let getTest () =
{ X = { Y = { Z = 0 } } }

[<EntryPoint>]
let main argv =
let a = {
getTest () with
X.Y.Z = 1
}
printfn "%i" a.X.Y.Z |> ignore
0
"""
|> typecheck
|> shouldSucceed
|> verifyOutput "1"

[<Fact>]
let ``N-Nested, anonymous copy-and-update works when the starting expression is not a simple identifier``() =
FSharp """
module CopyAndUpdateTests

let getTest () =
{| X = {| Y = {| Z = 0 |} |} |}

[<EntryPoint>]
let main argv =
let a = {|
getTest () with
X.Y.Z = 1
|}
printfn "%i" a.X.Y.Z |> ignore
0
"""
|> typecheck
|> shouldSucceed
|> verifyOutput "1"
Loading