QuantifiedConstraints: panic "addTcEvBind NoEvBindsVar"
I wanted to see if we're ready to put join
into Monad
. So I typed this in:
{-# LANGUAGE QuantifiedConstraints, StandaloneDeriving, GeneralizedNewtypeDeriving #-}
module Bug where
import Prelude hiding ( Monad(..) )
import Data.Coerce ( Coercible )
class Monad m where
(>>=) :: m a -> (a -> m b) -> m b
join :: m (m a) -> m a
newtype StateT s m a = StateT { runStateT :: s -> m (s, a) }
instance Monad m => Monad (StateT s m) where
ma >>= fmb = StateT $ \s -> runStateT ma s >>= \(s1, a) -> runStateT (fmb a) s1
join ssa = StateT $ \s -> runStateT ssa s >>= \(s, sa) -> runStateT sa s
newtype IntStateT m a = IntStateT { runIntStateT :: StateT Int m a }
deriving instance (Monad m, forall p q. Coercible p q => Coercible (m p) (m q)) => Monad (IntStateT m)
This looks like it should be accepted. But I get
ghc-stage2: panic! (the 'impossible' happened)
(GHC version 8.5.20180617 for x86_64-apple-darwin):
addTcEvBind NoEvBindsVar
[G] df_a67k
= \ (@ p_a62C) (@ q_a62D) (v_B1 :: Coercible p_a62C q_a62D) ->
coercible_sel
@ *
@ (m_a64Z[ssk:1] p_a62C)
@ (m_a64Z[ssk:1] q_a62D)
(df_a651 @ p_a62C @ q_a62D v_B1)
a67c
Call stack:
CallStack (from HasCallStack):
callStackDoc, called at compiler/utils/Outputable.hs:1164:37 in ghc:Outputable
pprPanic, called at compiler/typecheck/TcRnMonad.hs:1404:5 in ghc:TcRnMonad
Trac metadata
Trac field | Value |
---|---|
Version | 8.4.3 |
Type | Bug |
TypeOfFailure | OtherFailure |
Priority | normal |
Resolution | Unresolved |
Component | Compiler |
Test case | |
Differential revisions | |
BlockedBy | |
Related | |
Blocking | |
CC | |
Operating system | |
Architecture |