It works, but it sure ain't pretty

Author: brianrourkeboll

src/Compiler/Checking/Expressions/CheckExpressions.fs

@@ -8065,7 +8065,93 @@ and TcNewAnonRecdExpr cenv (overallTy: TType) env tpenv (isStruct, unsortedField
 
     let maybeAnonRecdTargetTy = tryDestAnonRecdTy g overallTy
 
+    let possibleTargetTyAt =
+        match maybeAnonRecdTargetTy with
+        | ValueSome (anonInfo, tys) ->
+            let names = anonInfo.SortedNames
+            let tys = List.toArray tys
+            fun name ->
+                let i = Array.BinarySearch (names, name)
+                if i < 0 then ValueNone
+                else ValueSome tys[i]
+        | ValueNone -> fun _ -> ValueNone
+
     let spreadSrcs, unsortedCheckedFields, sortedCheckedFields, tpenv =
+        let (|LeftwardExplicit|NoLeftwardExplicit|) hasLeftwardExplicit = if hasLeftwardExplicit then LeftwardExplicit else NoLeftwardExplicit
+        let LeftwardExplicit = true
+        let NoLeftwardExplicit = false
+
+        let rec mkTcFuncs tys i fieldsAndSpreads =
+            match fieldsAndSpreads with
+            | [] ->
+                let acc =
+                    (Map.empty, tys) ||> Map.fold (fun acc _ (_, tys) ->
+                        let (i, ty), tys = List.headAndTail tys
+                        let acc = acc |> Map.add i (fun _ expr tpenv -> ty, TcExprFlex cenv true false ty env tpenv expr)
+                        (acc, tys) ||> List.fold (fun acc (i, ty) -> acc |> Map.add i (fun m _ tpenv -> ty, (mkThrow m ty (mkOne g m), tpenv))))
+
+                fun i m expr tpenv ->
+                    acc
+                    |> Map.tryFind i
+                    |> Option.map (fun tc -> tc m expr tpenv)
+                    |> Option.defaultWith (fun () -> g.obj_ty_ambivalent, (mkThrow m g.obj_ty_ambivalent (mkOne g m), tpenv))
+
+            | SynExprAnonRecordFieldOrSpread.Field (SynExprAnonRecordField (fieldName = SynLongIdent (([] | _ :: _ :: _), _, _); range = m), _) :: _ ->
+                error (InternalError ("All field names should have been transformed into simple identifiers by this point.", m))
+
+            // Explicitly redeclared fields are not allowed:
+            //     {| A = 3; A = 4 |}
+            //               ↑ error FS3522
+            | SynExprAnonRecordFieldOrSpread.Field (SynExprAnonRecordField (fieldName = SynLongIdent ([fieldId], _, _)), _) :: fieldsAndSpreads ->
+                let ty = possibleTargetTyAt fieldId.idText |> ValueOption.defaultWith (fun () -> NewInferenceType g)
+
+                let tys =
+                    tys |> Map.change fieldId.idText (function
+                        | None -> Some (LeftwardExplicit, [i, ty])
+                        | Some (LeftwardExplicit, dupes) -> Some (LeftwardExplicit, (i, ty) :: dupes)
+                        | Some (NoLeftwardExplicit, _dupes) -> Some (LeftwardExplicit, [i, ty]))
+
+                mkTcFuncs tys (i + 1) fieldsAndSpreads
+
+            // Field shadowing from spreads is allowed:
+            //     let a = {| A = 3 |}
+            //     let b = {| A = "4" |}
+            //     let c = {| ...a; ...b |} → {| A = "4" |}
+            | SynExprAnonRecordFieldOrSpread.Spread (SynExprSpread (expr = expr; range = m), _) :: fieldsAndSpreads ->
+                checkLanguageFeatureAndRecover g.langVersion LanguageFeature.RecordSpreads m
+
+                let flex = false
+                let spreadSrcExpr, _ = TcExprFlex cenv flex false (NewInferenceType g) env tpenv expr
+                let tyOfSpreadSrcExpr = tyOfExpr g spreadSrcExpr
+
+                let fieldsFromSpread =
+                    if isRecdTy g tyOfSpreadSrcExpr then
+                        ResolveRecordOrClassFieldsOfType cenv.nameResolver m ad tyOfSpreadSrcExpr false
+                        |> List.choose (function
+                            | Item.RecdField field ->
+                                let fieldId = field.RecdField.Id.idText
+                                Some (fieldId, possibleTargetTyAt fieldId |> ValueOption.defaultValue field.FieldType)
+                            | _ -> None)
+                    else
+                        match tryDestAnonRecdTy g tyOfSpreadSrcExpr with
+                        | ValueSome (anonInfo, tys) ->
+                            tys |> List.mapi (fun j ty ->
+                                let fieldId = anonInfo.SortedNames[j]
+                                fieldId, possibleTargetTyAt fieldId |> ValueOption.defaultValue ty)
+                        | ValueNone -> []
+
+                let i, tys =
+                    ((i, tys), fieldsFromSpread)
+                    ||> List.fold (fun (i, tys) (fieldId, ty) ->
+                        i + 1, tys |> Map.change fieldId (function
+                            | None -> Some (NoLeftwardExplicit, [i, ty])
+                            | Some (LeftwardExplicit, _dupes) -> Some (LeftwardExplicit, [i, ty])
+                            | Some (NoLeftwardExplicit, _dupes) -> Some (NoLeftwardExplicit, [i, ty])))
+
+                mkTcFuncs tys i fieldsAndSpreads
+
+        let targetTys = mkTcFuncs Map.empty 0 unsortedFieldIdsAndSynExprsGiven
+
         let rec tcFieldsAndSpreads spreadSrcs checkedFields i tpenv fieldsAndSpreads =
             let (|LeftwardExplicit|NoLeftwardExplicit|) hasLeftwardExplicit = if hasLeftwardExplicit then LeftwardExplicit else NoLeftwardExplicit
             let LeftwardExplicit = true
@@ -8105,9 +8191,7 @@ and TcNewAnonRecdExpr cenv (overallTy: TType) env tpenv (isStruct, unsortedField
             //     {| A = 3; A = 4 |}
             //               ↑ error FS3522
             | SynExprAnonRecordFieldOrSpread.Field (SynExprAnonRecordField (fieldName = SynLongIdent ([fieldId], _, _); expr = expr; range = m), _) :: fieldsAndSpreads ->
-                let flex = true
-                let ty = NewInferenceType g
-                let expr, tpenv = TcExprFlex cenv flex false ty env tpenv expr
+                let ty, (expr, tpenv) = targetTys i m expr tpenv
 
                 let checkedFields =
                     checkedFields |> Map.change fieldId.idText (function
@@ -8164,7 +8248,7 @@ and TcNewAnonRecdExpr cenv (overallTy: TType) env tpenv (isStruct, unsortedField
                         | Item.RecdField fieldInfo :: fieldsFromSpread ->
                             let fieldExpr = mkRecdFieldGetViaExprAddr (spreadSrcAddrExpr, fieldInfo.RecdFieldRef, fieldInfo.TypeInst, m)
                             let fieldId = fieldInfo.RecdFieldRef.RecdField.Id
-                            let ty = fieldInfo.FieldType
+                            let ty = possibleTargetTyAt fieldId.idText |> ValueOption.defaultValue fieldInfo.FieldType
 
                             let checkedFields =
                                 checkedFields |> Map.change fieldId.idText (function
@@ -8261,20 +8345,18 @@ and TcNewAnonRecdExpr cenv (overallTy: TType) env tpenv (isStruct, unsortedField
     let anonInfo, sortedFieldTys =
         let anonInfo, sortedFieldTys =
             match maybeAnonRecdTargetTy with
-            | ValueSome (anonInfo, ptys) ->
+            | ValueSome (anonInfo, _) ->
                 // Note: use the assembly of the known type, not the current assembly
                 // Note: use the structness of the known type, unless explicit
                 // Note: use the names of our type, since they are always explicit
                 let tupInfo = if isStruct then tupInfoStruct else anonInfo.TupInfo
                 let anonInfo = AnonRecdTypeInfo.Create(anonInfo.Assembly, tupInfo, sortedNames)
                 let sortedFieldTys =
-                    if List.length ptys = sortedNames.Length then ptys
-                    else
-                        [
-                            for KeyValue (_, (_, dupes)) in sortedCheckedFields do
-                                for _, _, ty, _ in dupes do
-                                    ty
-                        ]
+                    [
+                        for KeyValue (_, (_, dupes)) in sortedCheckedFields do
+                            for _, _, ty, _ in dupes do
+                                ty
+                    ]
                 anonInfo, sortedFieldTys
             | ValueNone ->
                 // Note: no known anonymous record type - use our assembly

tests/FSharp.Compiler.ComponentTests/Language/SpreadTests.fs

@@ -1171,6 +1171,28 @@ module NominalAndAnonymousRecords =
                 |> compileExeAndRun
                 |> shouldSucceed
 
+        module BackCompat =
+            [<Fact>]
+            let ``Inference works the same`` () =
+                let src =
+                    """
+                    let f x y =
+                        if x = y then ()
+                        else failwith $"Expected %A{x} = %A{y}."
+
+                    f {| a = 1 - 1 |} {| a = Unchecked.defaultof<_> |}
+
+                    #nowarn FS3883 // Spread shadowing explicit.
+
+                    let r = {| a = Unchecked.defaultof<_> |}
+                    f {| a = 1 - 1 |} {| a = "a"; ...r |}
+                    """
+
+                FSharp src
+                |> withLangVersion SupportedLangVersion
+                |> compileExeAndRun
+                |> shouldSucceed
+
         module Conversions =
             ()