Why is type 'b' forced to be type 'm a' and not possibly 'm a -> m a'

15 Sep 2006

      Dear Haskell Cafe,

I have a problem I can't get my head around. The code below sets the problem
out.  What I need to be able to do is commented out.

This code works, the only problem is that what I need is that an argument
will be evaluated before it is passed,
so ((and fries eats) eggs) has a single `eggs` (fries1 eggs2 and3 eats4
egg2) not (fries1 eggs2 and3 eats4 eggs5).

The code that doesn't work is commented out at the bottom.  I'm not sure the
behaviour  of ghc is correct, because 
when it typechecks it tries to unify `b = t t1` but `b` could actually be `t
t1 -> t t1`.

I want to be able to specify that when the first argument of `b` is of type
`m a` that fork should run it and _then_
fork the argument to the first two arguments of 'fork'.  The instance for (a
-> b) covers the rest of the possibilities.

just type "run test[1-4]" to see results.

\begin{code}
{-# OPTIONS_GHC -fglasgow-exts -fno-monomorphism-restriction #-}

module Fork where

{---------------------------------------------------------------------------
--}

import Prelude hiding (and)

import Control.Monad.State

{---------------------------------------------------------------------------
--}

data NRef = NS0 String
          | NS1 String NRef
          | NS2 String NRef NRef
          deriving(Show)

{---------------------------------------------------------------------------
--}

data UniqueS = US { nums :: [String] }
    deriving(Show)

type USM a = StateT UniqueS IO a

newUniqueS :: UniqueS
newUniqueS = US { nums = [ show x | x <- [1..] ] }

freshInstance :: String -> USM String
freshInstance x = do
                  (f:fs) <- gets nums
                  put $ US { nums = fs }
                  return $ x ++ f

{---------------------------------------------------------------------------
--}

single x = do
    x' <- freshInstance x
    return $ NS0 x'

unary x n = do
    x' <- freshInstance x
    n' <- n
    return $ NS1 x' n'

binary x n1 n2 = do
    x' <- freshInstance x
    n1' <- n1
    n2' <- n2
    return $ NS2 x' n1' n2'

{---------------------------------------------------------------------------
--}

foxy = single "foxy"
eggs = single "eggs"
golden = unary "golden"
white = unary "white"
fries = binary "fries"
eats = binary "eats"

{---------------------------------------------------------------------------
--}

class Forkable a where
    fork :: String -> a -> a -> a

instance (Forkable a, Forkable b) => Forkable (a -> b) where
    fork n a1 a2 a = fork n (a1 a) (a2 a)

{-
instance (Monad m, Forkable (m a), Forkable b) => Forkable (m a -> b) where
    fork n a1 a2 a = do
                     a' <- a
                     fork n (a1 $ return a') (a2 $ return a')
-}
{---------------------------------------------------------------------------
--}

instance Forkable (USM NRef) where
    fork n a1 a2 = do
                   a1' <- a1
                   a2' <- a2
                   return $ NS2 n a1' a2'

{---------------------------------------------------------------------------
--}

and = fork "and"

test1 = (and foxy eggs)
test2 = (and golden white) eggs
test3 = (and fries eats) foxy eggs
test4 = (eats foxy (and (golden eggs) (white eggs))) 

run x = runStateT x newUniqueS >>= (putStrLn . show . fst)
\end{code

-- 
No virus found in this outgoing message.
Checked by AVG Free Edition.
Version: 7.1.405 / Virus Database: 268.12.4/448 - Release Date: 14/09/2006

Vivian McPhail

Anatoly Zaretsky

tags

participants (2)