Desugaring of do-syntax intros unification var with -XRebindableSyntax
When compiling below snippet with GHC 7.8.x (and I believe v7.10.x)
{-# LANGUAGE RankNTypes, RebindableSyntax #-}
import qualified Prelude as P
(>>=) :: a -> ((forall b . b) -> c) -> c
a >>= f = f P.undefined
return a = a
fail s = P.undefined
t1 = 'd' >>= (\_ -> 'k')
t2 = do _ <- 'd'
'k'
main = P.putStrLn [t1, t2]
we get this error:
Ztest.hs:12:9:
Cannot instantiate unification variable `t0`
with a type involving foralls: forall b. b
Perhaps you want ImpredicativeTypes
In a stmt of a 'do' block: _ <- 'd'
In the expression:
do { _ <- 'd';
'k' }
In an equation for `t2`:
t2
= do { _ <- 'd';
'k' }
Failed, modules loaded: none.
In GHC HEAD (and v7.6.x) the error does not appear. Nevertheless I'll file this bug for addition of a regression test.
Discussion here: https://mail.haskell.org/pipermail/ghc-devs/2015-February/008383.html
Trac metadata
Trac field | Value |
---|---|
Version | 7.8.4 |
Type | Bug |
TypeOfFailure | OtherFailure |
Priority | normal |
Resolution | Unresolved |
Component | Compiler |
Test case | |
Differential revisions | |
BlockedBy | |
Related | |
Blocking | |
CC | |
Operating system | |
Architecture |