[Haskell-cafe] ok, someone check me on this (type unification from the (>>=)/fmap thread)

Daniel Fischer daniel.is.fischer at web.de
Sun May 10 12:04:33 EDT 2009


Am Sonntag 10 Mai 2009 07:24:43 schrieb Brandon S. Allbery KF8NH:
> I can't tell where I'm making the mistake here.
>
> In the thread where (>>=) and fmap were being confused, the error
> cited a type (Maybe a) which was supposed to be in typeclass Num.  As
> far as I can tell, if the typechecker gets to the point where Num and
> Maybe are both present and (m) is Maybe, it has to (1) be focused on
> the (m b) part of (a -> m b), and therefore (2) must have already
> unified (a) and (b).  But that means (m b) must unify with (Num a =>
> a), which is unified with (b), resulting in the attempt to unify (Num
> a => a) with (Maybe a); since we get the error about (Maybe a) not
> being a Num, it must not have gotten there.  But that means it can't
> have related Num to (m a) with (m) bound to Maybe, which is why I
> assumed it had unified (m) with ((->) r) instead.
>
> Can the typechecker really get the Num to the other end of (a -> m b)
> without also getting the (a) there?  Or is it checking for the Num
> constraint before it has fully evaluated the type of (m b)?  I thought
> typeclass constraints happened later than basic type unification.

Just in case it hasn't been answered yet:

Just 3 >>= (1+)

Just 3 :: (Num n1) => Maybe n1
(>>=) :: (Monad m) => m a -> (a -> m b) -> m b
(1+) :: (Num n2) => n2 -> n2

(Just 3 >>=) :: (Num n1) => (n1 -> Maybe b) -> Maybe b

Now we must unify the type of (1+) with (Just 3 >>=)'s argument's type, that is

(Num n2) => n2 -> n2 with (Num n1) => n1 -> Maybe b

n2 = n1
n2 = Maybe b

giving

(Just 3 >>=) :: (Num (Maybe b)) => (Maybe b -> Maybe b) -> Maybe b

Just 3 >>= (1+) :: Num (Maybe b) => Maybe b

=================================================
module MaybeNum where

import Control.Monad

instance Num a => Num (Maybe a) where
    (+) = liftM2 (+)
    (-) = liftM2 (-)
    (*) = liftM2 (*)
    signum = fmap signum
    abs = fmap abs
    negate = fmap negate
    fromInteger = Just . fromInteger
=================================================
*MaybeNum> Just 3 >>= (1+)
Just 4

or, weirder:
=================================================
instance Num (Maybe Bool) where
    (+) = liftM2 (/=)
    (-) = (+)
    (*) = liftM2 (&&)
    signum = (`mplus` Just False)
    abs = signum
    negate = id
    fromInteger = Just . odd
=================================================
*MaybeNum> Just 3 >>= (1+) :: Maybe Bool
Just False



More information about the Haskell-Cafe mailing list