Certain inter-module specializations run out of simplifier ticks
A modification of ezyang's test case in #9630 (closed) yields the below. Triggering specialization in a separate module can run the simplifier out of ticks. Notably, moving the definition of T
into GenSpec
resolves the problem. Unlike #9630 (closed) proper, this seems to cause trouble going back as far as GHC 7.4.
module GenSpec where
import Gen
import GHC.Generics
-- Trigger specialization
tput :: T -> Put
tput = gput . from
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -fno-warn-missing-methods #-}
module Gen where
import GHC.Generics
import Control.Monad
import Control.Applicative
import Data.Monoid
data PairS a = PairS a !(() -> ())
newtype PutM a = Put { unPut :: PairS a }
-- Use of this writer monad seems to be important; IO speeds it up
type Put = PutM ()
--type Put = IO ()
-- binary has INLINE pragmas on most of the instances but you can still
-- trigger bad behavior without them.
instance Functor PutM where
fmap f m = Put $ let PairS a w = unPut m in PairS (f a) w
-- Just to appease AMP
instance Applicative PutM where
pure = return
(<*>) = ap
instance Monad PutM where
return a = Put $ PairS a id
m >>= k = Put $
let PairS a w = unPut m
PairS b w' = unPut (k a)
in PairS b (w . w')
class GBinary f where
gput :: f t -> Put
-- Forcing the dictionary to have two elements hurts
-- the optimizer a lot.
not_used :: f t
instance GBinary a => GBinary (M1 i c a) where
gput = gput . unM1
instance Binary a => GBinary (K1 i a) where
gput = put . unK1
instance (GBinary a, GBinary b) => GBinary (a :*: b) where
gput (x :*: y) = gput x >> gput y
class Binary t where
put :: t -> Put
instance Binary () where
put () = return ()
data T = T () () () () () () () () () () () ()
() () () () () () () () () ()
() () () () () () () () () ()
() () () () () () () () () ()
() () () () () () () () () ()
() () () () () () () () () ()
() () () () () () () () () ()
() () () () () () () () () ()
() () () () () () () () () ()
() () () () () () () () () ()
() () () () () () () () () ()
() () () () () () () () () ()
() () () () () () () () () ()
() () () () () () () () () ()
() () () () () () () () () ()
() () () () () () () () () ()
() () () () () () () () () ()
() () () () () () () () () ()
() () () () () () () () () ()
deriving Generic
Trac metadata
Trac field | Value |
---|---|
Version | 8.0.1 |
Type | Bug |
TypeOfFailure | OtherFailure |
Priority | high |
Resolution | Unresolved |
Component | Compiler |
Test case | |
Differential revisions | |
BlockedBy | |
Related | |
Blocking | |
CC | |
Operating system | |
Architecture |