brain explosion in polymorphic state monad
Hal Daume III
hdaume@ISI.EDU
Thu, 10 Oct 2002 16:32:25 -0700 (PDT)
I'm not sure why it's doing that, but you can see (and fix!) the same
problem in a simpler case:
data Foo a = forall b . Foo a b
foo (Foo a _) f =
let Foo _ b = f a
in Foo a b
This causes the same error. Presumably this has to do with the compiler
worrying about escaping variables or something. I'm not sure. There's a
workaround, though, which I bet will work in your case. First we define:
refoo (Foo a _) (Foo _ b) = Foo a b
Then we redefine the foo function using this:
foo x@(Foo a _) f = refoo x (f a)
and we have a semantically identical, but now acceptable, function.
HTH
- Hal
--
Hal Daume III
"Computer science is no more about computers | hdaume@isi.edu
than astronomy is about telescopes." -Dijkstra | www.isi.edu/~hdaume
On Thu, 10 Oct 2002, mathieu wrote:
> Hello,
>
> I am trying to define a polymorphic state monad using glasgow extensions and I got a brain explosion of ghc when i try to compile it.
>
> Here is the code :
>
> newtype StateT s m a = MkStateT (s -> m (a, s))
>
> instance Monad m => Monad (StateT s m) where
> return x = MkStateT (\s -> return (x, s))
> MkStateT m1 >>= k =
> MkStateT
> (\s0 -> do (a, s1) <- m1 s0
> let MkStateT m2 = k a
> m2 s1 )
>
> data Thread a = forall b . MkThread (StateT (Thread b) [] a)
>
> instance Monad Thread where
> return = MkThread . return
> MkThread p >>= k = MkThread ( do x <- p
> let MkThread p' = k x
> p' )
>
> I got this error :
> My brain just exploded.
> I can't handle pattern bindings for existentially-quantified constructors.
> In the binding group
> MkThread p' = k x
> In the first argument of `MkThread', namely
> `(do
> x <- p
> let MkThread p' = k x
> p')'
> In the definition of `>>=':
> MkThread (do
> x <- p
> let MkThread p' = k x
> p')
>
> How can i define (>>=) for my thread monad ?
>
> Thanks in advance for any piece of advice,
> Mathieu
>
> --
> There are only 10 types of people in the world:
> Those who understand binary and those who don't.
> _______________________________________________
> Glasgow-haskell-users mailing list
> Glasgow-haskell-users@haskell.org
> http://www.haskell.org/mailman/listinfo/glasgow-haskell-users
>