Spread operator { ...expr }, { ...ty } for records

docs/release-notes/.FSharp.Compiler.Service/11.0.100.md

@@ -73,6 +73,7 @@
 * Added warning FS3884 when a function or delegate value is used as an interpolated string argument. ([PR #19289](https://github.com/dotnet/fsharp/pull/19289))
 * Symbols: add ObsoleteDiagnosticInfo ([PR #19359](https://github.com/dotnet/fsharp/pull/19359))
 * Add `#version;;` directive to F# Interactive to display version and environment information. ([Issue #13307](https://github.com/dotnet/fsharp/issues/13307), [PR #19332](https://github.com/dotnet/fsharp/pull/19332))
+* Spread operator for records ([RFC FS-1151](https://github.com/fsharp/fslang-design/pull/805), [PR #18927](https://github.com/dotnet/fsharp/pull/18927))
 
 ### Changed
 

docs/release-notes/.Language/preview.md

@@ -2,7 +2,8 @@
 
 * Warn (FS3884) when a function or delegate value is used as an interpolated string argument, since it will be formatted via `ToString` rather than being applied. ([PR #19289](https://github.com/dotnet/fsharp/pull/19289))
 * Added `MethodOverloadsCache` language feature (preview) that caches overload resolution results for repeated method calls, significantly improving compilation performance. ([PR #19072](https://github.com/dotnet/fsharp/pull/19072))
+* Spread operator for records ([RFC FS-1151](https://github.com/fsharp/fslang-design/pull/805), [PR #18927](https://github.com/dotnet/fsharp/pull/18927))
 
 ### Fixed
 
-### Changed
+### Changed

src/Compiler/Checking/CheckDeclarations.fs

@@ -1,4 +1,4 @@
-// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information.
+// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information.
 
 module internal FSharp.Compiler.CheckDeclarations
 
@@ -2607,6 +2607,8 @@ module EstablishTypeDefinitionCores =
         let m = tycon.Range
         let env = AddDeclaredTypars CheckForDuplicateTypars (tycon.Typars m) env
         let env = MakeInnerEnvForTyconRef env thisTyconRef false 
+        let ad = env.AccessRights
+        let spreadSrcTys = ResizeArray ()
         [ match synTyconRepr with 
           | SynTypeDefnSimpleRepr.None _ -> ()
           | SynTypeDefnSimpleRepr.Union (_, unionCases, _) -> 
@@ -2650,13 +2652,31 @@ module EstablishTypeDefinitionCores =
                           errorR(Error(FSComp.SR.tcStructsMustDeclareTypesOfImplicitCtorArgsExplicitly(), m))   
                       yield (ty, m)
 
-          | SynTypeDefnSimpleRepr.Record (_, fields, _) -> 
-              for SynField(fieldType = ty; range = m) in fields do 
+          | SynTypeDefnSimpleRepr.Record (_, fieldsAndSpreads, _) ->
+              let tcField (SynField (fieldType = ty; range = m)) =
                   let tyR, _ = TcTypeAndRecover cenv NoNewTypars NoCheckCxs ItemOccurrence.UseInType WarnOnIWSAM.Yes env tpenv ty
-                  yield (tyR, m)
+                  (tyR, m), ignore
+
+              let tcSpread (SynTypeSpread (ty = ty; range = m)) =
+                  let spreadSrcTy, _ = TcTypeAndRecover cenv NoNewTypars NoCheckCxs ItemOccurrence.UseInType WarnOnIWSAM.Yes env tpenv ty
+
+                  if isRecdTy g spreadSrcTy then
+                      spreadSrcTys.Add spreadSrcTy
+                      ResolveRecordOrClassFieldsOfType cenv.nameResolver m ad spreadSrcTy false
+                      |> List.choose (function
+                          | Item.RecdField field -> Some (field.RecdField.Id.idText, (field.FieldType, m), ignore)
+                          | _ -> None)
+                  else
+                      match tryDestAnonRecdTy g spreadSrcTy with
+                      | ValueSome (anonInfo, tys) -> tys |> List.mapi (fun i ty -> (anonInfo.SortedNames[i], (ty, m), ignore))
+                      | ValueNone -> []
+
+              // We must apply the spread shadowing logic here
+              // to get the correct set of field types.
+              yield! fieldsAndSpreads |> Spreads.Types.Records.check ignore tcField tcSpread
 
           | _ ->
-              () ]
+              () ], spreadSrcTys
 
     let ComputeModuleOrNamespaceKind g isModule typeNames attribs nm = 
         if not isModule then (Namespace true)
@@ -3607,14 +3627,104 @@ module EstablishTypeDefinitionCores =
                     let repr = Construct.MakeUnionRepr unionCases
                     repr, None, NoSafeInitInfo
 
-                | SynTypeDefnSimpleRepr.Record (_, fields, mRepr) -> 
+                | SynTypeDefnSimpleRepr.Record (_accessibility, fieldsAndSpreads, mRepr) -> 
                     noMeasureAttributeCheck()
                     noSealedAttributeCheck FSComp.SR.tcTypesAreAlwaysSealedRecord
                     noAbstractClassAttributeCheck()
                     noAllowNullLiteralAttributeCheck()
                     structLayoutAttributeCheck true  // these are allowed for records
-                    let recdFields = TcRecdUnionAndEnumDeclarations.TcNamedFieldDecls cenv envinner innerParent false tpenv fields
-                    recdFields |> CheckDuplicates (fun f -> f.Id) "field" |> ignore
+
+                    let recdFields =
+                        let tcField synField =
+                            let field = TcRecdUnionAndEnumDeclarations.TcNamedFieldDecl cenv envinner innerParent false tpenv synField |> Option.get
+                            let errorAmbiguousShadowing () = errorR (Duplicate ("field", field.Id.idText, field.Id.idRange))
+                            field, errorAmbiguousShadowing
+
+                        let tcSpread (SynTypeSpread (ty = ty; range = m)) =
+                            let (spreadSrcTy, _tpenv), error =
+                                try TcType cenv NoNewTypars CheckCxs ItemOccurrence.UseInType WarnOnIWSAM.Yes envinner tpenv ty, false with
+                                | RecoverableException e ->
+                                    errorRecovery e ty.Range
+                                    (g.obj_ty_ambivalent, tpenv), true
+
+                            let isValidSpreadSrcTy =
+                                (not g.checkNullness || (nullnessOfTy g spreadSrcTy).Evaluate() <> NullnessInfo.WithNull)
+                                && (error || isRecdTy g spreadSrcTy || isAnonRecdTy g spreadSrcTy)
+
+                            if isValidSpreadSrcTy then
+                                let spreadSrcTy =
+                                    tryAppTy g spreadSrcTy
+                                    |> ValueOption.map (fun (tcref, tinst) ->
+                                        let _, _, newTinst = FreshenTypeInst g m (tcref.Typars m)
+                                        SolveTyparsEqualTypes g cenv.css m newTinst tinst
+                                        TType_app (tcref, newTinst, g.knownWithoutNull))
+                                    |> ValueOption.defaultValue spreadSrcTy
+
+                                let recordFieldsFromSpread =
+                                    if isRecdTy g spreadSrcTy then
+                                        ResolveRecordOrClassFieldsOfType cenv.nameResolver 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 []
+
+                                recordFieldsFromSpread
+                                |> List.choose (fun field ->
+                                    match field with
+                                    | Item.RecdField fieldInfo ->
+                                        // Update the field ID's range to be that of the spread.
+                                        let syntheticId = ident (fieldInfo.RecdField.Id.idText, m)
+                                        let fieldTy = fieldInfo.FieldType
+                                        let recdField =
+                                            { fieldInfo.RecdField with
+                                                rfield_id = syntheticId
+                                                rfield_type = fieldTy }
+
+                                        let warnAmbiguousShadowing () =
+                                            let fmtedSpreadField = NicePrint.stringOfRecdField envinner.DisplayEnv cenv.infoReader fieldInfo.TyconRef recdField
+                                            let fmtedSpreadSrcTy = NicePrint.stringOfTy envinner.DisplayEnv spreadSrcTy
+                                            warning (Error (FSComp.SR.tcRecordTypeDefinitionSpreadFieldShadowsExplicitField (fmtedSpreadField, fmtedSpreadSrcTy), m))
+
+                                        Some (fieldInfo.RecdField.Id.idText, recdField, warnAmbiguousShadowing)
+
+                                    | Item.AnonRecdField (anonInfo, tys, fieldIndex, _) ->
+                                        let fieldId =
+                                            let orig = anonInfo.SortedIds[fieldIndex]
+                                            ident (orig.idText, m)
+
+                                        let ty = tys[fieldIndex]
+
+                                        let field =
+                                            let stat = false
+                                            let konst = None
+                                            let generated = false
+                                            let mut = false
+                                            let volatile = false
+                                            let pattribs = []
+                                            let fattribs = []
+                                            let vis = None
+                                            TcRecdUnionAndEnumDeclarations.MakeRecdFieldSpec g envinner innerParent (stat, konst, ty, pattribs, fattribs, fieldId, generated, mut, volatile, XmlDoc.Empty, vis, m)
+
+                                        let warnAmbiguousShadowing () =
+                                            let typars = tryAppTy g ty |> ValueOption.map (snd >> List.choose (tryDestTyparTy g >> ValueOption.toOption)) |> ValueOption.defaultValue []
+                                            let fmtedSpreadField = LayoutRender.showL (NicePrint.prettyLayoutOfMemberSig envinner.DisplayEnv ([], fieldId.idText, typars, [], ty))
+                                            let fmtedSpreadSrcTy = NicePrint.stringOfTy envinner.DisplayEnv spreadSrcTy
+                                            warning (Error (FSComp.SR.tcRecordTypeDefinitionSpreadFieldShadowsExplicitField (fmtedSpreadField, fmtedSpreadSrcTy), m))
+
+                                        Some (fieldId.idText, field, warnAmbiguousShadowing)
+
+                                    | _ -> None)
+                            else
+                                if not ty.IsFromParseError then
+                                    errorR (Error (FSComp.SR.tcRecordTypeDefinitionSpreadSourceMustBeRecord (), m))
+                                []
+
+                        let checkSpreadsLanguageFeature m = checkLanguageFeatureAndRecover g.langVersion LanguageFeature.RecordSpreads m
+                        fieldsAndSpreads |> Spreads.Types.Records.check checkSpreadsLanguageFeature tcField tcSpread
+
                     writeFakeRecordFieldsToSink recdFields
                     CallEnvSink cenv.tcSink (mRepr, envinner.NameEnv, ad)
 
@@ -4150,14 +4260,43 @@ module EstablishTypeDefinitionCores =
         // be satisfied, so we have to do this prior to checking any constraints.
         //
         // First find all the field types in all the structural types
-        let tyconsWithStructuralTypes = 
-            (envMutRecPrelim, withEnvs) 
-            ||> MutRecShapes.mapTyconsWithEnv (fun envForDecls (origInfo, tyconOpt) -> 
-                   match origInfo, tyconOpt with 
-                   | (typeDefCore, _, _), Some tycon -> Some (tycon, GetStructuralElementsOfTyconDefn cenv envForDecls tpenv typeDefCore tycon)
-                   | _ -> None) 
-            |> MutRecShapes.collectTycons 
-            |> List.choose id
+        let tyconsWithStructuralTypes =
+            let all =
+                (envMutRecPrelim, withEnvs) 
+                ||> MutRecShapes.mapTyconsWithEnv (fun envForDecls (origInfo, tyconOpt) -> 
+                       match origInfo, tyconOpt with 
+                       | (typeDefCore, _, _), Some tycon -> Some (tycon, GetStructuralElementsOfTyconDefn cenv envForDecls tpenv typeDefCore tycon)
+                       | _ -> None) 
+                |> MutRecShapes.collectTycons 
+                |> List.choose id
+
+            // Check for cyclic spreads.
+            do
+                if cenv.g.langVersion.SupportsFeature LanguageFeature.RecordSpreads then
+                    let (|PotentiallyRecursiveTycon|_|) ty =
+                        tryTcrefOfAppTy cenv.g ty
+                        |> ValueOption.bind _.TryDeref
+
+                    let edges =
+                        [
+                            for dst, (_, spreadSrcs) in all do
+                                for src in spreadSrcs do
+                                    match src with
+                                    | PotentiallyRecursiveTycon src -> dst, src
+                                    | _ -> ()
+                        ]
+
+                    let tycons =
+                        [
+                            for dst, src in edges do
+                                yield dst
+                                yield src
+                        ]
+
+                    let graph = Graph<Tycon, Stamp> (_.Stamp, tycons, edges)
+                    graph.IterateCycles (fun path -> errorR (Error (FSComp.SR.tcTypeDefinitionIsCyclicThroughSpreads (), (List.head path).Range)))
+
+            [for tycon, (tys, _) in all -> tycon, tys]
 
         let scSet = TyconConstraintInference.InferSetOfTyconsSupportingComparable cenv envMutRecPrelim.DisplayEnv tyconsWithStructuralTypes
         let seSet = TyconConstraintInference.InferSetOfTyconsSupportingEquatable cenv envMutRecPrelim.DisplayEnv tyconsWithStructuralTypes

src/Compiler/Checking/CheckPatterns.fs

@@ -498,13 +498,19 @@ and TcPatArrayOrList warnOnUpper cenv env vFlags patEnv ty isArray args m =
     phase2, acc
 
 and TcRecordPat warnOnUpper (cenv: cenv) env vFlags patEnv ty fieldPats m =
-    let fieldPats = 
+    let idents =
+        let (|Last|) = List.last
+        fieldPats
+        |> List.map (fun (NamePatPairField (fieldName = SynLongIdent (id = Last fieldId))) -> fieldId)
+
+    let fieldPats =
         fieldPats 
         |> List.map (fun (NamePatPairField(fieldName = fieldLid; pat = pat)) -> 
             match fieldLid.LongIdent with
-            | [id] -> ([], id), pat
-            | lid -> List.frontAndBack lid, pat)
+            | [id] -> ExplicitOrSpread.Explicit (([], id), pat)
+            | lid -> ExplicitOrSpread.Explicit (List.frontAndBack lid, pat))
 
+    CheckRecdExprDuplicateFields idents
     match BuildFieldMap cenv env false ty fieldPats m with
     | None -> (fun _ -> TPat_error m), patEnv
     | Some(tinst, tcref, fldsmap, _fldsList) ->
@@ -520,13 +526,14 @@ and TcRecordPat warnOnUpper (cenv: cenv) env vFlags patEnv ty fieldPats m =
     let fieldPats, patEnvR =
         (patEnv, ftys) ||> List.mapFold (fun s (ty, fsp) ->
             match fldsmap.TryGetValue fsp.rfield_id.idText with
-            | true, v ->
+            | true, ExplicitOrSpread.Explicit v ->
                 let warnOnUpper =
                     if cenv.g.langVersion.SupportsFeature(LanguageFeature.DontWarnOnUppercaseIdentifiersInBindingPatterns) then
                         AllIdsOK
                     else
                         warnOnUpper
                 TcPat warnOnUpper cenv env None vFlags s ty v
+            | true, ExplicitOrSpread.Spread _ -> (* Unreachable. *) error (InternalError ("Spreads in patterns are not supported.", m))
             | _ -> (fun _ -> TPat_wild m), s)
 
     let phase2 values =