Commit f4d50a0e authored by Ryan Scott's avatar Ryan Scott Committed by Ben Gamari

Fix #14228 by marking SumPats as non-irrefutable

`isIrrefutableHsPat` should always return `False` for unboxed sum
patterns (`SumPat`s), since they always have at least one other
corresponding pattern of the same arity (since the minimum arity for a
`SumPat` is 2). Failure to do so causes incorrect code to be generated
for pattern synonyms that use unboxed sums, as shown in #14228.

Test Plan: make test TEST=T14228

Reviewers: austin, bgamari, simonpj

Reviewed By: simonpj

Subscribers: simonpj, rwbarton, thomie

GHC Trac Issues: #14228

Differential Revision: https://phabricator.haskell.org/D3951
parent 9e227bb1
......@@ -146,7 +146,7 @@ data Pat p
| SumPat (LPat p) -- Sum sub-pattern
ConTag -- Alternative (one-based)
Arity -- Arity
Arity -- Arity (INVARIANT: ≥ 2)
(PostTc p [Type]) -- PlaceHolder before typechecker, filled in
-- afterwards with the types of the
-- alternative
......@@ -613,7 +613,8 @@ isIrrefutableHsPat pat
go1 (SigPatIn pat _) = go pat
go1 (SigPatOut pat _) = go pat
go1 (TuplePat pats _ _) = all go pats
go1 (SumPat pat _ _ _) = go pat
go1 (SumPat _ _ _ _) = False
-- See Note [Unboxed sum patterns aren't irrefutable]
go1 (ListPat {}) = False
go1 (PArrPat {}) = False -- ?
......@@ -634,6 +635,28 @@ isIrrefutableHsPat pat
-- since we cannot know until the splice is evaluated.
go1 (SplicePat {}) = False
{- Note [Unboxed sum patterns aren't irrefutable]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Unlike unboxed tuples, unboxed sums are *not* irrefutable when used as
patterns. A simple example that demonstrates this is from #14228:
pattern Just' x = (# x | #)
pattern Nothing' = (# | () #)
foo x = case x of
Nothing' -> putStrLn "nothing"
Just' -> putStrLn "just"
In foo, the pattern Nothing' (that is, (# x | #)) is certainly not irrefutable,
as does not match an unboxed sum value of the same arity—namely, (# | y #)
(covered by Just'). In fact, no unboxed sum pattern is irrefutable, since the
minimum unboxed sum arity is 2.
Failing to mark unboxed sum patterns as non-irrefutable would cause the Just'
case in foo to be unreachable, as GHC would mistakenly believe that Nothing'
is the only thing that could possibly be matched!
-}
hsPatNeedsParens :: Pat a -> Bool
hsPatNeedsParens (NPlusKPat {}) = True
hsPatNeedsParens (SplicePat {}) = False
......
{-# LANGUAGE UnboxedSums #-}
{-# LANGUAGE PatternSynonyms #-}
module Main where
type Maybe' t = (# t | () #)
pattern Just' :: a -> Maybe' a
pattern Just' x = (# x | #)
pattern Nothing' :: Maybe' a
pattern Nothing' = (# | () #)
foo x = case x of
Nothing' -> putStrLn "nothing"
Just' _ -> putStrLn "just"
main = do
putStrLn "Nothing'"
foo Nothing'
putStrLn "Just'"
foo (Just' "hello")
......@@ -15,3 +15,4 @@ test('ghci', just_ghci, ghci_script, ['ghci.script'])
test('T11985', just_ghci, ghci_script, ['T11985.script'])
test('T11224', normal, compile_and_run, [''])
test('T13688', normal, multimod_compile_and_run, ['T13688', '-v0'])
test('T14228', normal, compile_and_run, [''])
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment