Implement RFC fs-1025: Improve record type inference

src/fsharp/TypeChecker.fs

@@ -1884,22 +1884,27 @@ let BuildFieldMap cenv env isPartial ty flds m =
         let allFields = flds |> List.map (fun ((_,ident),_) -> ident)
         flds |> List.map (fun (fld,fldExpr) -> 
             let frefSet = ResolveField cenv.tcSink cenv.nameResolver env.eNameResEnv ad ty fld allFields
-            fld,frefSet, fldExpr)
+            fld,frefSet,fldExpr)
     let relevantTypeSets = 
         frefSets |> List.map (fun (_,frefSet,_) -> frefSet |> List.choose (fun (FieldResolution(rfref,_)) -> Some rfref.TyconRef))
 
     let tcref = 
         match List.fold (ListSet.intersect (tyconRefEq cenv.g)) (List.head relevantTypeSets) (List.tail relevantTypeSets) with
         | [tcref] -> tcref
-        | _ -> 
+        | tcrefs -> 
             if isPartial then 
                 warning (Error(FSComp.SR.tcFieldsDoNotDetermineUniqueRecordType(),m))
-            // OK, there isn't a unique type dictated by the intersection for the field refs. 
-            // We're going to get an error of some kind below. 
-            // Just choose one field ref and let the error come later 
-            let (_,frefSet1,_) = List.head frefSets
-            let (FieldResolution(fref1,_))= List.head frefSet1
-            fref1.TyconRef
+
+            // try finding a record type with the same number of fields as the ones that are given.
+            match tcrefs |> List.tryFind (fun tc -> tc.TrueFieldsAsList.Length = flds.Length) with
+            | Some tcref -> tcref            
+            | _ -> 
+                // OK, there isn't a unique, good type dictated by the intersection for the field refs. 
+                // We're going to get an error of some kind below. 
+                // Just choose one field ref and let the error come later 
+                let (_,frefSet1,_) = List.head frefSets
+                let (FieldResolution(fref1,_))= List.head frefSet1
+                fref1.TyconRef
 
     let fldsmap,rfldsList = 
         ((Map.empty,[]), frefSets) ||> List.fold (fun (fs,rfldsList) (fld,frefs,fldExpr) -> 

tests/fsharp/core/recordResolution/build.bat

@@ -0,0 +1,6 @@
+@if "%_echo%"=="" echo off
+
+call %~d0%~p0..\..\single-test-build.bat
+
+exit /b %ERRORLEVEL%
+

tests/fsharp/core/recordResolution/test.fs

@@ -0,0 +1,60 @@
+module Ex1 =
+  //simple example
+
+  type A = { FA: int }
+  type B = { FB: int }
+  type AB = { FA: int; FB: int }
+
+  let a = { FA = 1 } 
+  let b = { FB = 2 }
+  let a' = { a with FA = 2 }
+
+module Ex2 =
+
+  //more confusing fields
+
+  type A = { FA: int }
+  type B = { FB: int }
+  type C = { FC: int }
+  type AB = { FA: int; FB: int }
+  type AC = { FA: int; FC: int }
+  type CB = { FC: int; FB: int }
+  type ABC = { FA: int; FB: int; FC: int }
+
+  let a = { FA = 1 }
+  let b = { FB = 1 }
+  let c = { FC = 1 }
+  let ab = { FA = 1; FB = 2 }
+  let ac = { FA = 1; FC = 2 }
+  let cb = { FC = 1; FB = 2 }
+  let abc = { FA = 1; FB = 2; FC = 3 }
+
+  let a' = { a with FA = 2 }
+
+module Ex3 =
+
+  //make sure this works with open
+  open Ex2
+
+  let a = { FA = 1 }
+  let b = { FB = 1 }
+  let c = { FC = 1 }
+  let ab = { FA = 1; FB = 2 }
+  let ac = { FA = 1; FC = 2 }
+  let cb = { FC = 1; FB = 2 }
+  let abc = { FA = 1; FB = 2; FC = 3 }
+
+ module Ex4 =
+
+  //still choose the last occurring match
+
+  type A1 = { FA: int }
+  type A2 = { FA: int }
+  type C = { FC: int }
+  type AB = { FA: int; FB: int }
+
+  let a2 = { FA = 1 }
+  let r = a2 :> A2 //this produces warnings, but proves that a2 is indeed of type A2.
+
+System.IO.File.WriteAllText("test.ok","ok") 
+exit 0

tests/fsharp/tests.fs

@@ -690,6 +690,8 @@ module CoreTests =
     [<Test; Category("lift")>]
     let lift () = singleTestBuildAndRun "core/lift" FSC_OPT_PLUS_DEBUG
 
+    [<Test>]
+    let recordResolution () = singleTestBuildAndRun "core/recordResolution" FSC_OPT_PLUS_DEBUG
 
     [<Test>]
     let ``load-script`` () = 

tests/fsharpqa/Source/Conformance/BasicTypeAndModuleDefinitions/RecordTypes/E_TypeInference01.fs

@@ -5,7 +5,7 @@
 
 module N
 
-type Red  = { X : int }
+type Red  = { A : int }
 type Blue = { X : int; Y : int }
 
 let aBlue   = { X = 0; Y = 1 }

tests/fsharpqa/Source/Conformance/BasicTypeAndModuleDefinitions/RecordTypes/E_TypeInference01b.fs

@@ -6,7 +6,7 @@
 namespace N
 module M =
 
-    type GRed<'a>  = { GX : 'a }
+    type GRed<'a>  = { GA : 'a }
     type Blue<'a> = { GX : 'a; Y : int }
 
     let gaBlue   = { GX = 0; Y = 1 }