GHC issueshttps://gitlab.haskell.org/ghc/ghc/-/issues2019-07-07T18:30:41Zhttps://gitlab.haskell.org/ghc/ghc/-/issues/11374`-Woverlapping-patterns` induced memory-blowup2019-07-07T18:30:41ZHerbert Valerio Riedelhvr@gnu.org`-Woverlapping-patterns` induced memory-blowupI'm afraid I've found yet another case that still let's the pattern checker go crazy (courtesy of hackage:cryptol-2.2.5):
```hs
{-# LANGUAGE Haskell2010 #-}
{-# OPTIONS_GHC -Woverlapping-patterns #-}
module Bug where
data Type = TCo...I'm afraid I've found yet another case that still let's the pattern checker go crazy (courtesy of hackage:cryptol-2.2.5):
```hs
{-# LANGUAGE Haskell2010 #-}
{-# OPTIONS_GHC -Woverlapping-patterns #-}
module Bug where
data Type = TCon TCon [Type]
| TUser String [Type] Type
| TRec [(String,Type)]
deriving (Show,Eq,Ord)
data TCon = TC TC
| TF TFun
deriving (Show,Eq,Ord)
data TC = TCNum Integer
| TCInf
| TCBit
| TCSeq
| TCFun
| TCTuple Int
deriving (Show,Eq,Ord)
data TFun = TCAdd
| TCSub
| TCMul
| TCDiv
| TCMod
| TCLg2
| TCExp
| TCWidth
| TCMin
| TCMax
| TCLenFromThen
| TCLenFromThenTo
deriving (Show, Eq, Ord, Bounded, Enum)
simpFinTy :: Type -> Maybe [Type]
simpFinTy ty = case ty of
TCon (TC (TCNum _)) _ -> Just []
TCon (TF tf) [t1]
| TCLg2 <- tf -> Just [t1]
| TCWidth <- tf -> Just [t1]
TCon (TF tf) [t1,t2]
| TCAdd <- tf -> Just [t1, t2]
| TCSub <- tf -> Just [t1]
| TCMul <- tf -> Just [t1, t2]
| TCDiv <- tf -> Just [t1]
| TCMod <- tf -> Just []
| TCExp <- tf -> Just [t1, t2]
| TCMin <- tf -> Nothing
| TCMax <- tf -> Just [t1, t2]
TCon (TF tf) [_,_,_]
| TCLenFromThen <- tf -> Just []
| TCLenFromThenTo <- tf -> Just []
_ -> Nothing
```
<details><summary>Trac metadata</summary>
| Trac field | Value |
| ---------------------- | ------------ |
| Version | 8.1 |
| Type | Bug |
| TypeOfFailure | OtherFailure |
| Priority | highest |
| Resolution | Unresolved |
| Component | Compiler |
| Test case | |
| Differential revisions | |
| BlockedBy | |
| Related | |
| Blocking | |
| CC | bgamari |
| Operating system | |
| Architecture | |
</details>
<!-- {"blocked_by":[],"summary":"`-Woverlapping-patterns` induced memory-blowup","status":"New","operating_system":"","component":"Compiler","related":[],"milestone":"8.0.1","resolution":"Unresolved","owner":{"tag":"OwnedBy","contents":"gkaracha"},"version":"8.1","keywords":[],"differentials":[],"test_case":"","architecture":"","cc":["bgamari"],"type":"Bug","description":"I'm afraid I've found yet another case that still let's the pattern checker go crazy (courtesy of hackage:cryptol-2.2.5):\r\n\r\n{{{#!hs\r\n{-# LANGUAGE Haskell2010 #-}\r\n\r\n{-# OPTIONS_GHC -Woverlapping-patterns #-}\r\nmodule Bug where\r\n\r\ndata Type = TCon TCon [Type]\r\n | TUser String [Type] Type\r\n | TRec [(String,Type)]\r\n deriving (Show,Eq,Ord)\r\n\r\ndata TCon = TC TC\r\n | TF TFun\r\n deriving (Show,Eq,Ord)\r\n\r\ndata TC = TCNum Integer\r\n | TCInf\r\n | TCBit\r\n | TCSeq\r\n | TCFun\r\n | TCTuple Int\r\n deriving (Show,Eq,Ord)\r\n\r\ndata TFun = TCAdd\r\n | TCSub\r\n | TCMul\r\n | TCDiv\r\n | TCMod\r\n | TCLg2\r\n | TCExp\r\n | TCWidth\r\n | TCMin\r\n | TCMax\r\n | TCLenFromThen\r\n | TCLenFromThenTo\r\n deriving (Show, Eq, Ord, Bounded, Enum)\r\n\r\nsimpFinTy :: Type -> Maybe [Type]\r\nsimpFinTy ty = case ty of\r\n TCon (TC (TCNum _)) _ -> Just []\r\n\r\n TCon (TF tf) [t1]\r\n | TCLg2 <- tf -> Just [t1]\r\n | TCWidth <- tf -> Just [t1]\r\n\r\n TCon (TF tf) [t1,t2]\r\n | TCAdd <- tf -> Just [t1, t2]\r\n | TCSub <- tf -> Just [t1]\r\n | TCMul <- tf -> Just [t1, t2]\r\n | TCDiv <- tf -> Just [t1]\r\n | TCMod <- tf -> Just []\r\n | TCExp <- tf -> Just [t1, t2]\r\n | TCMin <- tf -> Nothing\r\n | TCMax <- tf -> Just [t1, t2]\r\n\r\n TCon (TF tf) [_,_,_]\r\n | TCLenFromThen <- tf -> Just []\r\n | TCLenFromThenTo <- tf -> Just []\r\n\r\n _ -> Nothing\r\n}}}","type_of_failure":"OtherFailure","blocking":[]} -->8.0.1Georgios KarachaliasGeorgios Karachaliashttps://gitlab.haskell.org/ghc/ghc/-/issues/11276GHC hangs/takes an exponential amount of time with simple program2020-03-04T08:34:57ZMatthew PickeringGHC hangs/takes an exponential amount of time with simple programThis was discovered when trying to compile xml-conduit. Here is the standalone test case with a few comments indicating how to make it compile.
The program compiles with ghc-7.10.2 but fails with HEAD.
```hs
{-# LANGUAGE RankNTypes #-}...This was discovered when trying to compile xml-conduit. Here is the standalone test case with a few comments indicating how to make it compile.
The program compiles with ghc-7.10.2 but fails with HEAD.
```hs
{-# LANGUAGE RankNTypes #-}
module Hang where
import Control.Monad
import Data.Char
data Event
= EventBeginDocument
| EventEndDocument
| EventBeginDoctype
| EventEndDoctype
| EventInstruction
| EventBeginElement
| EventEndElement
| EventContent Content
| EventComment
| EventCDATA
data Content
= ContentText String
| ContentEntity String
peek :: Monad m => Consumer a m (Maybe a)
peek = undefined
type Consumer i m r = forall o. ConduitM i o m r
tag :: forall m a b c o . Monad m =>
ConduitM Event o m (Maybe c)
tag = do
_ <- dropWS
return undefined
where
-- Add this and it works
-- dropWS :: Monad m => ConduitM Event o m (Maybe Event)
dropWS = do
-- Swap these two lines and it works
-- let x = undefined
x <- peek
let isWS =
case x of
-- Remove some of these and it works
Just EventBeginDocument -> True
Just EventEndDocument -> True
Just EventBeginDoctype{} -> True
Just EventEndDoctype -> True
Just EventInstruction{} -> True
Just EventBeginElement{} -> False
Just EventEndElement{} -> False
Just (EventContent (ContentText t))
| all isSpace t -> True
| otherwise -> False
Just (EventContent ContentEntity{}) -> False
Just EventComment{} -> True
Just EventCDATA{} -> False
Nothing -> False
if isWS then dropWS else return x
-- Inlined Instances
instance Functor (ConduitM i o m) where
fmap f (ConduitM c) = ConduitM $ \rest -> c (rest . f)
instance Applicative (ConduitM i o m) where
pure x = ConduitM ($ x)
{-# INLINE pure #-}
(<*>) = ap
{-# INLINE (<*>) #-}
instance Monad (ConduitM i o m) where
return = pure
ConduitM f >>= g = ConduitM $ \h -> f $ \a -> unConduitM (g a) h
instance Monad m => Functor (Pipe l i o u m) where
fmap = liftM
{-# INLINE fmap #-}
instance Monad m => Applicative (Pipe l i o u m) where
pure = Done
{-# INLINE pure #-}
(<*>) = ap
{-# INLINE (<*>) #-}
instance Monad m => Monad (Pipe l i o u m) where
return = pure
{-# INLINE return #-}
HaveOutput p c o >>= fp = HaveOutput (p >>= fp) c o
NeedInput p c >>= fp = NeedInput (p >=> fp) (c >=> fp)
Done x >>= fp = fp x
PipeM mp >>= fp = PipeM ((>>= fp) `liftM` mp)
Leftover p i >>= fp = Leftover (p >>= fp) i
newtype ConduitM i o m r = ConduitM
{ unConduitM :: forall b.
(r -> Pipe i i o () m b) -> Pipe i i o () m b
}
data Pipe l i o u m r =
HaveOutput (Pipe l i o u m r) (m ()) o
| NeedInput (i -> Pipe l i o u m r) (u -> Pipe l i o u m r)
| Done r
| PipeM (m (Pipe l i o u m r))
| Leftover (Pipe l i o u m r) l
```
<details><summary>Trac metadata</summary>
| Trac field | Value |
| ---------------------- | ------------ |
| Version | 7.10.3 |
| Type | Bug |
| TypeOfFailure | OtherFailure |
| Priority | high |
| Resolution | Unresolved |
| Component | Compiler |
| Test case | |
| Differential revisions | |
| BlockedBy | |
| Related | |
| Blocking | |
| CC | |
| Operating system | |
| Architecture | |
</details>
<!-- {"blocked_by":[],"summary":"GHC hangs/takes an exponential amount of time with simple program","status":"New","operating_system":"","component":"Compiler","related":[],"milestone":"","resolution":"Unresolved","owner":{"tag":"Unowned"},"version":"7.10.3","keywords":[],"differentials":[],"test_case":"","architecture":"","cc":[""],"type":"Bug","description":"This was discovered when trying to compile xml-conduit. Here is the standalone test case with a few comments indicating how to make it compile.\r\n\r\nThe program compiles with ghc-7.10.2 but fails with HEAD. \r\n\r\n{{{#!hs\r\n{-# LANGUAGE RankNTypes #-}\r\nmodule Hang where\r\nimport Control.Monad\r\nimport Data.Char\r\n\r\ndata Event\r\n = EventBeginDocument\r\n | EventEndDocument\r\n | EventBeginDoctype\r\n | EventEndDoctype\r\n | EventInstruction\r\n | EventBeginElement\r\n | EventEndElement\r\n | EventContent Content\r\n | EventComment\r\n | EventCDATA\r\n\r\ndata Content\r\n = ContentText String\r\n | ContentEntity String\r\n\r\n\r\npeek :: Monad m => Consumer a m (Maybe a)\r\npeek = undefined\r\n\r\ntype Consumer i m r = forall o. ConduitM i o m r\r\n\r\ntag :: forall m a b c o . Monad m =>\r\n ConduitM Event o m (Maybe c)\r\ntag = do\r\n _ <- dropWS\r\n return undefined\r\n where\r\n-- Add this and it works\r\n-- dropWS :: Monad m => ConduitM Event o m (Maybe Event)\r\n dropWS = do\r\n-- Swap these two lines and it works\r\n-- let x = undefined\r\n x <- peek\r\n let isWS =\r\n case x of\r\n -- Remove some of these and it works\r\n Just EventBeginDocument -> True\r\n Just EventEndDocument -> True\r\n Just EventBeginDoctype{} -> True\r\n Just EventEndDoctype -> True\r\n Just EventInstruction{} -> True\r\n Just EventBeginElement{} -> False\r\n Just EventEndElement{} -> False\r\n Just (EventContent (ContentText t))\r\n | all isSpace t -> True\r\n | otherwise -> False\r\n Just (EventContent ContentEntity{}) -> False\r\n Just EventComment{} -> True\r\n Just EventCDATA{} -> False\r\n Nothing -> False\r\n if isWS then dropWS else return x\r\n\r\n-- Inlined Instances\r\n\r\ninstance Functor (ConduitM i o m) where\r\n fmap f (ConduitM c) = ConduitM $ \\rest -> c (rest . f)\r\n\r\ninstance Applicative (ConduitM i o m) where\r\n pure x = ConduitM ($ x)\r\n {-# INLINE pure #-}\r\n (<*>) = ap\r\n {-# INLINE (<*>) #-}\r\n\r\ninstance Monad (ConduitM i o m) where\r\n return = pure\r\n ConduitM f >>= g = ConduitM $ \\h -> f $ \\a -> unConduitM (g a) h\r\n\r\ninstance Monad m => Functor (Pipe l i o u m) where\r\n fmap = liftM\r\n {-# INLINE fmap #-}\r\n\r\ninstance Monad m => Applicative (Pipe l i o u m) where\r\n pure = Done\r\n {-# INLINE pure #-}\r\n (<*>) = ap\r\n {-# INLINE (<*>) #-}\r\n\r\ninstance Monad m => Monad (Pipe l i o u m) where\r\n return = pure\r\n {-# INLINE return #-}\r\n\r\n HaveOutput p c o >>= fp = HaveOutput (p >>= fp) c o\r\n NeedInput p c >>= fp = NeedInput (p >=> fp) (c >=> fp)\r\n Done x >>= fp = fp x\r\n PipeM mp >>= fp = PipeM ((>>= fp) `liftM` mp)\r\n Leftover p i >>= fp = Leftover (p >>= fp) i\r\n\r\nnewtype ConduitM i o m r = ConduitM\r\n { unConduitM :: forall b.\r\n (r -> Pipe i i o () m b) -> Pipe i i o () m b\r\n }\r\n\r\ndata Pipe l i o u m r =\r\n HaveOutput (Pipe l i o u m r) (m ()) o\r\n | NeedInput (i -> Pipe l i o u m r) (u -> Pipe l i o u m r)\r\n | Done r\r\n | PipeM (m (Pipe l i o u m r))\r\n | Leftover (Pipe l i o u m r) l\r\n}}}","type_of_failure":"OtherFailure","blocking":[]} -->8.0.1Georgios KarachaliasGeorgios Karachaliashttps://gitlab.haskell.org/ghc/ghc/-/issues/11245Non-exhaustive pattern, "Patterns not matched" list is empty2019-07-07T18:31:18ZÖmer Sinan AğacanNon-exhaustive pattern, "Patterns not matched" list is emptyExample:
```haskell
module Main where
maybeOdd :: Int -> Maybe Int
maybeOdd i = if odd i then Just i else Nothing
main :: IO ()
main = do
let x = maybeOdd 10
let a | Just i <- x
, odd i
= True
| Nothing <...Example:
```haskell
module Main where
maybeOdd :: Int -> Maybe Int
maybeOdd i = if odd i then Just i else Nothing
main :: IO ()
main = do
let x = maybeOdd 10
let a | Just i <- x
, odd i
= True
| Nothing <- x
= False
print x
print a
```
Warning printed by GHC HEAD:
```
Exhaustive.hs:10:7: warning:
Pattern match(es) are non-exhaustive
In an equation for ‘a’: Patterns not matched:
Linking Exhaustive ...
```
The problem with this message is; if it couldn't come up with an example unmatched pattern, then how can it know that the pattern is non-exhaustive? If it came up with an example, why is that example not printed?
UPDATE: I just realized it's actually worse that I first thought. If I change `a` in this example:
```haskell
let a | Just i <- x
= True
```
This message is printed:
```
[1 of 1] Compiling Main ( Exhaustive.hs, Exhaustive.o )
Exhaustive.hs:10:7: warning:
Pattern match(es) are non-exhaustive
In an equation for ‘a’: Patterns not matched:
Exhaustive.hs:10:16: warning: Defined but not used: ‘i’
Linking Exhaustive ...
```
NOTE: Tried with GHC 7.10 too. It seems like in the case where the checks are not exhaustive, both 7.10 and HEAD are giving the same warning(with empty list of non-checked patterns). HEAD is better in detecting exhaustive patterns.
<details><summary>Trac metadata</summary>
| Trac field | Value |
| ---------------------- | ------------ |
| Version | 7.11 |
| Type | Bug |
| TypeOfFailure | OtherFailure |
| Priority | normal |
| Resolution | Unresolved |
| Component | Compiler |
| Test case | |
| Differential revisions | |
| BlockedBy | |
| Related | |
| Blocking | |
| CC | |
| Operating system | |
| Architecture | |
</details>
<!-- {"blocked_by":[],"summary":"Non-exhaustive pattern, \"Patterns not matched\" list is empty","status":"New","operating_system":"","component":"Compiler","related":[],"milestone":"","resolution":"Unresolved","owner":{"tag":"Unowned"},"version":"7.11","keywords":[],"differentials":[],"test_case":"","architecture":"","cc":[""],"type":"Bug","description":"Example:\r\n\r\n{{{#!haskell\r\nmodule Main where\r\n\r\nmaybeOdd :: Int -> Maybe Int\r\nmaybeOdd i = if odd i then Just i else Nothing\r\n\r\nmain :: IO ()\r\nmain = do\r\n let x = maybeOdd 10\r\n\r\n let a | Just i <- x\r\n , odd i\r\n = True\r\n\r\n | Nothing <- x\r\n = False\r\n\r\n print x\r\n print a\r\n}}}\r\n\r\nWarning printed by GHC HEAD:\r\n\r\n{{{\r\nExhaustive.hs:10:7: warning:\r\n Pattern match(es) are non-exhaustive\r\n In an equation for ‘a’: Patterns not matched:\r\nLinking Exhaustive ...\r\n}}}\r\n\r\nThe problem with this message is; if it couldn't come up with an example unmatched pattern, then how can it know that the pattern is non-exhaustive? If it came up with an example, why is that example not printed?\r\n\r\nUPDATE: I just realized it's actually worse that I first thought. If I change {{{a}}} in this example:\r\n\r\n{{{#!haskell\r\n let a | Just i <- x\r\n = True\r\n}}}\r\n\r\nThis message is printed:\r\n\r\n{{{\r\n[1 of 1] Compiling Main ( Exhaustive.hs, Exhaustive.o )\r\n\r\nExhaustive.hs:10:7: warning:\r\n Pattern match(es) are non-exhaustive\r\n In an equation for ‘a’: Patterns not matched:\r\n\r\nExhaustive.hs:10:16: warning: Defined but not used: ‘i’\r\nLinking Exhaustive ...\r\n}}}\r\n\r\nNOTE: Tried with GHC 7.10 too. It seems like in the case where the checks are not exhaustive, both 7.10 and HEAD are giving the same warning(with empty list of non-checked patterns). HEAD is better in detecting exhaustive patterns.","type_of_failure":"OtherFailure","blocking":[]} -->8.0.1Georgios KarachaliasGeorgios Karachaliashttps://gitlab.haskell.org/ghc/ghc/-/issues/11163New exhaustiveness checker breaks T56422019-07-07T18:31:41ZBen GamariNew exhaustiveness checker breaks T5642The new exhaustiveness checker drastically increases compile time of the `T5642` testcase. From the profile it appears that a great deal of time is being spent evaluating `Check.mkPmId.occname`,
```
COST CENTRE MODULE ...The new exhaustiveness checker drastically increases compile time of the `T5642` testcase. From the profile it appears that a great deal of time is being spent evaluating `Check.mkPmId.occname`,
```
COST CENTRE MODULE %time %alloc
mkPmId.occname Check 73.7 16.9
mkOneConFull Check 3.4 10.2
deSugar HscMain 2.8 14.8
mkOneConFull.arguments Check 2.5 5.5
pmTraverse Check 1.6 0.8
mkOneConFull.subst1 Check 1.5 5.9
wrapK.go Check 1.5 5.9
cMatcher Check 1.2 2.7
canEvVar TcCanonical 1.0 3.4
```
<details><summary>Trac metadata</summary>
| Trac field | Value |
| ---------------------- | ------------ |
| Version | 7.10.2 |
| Type | Bug |
| TypeOfFailure | OtherFailure |
| Priority | high |
| Resolution | Unresolved |
| Component | Compiler |
| Test case | |
| Differential revisions | |
| BlockedBy | |
| Related | |
| Blocking | |
| CC | gkaracha |
| Operating system | |
| Architecture | |
</details>
<!-- {"blocked_by":[],"summary":"New exhaustiveness checker breaks T5642","status":"New","operating_system":"","component":"Compiler","related":[],"milestone":"8.0.1","resolution":"Unresolved","owner":{"tag":"Unowned"},"version":"7.10.2","keywords":[],"differentials":[],"test_case":"","architecture":"","cc":["gkaracha"],"type":"Bug","description":"The new exhaustiveness checker drastically increases compile time of the `T5642` testcase. From the profile it appears that a great deal of time is being spent evaluating `Check.mkPmId.occname`,\r\n\r\n{{{\r\nCOST CENTRE MODULE %time %alloc\r\n\r\nmkPmId.occname Check 73.7 16.9\r\nmkOneConFull Check 3.4 10.2\r\ndeSugar HscMain 2.8 14.8\r\nmkOneConFull.arguments Check 2.5 5.5\r\npmTraverse Check 1.6 0.8\r\nmkOneConFull.subst1 Check 1.5 5.9\r\nwrapK.go Check 1.5 5.9\r\ncMatcher Check 1.2 2.7\r\ncanEvVar TcCanonical 1.0 3.4\r\n}}}","type_of_failure":"OtherFailure","blocking":[]} -->8.0.1Georgios KarachaliasGeorgios Karachaliashttps://gitlab.haskell.org/ghc/ghc/-/issues/11161New exhaustiveness checker breaks concurrent/prog0012019-07-07T18:31:42ZBen GamariNew exhaustiveness checker breaks concurrent/prog001The new exhaustiveness checker appears to allocate until the machine runs out of memory while compiling the `concurrent/prog001` testcase. In particular it stalls while desugaring the `Thread` module. The fact that this module contains n...The new exhaustiveness checker appears to allocate until the machine runs out of memory while compiling the `concurrent/prog001` testcase. In particular it stalls while desugaring the `Thread` module. The fact that this module contains non-trivial pattern matching, coupled with the compiler gets stuck in `Desugar`, and the fact that I've noted other performance issues with the new exhaustiveness checker (see #11160) leads me to believe that this patch is to blame.8.0.1Georgios KarachaliasGeorgios Karachalias