From bf22e70deee7ebbd75d2413cde3d581425c9bfcb Mon Sep 17 00:00:00 2001 From: Kurt Schelfthout Date: Thu, 17 Nov 2016 20:57:04 +0000 Subject: [PATCH] Implement RFC fs-1025: Improve record inference. --- src/fsharp/TypeChecker.fs | 21 ++++--- tests/fsharp/core/recordResolution/build.bat | 6 ++ tests/fsharp/core/recordResolution/test.fs | 60 +++++++++++++++++++ tests/fsharp/tests.fs | 2 + .../RecordTypes/E_TypeInference01.fs | 2 +- .../RecordTypes/E_TypeInference01b.fs | 2 +- 6 files changed, 83 insertions(+), 10 deletions(-) create mode 100644 tests/fsharp/core/recordResolution/build.bat create mode 100644 tests/fsharp/core/recordResolution/test.fs diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index 5de87a6d997..7309d7c1b81 100755 --- a/src/fsharp/TypeChecker.fs +++ b/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) -> diff --git a/tests/fsharp/core/recordResolution/build.bat b/tests/fsharp/core/recordResolution/build.bat new file mode 100644 index 00000000000..a6ff3718fe7 --- /dev/null +++ b/tests/fsharp/core/recordResolution/build.bat @@ -0,0 +1,6 @@ +@if "%_echo%"=="" echo off + +call %~d0%~p0..\..\single-test-build.bat + +exit /b %ERRORLEVEL% + diff --git a/tests/fsharp/core/recordResolution/test.fs b/tests/fsharp/core/recordResolution/test.fs new file mode 100644 index 00000000000..13af38e0d92 --- /dev/null +++ b/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 \ No newline at end of file diff --git a/tests/fsharp/tests.fs b/tests/fsharp/tests.fs index dcd77f03af0..c40c1dae384 100644 --- a/tests/fsharp/tests.fs +++ b/tests/fsharp/tests.fs @@ -690,6 +690,8 @@ module CoreTests = [] let lift () = singleTestBuildAndRun "core/lift" FSC_OPT_PLUS_DEBUG + [] + let recordResolution () = singleTestBuildAndRun "core/recordResolution" FSC_OPT_PLUS_DEBUG [] let ``load-script`` () = diff --git a/tests/fsharpqa/Source/Conformance/BasicTypeAndModuleDefinitions/RecordTypes/E_TypeInference01.fs b/tests/fsharpqa/Source/Conformance/BasicTypeAndModuleDefinitions/RecordTypes/E_TypeInference01.fs index 32f6bfd0444..363e607f843 100644 --- a/tests/fsharpqa/Source/Conformance/BasicTypeAndModuleDefinitions/RecordTypes/E_TypeInference01.fs +++ b/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 } diff --git a/tests/fsharpqa/Source/Conformance/BasicTypeAndModuleDefinitions/RecordTypes/E_TypeInference01b.fs b/tests/fsharpqa/Source/Conformance/BasicTypeAndModuleDefinitions/RecordTypes/E_TypeInference01b.fs index 8d6b61e2959..bc4b7aa4e02 100644 --- a/tests/fsharpqa/Source/Conformance/BasicTypeAndModuleDefinitions/RecordTypes/E_TypeInference01b.fs +++ b/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 }