From 9d984564fac520941a871a1ff9dcea73a529f471 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Tue, 6 Feb 2024 21:50:07 +0100 Subject: [PATCH 1/5] Keeping track of nullness flow in scalar pattern match --- src/Compiler/Checking/CheckExpressions.fs | 18 +++++++++++++++-- .../Language/NullableReferenceTypesTests.fs | 20 +++++++++++++++++++ 2 files changed, 36 insertions(+), 2 deletions(-) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 2f0306f95c..574119acc6 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -10399,10 +10399,13 @@ and TcMatchPattern cenv inputTy env tpenv (synPat: SynPat) (synWhenExprOpt: SynE and TcMatchClauses cenv inputTy (resultTy: OverallTy) env tpenv clauses = let mutable first = true let isFirst() = if first then first <- false; true else false - List.mapFold (fun clause -> TcMatchClause cenv inputTy resultTy env (isFirst()) clause) tpenv clauses + let resultList,(tpEnv,_input) = + List.mapFold (fun (unscopedTyParEnv,inputTy) -> TcMatchClause cenv inputTy resultTy env (isFirst()) unscopedTyParEnv) (tpenv,inputTy) clauses + resultList,tpEnv and TcMatchClause cenv inputTy (resultTy: OverallTy) env isFirst tpenv synMatchClause = let (SynMatchClause(synPat, synWhenExprOpt, synResultExpr, patm, spTgt, _)) = synMatchClause + let pat, whenExprOpt, vspecs, envinner, tpenv = TcMatchPattern cenv inputTy env tpenv synPat synWhenExprOpt let resultEnv = @@ -10417,8 +10420,19 @@ and TcMatchClause cenv inputTy (resultTy: OverallTy) env isFirst tpenv synMatchC let resultExpr, tpenv = TcExprThatCanBeCtorBody cenv resultTy resultEnv tpenv synResultExpr let target = TTarget(vspecs, resultExpr, None) + + let inputTypeForNextPatterns= + let rec didEliminateNull (p:Pattern) = + match p with + | TPat_null _ | TPat_wild _ -> true + | TPat_as (p,_,_) -> didEliminateNull p + | TPat_disjs(patterns,_) -> patterns |> List.exists didEliminateNull + | _ -> false + if whenExprOpt.IsNone && didEliminateNull pat then + replaceNullnessOfTy KnownWithoutNull inputTy + else inputTy - MatchClause(pat, whenExprOpt, target, patm), tpenv + MatchClause(pat, whenExprOpt, target, patm), (tpenv,inputTypeForNextPatterns) and TcStaticOptimizationConstraint cenv env tpenv c = let g = cenv.g diff --git a/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs b/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs index ff50d48118..2ed616e9f1 100644 --- a/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs @@ -68,6 +68,26 @@ let doStuff() = printfn notNullLiteral printfn maybeLiteral printfn maybeLiteralWithHole thisCannotBeAFormat +""" + |> asLibrary + |> typeCheckWithStrictNullness + |> shouldSucceed + + +[] +[] +[] +[] +[] +[] +[] +let ``Eliminate nullness after matching`` (tp) = + FSharp $"""module MyLibrary + +let myFunction (input : string | null) : string = + match input with + | {tp} -> "" + | nonNullString -> nonNullString """ |> asLibrary |> typeCheckWithStrictNullness From 4dad783ef3a74d0277037732e74c92757ac11d76 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Wed, 7 Feb 2024 00:11:45 +0100 Subject: [PATCH 2/5] Tuple pattern match - control flow with nullness info --- src/Compiler/Checking/CheckExpressions.fs | 30 +++++++++++---- .../Language/NullableReferenceTypesTests.fs | 38 ++++++++++++++++++- 2 files changed, 60 insertions(+), 8 deletions(-) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 574119acc6..3a25b96273 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -10422,15 +10422,31 @@ and TcMatchClause cenv inputTy (resultTy: OverallTy) env isFirst tpenv synMatchC let target = TTarget(vspecs, resultExpr, None) let inputTypeForNextPatterns= - let rec didEliminateNull (p:Pattern) = + let removeNull t = replaceNullnessOfTy KnownWithoutNull t + let rec isWild (p:Pattern) = match p with - | TPat_null _ | TPat_wild _ -> true - | TPat_as (p,_,_) -> didEliminateNull p - | TPat_disjs(patterns,_) -> patterns |> List.exists didEliminateNull + | TPat_wild _ -> true + | TPat_as (p,_,_) -> isWild p + | TPat_disjs(patterns,_) -> patterns |> List.exists isWild + | TPat_conjs(patterns,_) -> patterns |> List.forall isWild + | TPat_tuple (_,pats,_,_) -> pats |> List.forall isWild | _ -> false - if whenExprOpt.IsNone && didEliminateNull pat then - replaceNullnessOfTy KnownWithoutNull inputTy - else inputTy + + let rec eliminateNull (ty:TType) (p:Pattern) = + match p with + | TPat_null _ -> removeNull ty + | TPat_as (p,_,_) -> eliminateNull ty p + | TPat_disjs(patterns,_) -> (ty,patterns) ||> List.fold eliminateNull + | TPat_tuple (_,pats,_,_) -> + match stripTyparEqns ty with + // In a tuple of size N, if 1 elem is matched for null and N-1 are wild => subsequent clauses can strip nullness + | TType_tuple(ti,tys) when tys.Length = pats.Length && (pats |> List.count (isWild >> not)) = 1 -> + TType_tuple(ti, List.map2 eliminateNull tys pats) + | _ -> ty + | _ -> ty + match whenExprOpt with + | None -> eliminateNull inputTy pat + | _ -> inputTy MatchClause(pat, whenExprOpt, target, patm), (tpenv,inputTypeForNextPatterns) diff --git a/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs b/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs index 2ed616e9f1..ec30ec11fd 100644 --- a/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs @@ -91,4 +91,40 @@ let myFunction (input : string | null) : string = """ |> asLibrary |> typeCheckWithStrictNullness - |> shouldSucceed \ No newline at end of file + |> shouldSucceed + +[] +[] +[] +let ``Eliminate tupled nullness after matching`` (tp) = + FSharp $"""module MyLibrary + +let myFunction (input1 : string | null) (input2 : string | null): string = + match input1,input2 with + | {tp} -> "" + | nns1,nns2 -> string (nns1.Length + nns2.Length) +""" + |> asLibrary + |> typeCheckWithStrictNullness + |> shouldSucceed + + +[] +[] +[] +[] +[] +[] +[] +let ``Should NOT eliminate tupled nullness after matching`` (tp) = + FSharp $"""module MyLibrary + +let myFunction (input1 : string | null) (input2 : string | null): string = + match input1,input2 with + | {tp} -> "" + | nns1,nns2 -> string (nns1.Length + nns2.Length) +""" + |> asLibrary + |> typeCheckWithStrictNullness + |> shouldFail + |> withErrorCode 3261 \ No newline at end of file From 1b0b12209a487fed1d275375f7235e6d38375209 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Wed, 7 Feb 2024 10:31:23 +0100 Subject: [PATCH 3/5] tests --- .../Language/NullableReferenceTypesTests.fs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs b/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs index ec30ec11fd..b37eae94b7 100644 --- a/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs @@ -99,10 +99,10 @@ let myFunction (input : string | null) : string = let ``Eliminate tupled nullness after matching`` (tp) = FSharp $"""module MyLibrary -let myFunction (input1 : string | null) (input2 : string | null): string = +let myFunction (input1 : string | null) (input2 : string | null): (string*string) = match input1,input2 with - | {tp} -> "" - | nns1,nns2 -> string (nns1.Length + nns2.Length) + | {tp} -> "","" + | nns1,nns2 -> nns1,nns2 """ |> asLibrary |> typeCheckWithStrictNullness @@ -119,10 +119,10 @@ let myFunction (input1 : string | null) (input2 : string | null): string = let ``Should NOT eliminate tupled nullness after matching`` (tp) = FSharp $"""module MyLibrary -let myFunction (input1 : string | null) (input2 : string | null): string = +let myFunction (input1 : string | null) (input2 : string | null): (string*string) = match input1,input2 with | {tp} -> "" - | nns1,nns2 -> string (nns1.Length + nns2.Length) + | nns1,nns2 -> nns1,nns2 """ |> asLibrary |> typeCheckWithStrictNullness From 8592849d75c8326d0e79b1fde81352103d5a0fe3 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Wed, 7 Feb 2024 14:59:51 +0100 Subject: [PATCH 4/5] tests --- .../Language/NullableReferenceTypesTests.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs b/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs index b37eae94b7..518fba4b1b 100644 --- a/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs @@ -121,7 +121,7 @@ let ``Should NOT eliminate tupled nullness after matching`` (tp) = let myFunction (input1 : string | null) (input2 : string | null): (string*string) = match input1,input2 with - | {tp} -> "" + | {tp} -> "","" | nns1,nns2 -> nns1,nns2 """ |> asLibrary From db14303a3d4505a8c55d7ce3231924e86285d0a0 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Thu, 8 Feb 2024 13:45:28 +0100 Subject: [PATCH 5/5] tests --- .../Language/NullableReferenceTypesTests.fs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs b/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs index 518fba4b1b..9bcebf546c 100644 --- a/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs @@ -9,7 +9,7 @@ let typeCheckWithStrictNullness cu = |> withCheckNulls |> withWarnOn 3261 |> withOptions ["--warnaserror+"] - |> typecheck + |> compile [] let ``Printing a nullable string should pass`` () = @@ -121,7 +121,7 @@ let ``Should NOT eliminate tupled nullness after matching`` (tp) = let myFunction (input1 : string | null) (input2 : string | null): (string*string) = match input1,input2 with - | {tp} -> "","" + | %s{tp} -> "","" | nns1,nns2 -> nns1,nns2 """ |> asLibrary