Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Fix analysis of conjunctive patterns for exhaustiveness #13020

Merged
merged 17 commits into from
Sep 29, 2022
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
8 changes: 1 addition & 7 deletions src/Compiler/Checking/PatternMatchCompilation.fs
Original file line number Diff line number Diff line change
Expand Up @@ -143,7 +143,6 @@ let GetSubExprOfInput g (gtps, tyargs, tinst) (SubExpr(accessf, (ve2, v2))) =
// The ints record which choices taken, e.g. tuple/record fields.
type Path =
| PathQuery of Path * Unique
| PathConj of Path * int
| PathTuple of Path * TypeInst * int
| PathRecd of Path * TyconRef * TypeInst * int
| PathUnionConstr of Path * UnionCaseRef * TypeInst * int
Expand All @@ -154,7 +153,6 @@ type Path =
let rec pathEq p1 p2 =
match p1, p2 with
| PathQuery(p1, n1), PathQuery(p2, n2) -> (n1 = n2) && pathEq p1 p2
| PathConj(p1, n1), PathConj(p2, n2) -> (n1 = n2) && pathEq p1 p2
| PathTuple(p1, _, n1), PathTuple(p2, _, n2) -> (n1 = n2) && pathEq p1 p2
| PathRecd(p1, _, _, n1), PathRecd(p2, _, _, n2) -> (n1 = n2) && pathEq p1 p2
| PathUnionConstr(p1, _, _, n1), PathUnionConstr(p2, _, _, n2) -> (n1 = n2) && pathEq p1 p2
Expand Down Expand Up @@ -203,8 +201,6 @@ let RefuteDiscrimSet g m path discrims =
let rec go path tm =
match path with
| PathQuery _ -> raise CannotRefute
| PathConj (p, _j) ->
go p tm
| PathTuple (p, tys, j) ->
let k, eCoversVals = mkOneKnown tm j tys
go p (fun _ -> mkRefTupled g m k tys, eCoversVals)
Expand Down Expand Up @@ -391,8 +387,6 @@ type Frontier = Frontier of ClauseNumber * Actives * ValMap<Expr>
type InvestigationPoint = Investigation of ClauseNumber * DecisionTreeTest * Path

// Note: actives must be a SortedDictionary
// REVIEW: improve these data structures, though surprisingly these functions don't tend to show up
// on profiling runs
let rec isMemOfActives p1 actives =
match actives with
| [] -> false
Expand Down Expand Up @@ -1624,7 +1618,7 @@ let CompilePatternBasic
subPats |> List.collect (fun subPat -> BindProjectionPattern (Active(inpPath, inpExpr, subPat)) activeState)

| TPat_conjs(subPats, _m) ->
let newActives = List.mapi (mkSubActive (fun path j -> PathConj(path, j)) (fun _j -> inpAccess)) subPats
let newActives = List.mapi (mkSubActive (fun path _j -> path) (fun _j -> inpAccess)) subPats
BindProjectionPatterns newActives activeState

| TPat_range (c1, c2, m) ->
Expand Down
15 changes: 15 additions & 0 deletions tests/fsharp/tests.fs
Original file line number Diff line number Diff line change
Expand Up @@ -2586,6 +2586,21 @@ module TypecheckTests =
peverify cfg "pos40.exe"
exec cfg ("." ++ "pos40.exe") ""

[<Test>]
let ``sigs pos1281`` () =
let cfg = testConfig "typecheck/sigs"
// This checks that warning 25 "incomplete matches" is not triggered
fsc cfg "%s --target:exe -o:pos1281.exe --warnaserror --nowarn:26" cfg.fsc_flags ["pos1281.fs"]
peverify cfg "pos1281.exe"
exec cfg ("." ++ "pos1281.exe") ""

[<Test>]
let ``sigs pos3294`` () =
let cfg = testConfig "typecheck/sigs"
fsc cfg "%s --target:exe -o:pos3294.exe --warnaserror" cfg.fsc_flags ["pos3294.fs"]
peverify cfg "pos3294.exe"
exec cfg ("." ++ "pos3294.exe") ""

[<Test>]
let ``sigs pos23`` () =
let cfg = testConfig "typecheck/sigs"
Expand Down
17 changes: 17 additions & 0 deletions tests/fsharp/typecheck/sigs/pos1281.fs
Original file line number Diff line number Diff line change
@@ -0,0 +1,17 @@
module Pos1281

type Cond = Foo | Bar | Baz
let (|SetV|) x _ = x

let c = Cond.Foo

match c with
| Baz ->
printfn "Baz"
| Foo & SetV "and" kwd
| Bar & SetV "or" kwd ->
printfn "Keyword: %s" kwd
| Baz -> failwith "wat"

printfn "test completed"
exit 0
8 changes: 8 additions & 0 deletions tests/fsharp/typecheck/sigs/pos3294.fs
Original file line number Diff line number Diff line change
@@ -0,0 +1,8 @@
module Pos40

let f = function
| [] -> 0
| (_ :: _) & _ -> 0

printfn "test completed"
exit 0