
Dear café,
{-# LANGUAGE Rank2Types #-} {-# LANGUAGE ImpredicativeTypes #-}
type Void = forall a. a
newtype Mono a = Mono { runMono :: [Void] }
beep :: Mono a -> Mono a beep (Mono vs) = Mono (map undefined vs)
Compiling this with GHC results in:
Monotype.hs:9:28: Cannot match a monotype with `Void' Expected type: Void Inferred type: a
What does this error mean and why does the code not compile? Thanks! Martijn.

* Martijn van Steenbergen
Dear café,
{-# LANGUAGE Rank2Types #-} {-# LANGUAGE ImpredicativeTypes #-}
type Void = forall a. a
newtype Mono a = Mono { runMono :: [Void] }
beep :: Mono a -> Mono a beep (Mono vs) = Mono (map undefined vs)
Compiling this with GHC results in:
Monotype.hs:9:28: Cannot match a monotype with `Void' Expected type: Void Inferred type: a
What does this error mean and why does the code not compile?
It works if you annotate the type of undefined: beep (Mono vs) = Mono (map (undefined :: Void -> Void) vs) -- Roman I. Cheplyaka :: http://ro-che.info/ "Don't let school get in the way of your education." - Mark Twain

It's a poor error message, but GHC's entire handling of impredicative polymorphism is poor at the moment. Indeed, I'm seriously considering removing it altogether until we can come up with a more robust story. (So don't rely on it!) The error happens because you are trying to use the type (forall a. a) in a context that requires a monotype (one with no foralls). I have not stared at the typing rules (in our papers) to convince myself that your program does transgress them; indeed, I regard the necessity to do so as evidence that the approach is not robust. Simon | -----Original Message----- | From: haskell-cafe-bounces@haskell.org [mailto:haskell-cafe-bounces@haskell.org] On | Behalf Of Martijn van Steenbergen | Sent: 14 October 2009 19:35 | To: Haskell Cafe | Subject: [Haskell-cafe] Monotype error | | Dear café, | | > {-# LANGUAGE Rank2Types #-} | > {-# LANGUAGE ImpredicativeTypes #-} | > | > type Void = forall a. a | > | > newtype Mono a = Mono { runMono :: [Void] } | > | > beep :: Mono a -> Mono a | > beep (Mono vs) = Mono (map undefined vs) | | Compiling this with GHC results in: | | > Monotype.hs:9:28: | > Cannot match a monotype with `Void' | > Expected type: Void | > Inferred type: a | | What does this error mean and why does the code not compile? | | Thanks! | | Martijn. | _______________________________________________ | Haskell-Cafe mailing list | Haskell-Cafe@haskell.org | http://www.haskell.org/mailman/listinfo/haskell-cafe

See our previous discussion on this topic here: http://www.nabble.com/Fwd:-Unification-for-rank-N-types-td23942179.html Thanks, Vladimir On Wed, Oct 14, 2009 at 10:35 PM, Martijn van Steenbergen < martijn@van.steenbergen.nl> wrote:
Dear café,
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ImpredicativeTypes #-}
type Void = forall a. a
newtype Mono a = Mono { runMono :: [Void] }
beep :: Mono a -> Mono a beep (Mono vs) = Mono (map undefined vs)
Compiling this with GHC results in:
Monotype.hs:9:28:
Cannot match a monotype with `Void' Expected type: Void Inferred type: a
What does this error mean and why does the code not compile?
Thanks!
Martijn. _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
participants (4)
-
Martijn van Steenbergen
-
Roman Cheplyaka
-
Simon Peyton-Jones
-
Vladimir Reshetnikov