diff --git a/src/Compiler/Checking/CheckRecordSyntaxHelpers.fs b/src/Compiler/Checking/CheckRecordSyntaxHelpers.fs index 861ad5587c6..66f33323621 100644 --- a/src/Compiler/Checking/CheckRecordSyntaxHelpers.fs +++ b/src/Compiler/Checking/CheckRecordSyntaxHelpers.fs @@ -156,12 +156,27 @@ let TransformAstForNestedUpdates (cenv: TcFileState) (env: TcEnv) overallTy (lid (accessIds, outerFieldId), Some(synExprRecd (recdExprCopyInfo (fields |> List.map fst) withExpr) outerFieldId rest exprBeingAssigned) +let BindIdText = "bind@" + +let IsNoneOrSimpleOrBoundExpr (withExprOpt: (SynExpr * BlockSeparator) option) = + match withExprOpt with + | None -> true + | Some (expr, _) -> + match expr with + | SynExpr.LongIdent (_, lIds, _, _) -> + lIds.LongIdent + |> List.tryFind (fun id -> id.idText = BindIdText) + |> _.IsSome + + | 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 = diff --git a/src/Compiler/Checking/CheckRecordSyntaxHelpers.fsi b/src/Compiler/Checking/CheckRecordSyntaxHelpers.fsi index 4e4f40d7504..7fa70c941dc 100644 --- a/src/Compiler/Checking/CheckRecordSyntaxHelpers.fsi +++ b/src/Compiler/Checking/CheckRecordSyntaxHelpers.fsi @@ -19,5 +19,10 @@ val TransformAstForNestedUpdates<'a> : withExpr: SynExpr * (range * 'a) -> (Ident list * Ident) * SynExpr option +val BindIdText: string + +val IsNoneOrSimpleOrBoundExpr: + withExprOpt: (SynExpr * BlockSeparator) option -> bool + val BindOriginalRecdExpr: withExpr: SynExpr * BlockSeparator -> mkRecdExpr: ((SynExpr * BlockSeparator) option -> SynExpr) -> SynExpr diff --git a/src/Compiler/Checking/Expressions/CheckExpressions.fs b/src/Compiler/Checking/Expressions/CheckExpressions.fs index 6979f20f0e0..344f07b190f 100644 --- a/src/Compiler/Checking/Expressions/CheckExpressions.fs +++ b/src/Compiler/Checking/Expressions/CheckExpressions.fs @@ -5895,14 +5895,13 @@ 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 _, _) -> + if IsNoneOrSimpleOrBoundExpr withExprOpt then 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) ) - | Some withExpr -> + else + let withExpr = withExprOpt.Value BindOriginalRecdExpr withExpr (fun withExpr -> SynExpr.AnonRecd (isStruct, withExpr, unsortedFieldExprs, mWholeExpr, trivia)) |> TcExpr cenv overallTy env tpenv @@ -5929,13 +5928,12 @@ 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) -> - match withExprOpt with - | None - | Some(SynExpr.Ident _, _) -> + | SynExpr.Record (inherits, withExprOpt, synRecdFields, mWholeExpr) -> + if IsNoneOrSimpleOrBoundExpr withExprOpt then TcNonControlFlowExpr env <| fun env -> TcExprRecord cenv overallTy env tpenv (inherits, withExprOpt, synRecdFields, mWholeExpr) - | Some withExpr -> + else + let withExpr = withExprOpt.Value BindOriginalRecdExpr withExpr (fun withExpr -> SynExpr.Record (inherits, withExpr, synRecdFields, mWholeExpr)) |> TcExpr cenv overallTy env tpenv diff --git a/tests/FSharp.Compiler.ComponentTests/Language/CopyAndUpdateTests.fs b/tests/FSharp.Compiler.ComponentTests/Language/CopyAndUpdateTests.fs index 1e29223eed4..b579c8b0188 100644 --- a/tests/FSharp.Compiler.ComponentTests/Language/CopyAndUpdateTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Language/CopyAndUpdateTests.fs @@ -480,3 +480,56 @@ if actual <> expected then |> withLangVersion80 |> compileExeAndRun |> verifyOutput "once" + +[] +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 } } } + +[] +let main argv = + let a = { + getTest () with + X.Y.Z = 1 + } + printfn "%i" a.X.Y.Z |> ignore + 0 + """ + |> typecheck + |> shouldSucceed + |> verifyOutput "1" + +[] +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 |} |} |} + +[] +let main argv = + let a = {| + getTest () with + X.Y.Z = 1 + |} + printfn "%i" a.X.Y.Z |> ignore + 0 + """ + |> typecheck + |> shouldSucceed + |> verifyOutput "1" \ No newline at end of file