Merge remote-tracking branch 'upstream/main' into release-notes-ci-wo…

…rkflow

src/Compiler/Checking/CheckExpressions.fs

@@ -5643,11 +5643,17 @@ and TcExprUndelayed (cenv: cenv) (overallTy: OverallTy) env tpenv (synExpr: SynE
         TcNonControlFlowExpr env <| fun env ->
         TcExprTuple cenv overallTy env tpenv (isExplicitStruct, args, m)
 
-    | SynExpr.AnonRecd (isStruct, withExprOpt, unsortedFieldExprs, mWholeExpr, _) ->
-        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)
-        )
+    | SynExpr.AnonRecd (isStruct, withExprOpt, unsortedFieldExprs, mWholeExpr, trivia) ->
+        match withExprOpt with
+        | None
+        | Some(SynExpr.Ident _, _) ->
+            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 ->
+            BindOriginalRecdExpr withExpr (fun withExpr -> SynExpr.AnonRecd (isStruct, withExpr, unsortedFieldExprs, mWholeExpr, trivia))
+            |> TcExpr cenv overallTy env tpenv
 
     | SynExpr.ArrayOrList (isArray, args, m) ->
         TcNonControlFlowExpr env <| fun env ->
@@ -5673,8 +5679,14 @@ and TcExprUndelayed (cenv: cenv) (overallTy: OverallTy) env tpenv (synExpr: SynE
         TcExprObjectExpr cenv overallTy env tpenv (synObjTy, argopt, binds, extraImpls, mNewExpr, m)
 
     | SynExpr.Record (inherits, withExprOpt, synRecdFields, mWholeExpr) ->
-        TcNonControlFlowExpr env <| fun env ->
-        TcExprRecord cenv overallTy env tpenv (inherits, withExprOpt, synRecdFields, mWholeExpr)
+        match withExprOpt with
+        | None
+        | Some(SynExpr.Ident _, _) ->
+            TcNonControlFlowExpr env <| fun env ->
+            TcExprRecord cenv overallTy env tpenv (inherits, withExprOpt, synRecdFields, mWholeExpr)
+        | Some withExpr ->
+            BindOriginalRecdExpr withExpr (fun withExpr -> SynExpr.Record (inherits, withExpr, synRecdFields, mWholeExpr))
+            |> TcExpr cenv overallTy env tpenv
 
     | SynExpr.While (spWhile, synGuardExpr, synBodyExpr, m) ->
         TcExprWhileLoop cenv overallTy env tpenv (spWhile, synGuardExpr, synBodyExpr, m)
@@ -6813,6 +6825,12 @@ and TcObjectExprBinding (cenv: cenv) (env: TcEnv) implTy tpenv (absSlotInfo, bin
                 let logicalMethId = id
                 let memberFlags = OverrideMemberFlags SynMemberKind.Member
                 bindingRhs, logicalMethId, memberFlags
+
+            | SynPat.Named (SynIdent(id,_), _, _, _), Some memberFlags ->
+                CheckMemberFlags None NewSlotsOK OverridesOK memberFlags mBinding
+                let bindingRhs = PushOnePatternToRhs cenv true (mkSynThisPatVar (ident (CompilerGeneratedName "this", id.idRange))) bindingRhs
+                let logicalMethId = id
+                bindingRhs, logicalMethId, memberFlags
 
             | SynPat.InstanceMember(thisId, memberId, _, _, _), Some memberFlags ->
                 CheckMemberFlags None NewSlotsOK OverridesOK memberFlags mBinding
@@ -7018,17 +7036,17 @@ and TcObjectExpr (cenv: cenv) env tpenv (objTy, realObjTy, argopt, binds, extraI
 
             DispatchSlotChecking.CheckOverridesAreAllUsedOnce (env.DisplayEnv, g, cenv.infoReader, true, implTy, dispatchSlotsKeyed, availPriorOverrides, overrideSpecs)
 
-            DispatchSlotChecking.CheckDispatchSlotsAreImplemented (env.DisplayEnv, cenv.infoReader, m, env.NameEnv, cenv.tcSink, false, implTy, dispatchSlots, availPriorOverrides, overrideSpecs) |> ignore)
+            DispatchSlotChecking.CheckDispatchSlotsAreImplemented (env.DisplayEnv, cenv.infoReader, m, env.NameEnv, cenv.tcSink, false, true, implTy, dispatchSlots, availPriorOverrides, overrideSpecs) |> ignore)
 
         // 3. create the specs of overrides
         let allTypeImpls =
           overridesAndVirts |> List.map (fun (m, implTy, _, dispatchSlotsKeyed, _, overrides) ->
               let overrides' =
                   [ for overrideMeth in overrides do
                         let overrideInfo, (_, thisVal, methodVars, bindingAttribs, bindingBody) = overrideMeth
-                        let (Override(_, _, id, mtps, _, _, _, isFakeEventProperty, _, _)) = overrideInfo
+                        let (Override(_, _, id, mtps, _, _, _, isFakeEventProperty, _, isInstance)) = overrideInfo
 
-                        if not isFakeEventProperty then
+                        if not isFakeEventProperty && isInstance then
                             let searchForOverride =
                                 dispatchSlotsKeyed
                                 |> NameMultiMap.find id.idText
@@ -11249,7 +11267,7 @@ and ApplyAbstractSlotInference (cenv: cenv) (envinner: TcEnv) (_: Val option) (a
                      if instanceExpected then
                         errorR(Error(FSComp.SR.tcNoMemberFoundForOverride(), memberId.idRange))
                      else
-                        errorR (Error(FSComp.SR.tcNoStaticMemberFoundForOverride (), memberId.idRange))
+                        errorR(Error(FSComp.SR.tcNoStaticMemberFoundForOverride (), memberId.idRange))
                      []
 
                  | slot :: _ as slots ->

src/Compiler/Checking/CheckRecordSyntaxHelpers.fs

@@ -11,6 +11,9 @@ open FSharp.Compiler.SyntaxTreeOps
 open FSharp.Compiler.Text.Position
 open FSharp.Compiler.Text.Range
 open FSharp.Compiler.TypedTree
+open FSharp.Compiler.Xml
+open FSharp.Compiler.SyntaxTrivia
+open TypedTreeOps
 
 /// Merges updates to nested record fields on the same level in record copy-and-update.
 ///
@@ -146,3 +149,29 @@ let TransformAstForNestedUpdates (cenv: TcFileState) (env: TcEnv) overallTy (lid
 
         (accessIds, outerFieldId),
         Some(synExprRecd (recdExprCopyInfo (fields |> List.map fst) withExpr) outerFieldId rest exprBeingAssigned)
+
+/// 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 withExpr = SynExpr.Ident id, blockSep
+
+    let binding =
+        mkSynBinding
+            (PreXmlDoc.Empty, mkSynPatVar None id)
+            (None,
+             false,
+             false,
+             mOrigExprSynth,
+             DebugPointAtBinding.NoneAtSticky,
+             None,
+             originalExpr,
+             mOrigExprSynth,
+             [],
+             [],
+             None,
+             SynBindingTrivia.Zero)
+
+    SynExpr.LetOrUse(false, false, [ binding ], mkRecdExpr (Some withExpr), mOrigExprSynth, SynExprLetOrUseTrivia.Zero)

src/Compiler/Checking/CheckRecordSyntaxHelpers.fsi

@@ -3,7 +3,6 @@
 module internal FSharp.Compiler.CheckRecordSyntaxHelpers
 
 open FSharp.Compiler.CheckBasics
-open FSharp.Compiler.NameResolution
 open FSharp.Compiler.Syntax
 open FSharp.Compiler.Text
 open FSharp.Compiler.TypedTree
@@ -19,3 +18,6 @@ val TransformAstForNestedUpdates<'a> :
     exprBeingAssigned: SynExpr ->
     withExpr: SynExpr * (range * 'a) ->
         (Ident list * Ident) * SynExpr option
+
+val BindOriginalRecdExpr:
+    withExpr: SynExpr * BlockSeparator -> mkRecdExpr: ((SynExpr * BlockSeparator) option -> SynExpr) -> SynExpr

src/Compiler/Checking/MethodOverrides.fs

@@ -324,14 +324,15 @@ module DispatchSlotChecking =
     let CheckDispatchSlotsAreImplemented (denv, infoReader: InfoReader, m,
                                           nenv, sink: TcResultsSink,
                                           isOverallTyAbstract,
+                                          isObjExpr: bool,
                                           reqdTy,
                                           dispatchSlots: RequiredSlot list,
                                           availPriorOverrides: OverrideInfo list,
                                           overrides: OverrideInfo list) =
         let g = infoReader.g
         let amap = infoReader.amap
 
-        let isReqdTyInterface = isInterfaceTy g reqdTy 
+        let isReqdTyInterface = isInterfaceTy g reqdTy
         let showMissingMethodsAndRaiseErrors = (isReqdTyInterface || not isOverallTyAbstract)
 
         let mutable res = true
@@ -392,7 +393,7 @@ module DispatchSlotChecking =
                             noimpl()
                         | [ overrideBy ] ->
 
-                            let (Override(_, _, _, methTypars, _, argTys, _, _, _, _)) = overrideBy
+                            let (Override(_, _, _, methTypars, _, argTys, _, _, _, isInstance)) = overrideBy
 
                             let moreThanOnePossibleDispatchSlot =
                                 dispatchSlots
@@ -401,18 +402,21 @@ module DispatchSlotChecking =
                                 |> not
 
                             let (CompiledSig (vargTys, _, fvmethTypars, _)) = compiledSig
-
-                            if moreThanOnePossibleDispatchSlot then
-                                noimpl()
-
-                            elif argTys.Length <> vargTys.Length then
-                                fail(Error(FSComp.SR.typrelMemberDoesNotHaveCorrectNumberOfArguments(FormatOverride denv overrideBy, FormatMethInfoSig g amap m denv dispatchSlot), overrideBy.Range))
-                            elif methTypars.Length <> fvmethTypars.Length then
-                                fail(Error(FSComp.SR.typrelMemberDoesNotHaveCorrectNumberOfTypeParameters(FormatOverride denv overrideBy, FormatMethInfoSig g amap m denv dispatchSlot), overrideBy.Range))
-                            elif not (IsTyparKindMatch compiledSig overrideBy) then
-                                fail(Error(FSComp.SR.typrelMemberDoesNotHaveCorrectKindsOfGenericParameters(FormatOverride denv overrideBy, FormatMethInfoSig g amap m denv dispatchSlot), overrideBy.Range))
-                            else 
-                                fail(Error(FSComp.SR.typrelMemberCannotImplement(FormatOverride denv overrideBy, NicePrint.stringOfMethInfo infoReader m denv dispatchSlot, FormatMethInfoSig g amap m denv dispatchSlot), overrideBy.Range))
+
+                            // Object expressions can only implement instance members
+                            let isObjExprWithInstanceMembers = (isObjExpr && isInstance)
+                            if isObjExprWithInstanceMembers || isInstance then
+                                if moreThanOnePossibleDispatchSlot then
+                                    noimpl()
+
+                                elif (argTys.Length <> vargTys.Length) then
+                                    fail(Error(FSComp.SR.typrelMemberDoesNotHaveCorrectNumberOfArguments(FormatOverride denv overrideBy, FormatMethInfoSig g amap m denv dispatchSlot), overrideBy.Range))
+                                elif methTypars.Length <> fvmethTypars.Length then
+                                    fail(Error(FSComp.SR.typrelMemberDoesNotHaveCorrectNumberOfTypeParameters(FormatOverride denv overrideBy, FormatMethInfoSig g amap m denv dispatchSlot), overrideBy.Range))
+                                elif not (IsTyparKindMatch compiledSig overrideBy) then
+                                    fail(Error(FSComp.SR.typrelMemberDoesNotHaveCorrectKindsOfGenericParameters(FormatOverride denv overrideBy, FormatMethInfoSig g amap m denv dispatchSlot), overrideBy.Range))
+                                else 
+                                    fail(Error(FSComp.SR.typrelMemberCannotImplement(FormatOverride denv overrideBy, NicePrint.stringOfMethInfo infoReader m denv dispatchSlot, FormatMethInfoSig g amap m denv dispatchSlot), overrideBy.Range))
                         | overrideBy :: _ -> 
                             errorR(Error(FSComp.SR.typrelOverloadNotFound(FormatMethInfoSig g amap m denv dispatchSlot, FormatMethInfoSig g amap m denv dispatchSlot), overrideBy.Range))
 
@@ -599,11 +603,18 @@ module DispatchSlotChecking =
                 match relevantVirts |> List.filter (fun dispatchSlot -> IsPartialMatch g dispatchSlot (CompiledSigOfMeth g amap m dispatchSlot) overrideBy) with 
                 | [dispatchSlot] -> 
                     errorR(OverrideDoesntOverride(denv, overrideBy, Some dispatchSlot, g, amap, m))
-                | _ -> 
+                | _ ->
                     match relevantVirts |> List.filter (fun dispatchSlot -> IsNameMatch dispatchSlot overrideBy) with 
-                    | [] -> errorR(OverrideDoesntOverride(denv, overrideBy, None, g, amap, m))
-                    | [dispatchSlot] -> 
-                        errorR(OverrideDoesntOverride(denv, overrideBy, Some dispatchSlot, g, amap, m))
+                    | [] ->
+                        if isObjExpr && not overrideBy.IsInstance then
+                            errorR(Error(FSComp.SR.chkStaticMembersOnObjectExpressions(), overrideBy.Range))
+                        else
+                            errorR(OverrideDoesntOverride(denv, overrideBy, None, g, amap, m))
+                    | [dispatchSlot] ->
+                        if isObjExpr && not overrideBy.IsInstance then
+                            errorR(Error(FSComp.SR.chkStaticMembersOnObjectExpressions(), overrideBy.Range))
+                        else
+                            errorR(OverrideDoesntOverride(denv, overrideBy, Some dispatchSlot, g, amap, m))
                     | possibleDispatchSlots -> 
                        let details =
                             possibleDispatchSlots
@@ -820,7 +831,7 @@ module DispatchSlotChecking =
 
                 if isImplementation && not (isInterfaceTy g overallTy) then 
                     let overrides = allImmediateMembersThatMightImplementDispatchSlots |> List.map snd
-                    let allCorrect = CheckDispatchSlotsAreImplemented (denv, infoReader, m, nenv, sink, tcaug.tcaug_abstract, reqdTy, dispatchSlots, availPriorOverrides, overrides)
+                    let allCorrect = CheckDispatchSlotsAreImplemented (denv, infoReader, m, nenv, sink, tcaug.tcaug_abstract, false, reqdTy, dispatchSlots, availPriorOverrides, overrides)
 
                     // Tell the user to mark the thing abstract if it was missing implementations
                     if not allCorrect && not tcaug.tcaug_abstract && not (isInterfaceTy g reqdTy) then 

src/Compiler/Checking/MethodOverrides.fsi

@@ -113,6 +113,7 @@ module DispatchSlotChecking =
         nenv: NameResolutionEnv *
         sink: TcResultsSink *
         isOverallTyAbstract: bool *
+        isObjExpr: bool *
         reqdTy: TType *
         dispatchSlots: RequiredSlot list *
         availPriorOverrides: OverrideInfo list *

src/Compiler/Driver/CompilerDiagnostics.fs

@@ -1551,7 +1551,7 @@ type Exception with
 
                     // If implementation and required slot doesn't have same "instance-ness", then tell user that.
                     if impl.IsInstance <> minfoVirt.IsInstance then
-                        // Requried slot is instance, meaning implementation is static, tell user that we expect instance.
+                        // Required slot is instance, meaning implementation is static, tell user that we expect instance.
                         if minfoVirt.IsInstance then
                             os.AppendString(OverrideShouldBeStatic().Format)
                         else

src/Compiler/FSComp.txt

@@ -1730,3 +1730,4 @@ featureUnmanagedConstraintCsharpInterop,"Interop between C#'s and F#'s unmanaged
 3584,tcDotLambdaAtNotSupportedExpression,"Shorthand lambda syntax is only supported for atomic expressions, such as method, property, field or indexer on the implied '_' argument. For example: 'let f = _.Length'."
 3855,tcNoStaticMemberFoundForOverride,"No static abstract member was found that corresponds to this override"
 3859,tcNoStaticPropertyFoundForOverride,"No static abstract property was found that corresponds to this override"
+3860,chkStaticMembersOnObjectExpressions,"Static members are not allowed in object expressions."