On 07/12/2011 05:01 PM, Ryan Newton wrote:
Hi all,

Is there something wrong with the code below?  My anticipation was that
the type of "test" would include the class constraint, because it uses
the Assign constructor.  But if you load this code in GHCI you can see
that the inferred type was "test :: E m -> E m".

When I complete the pattern match in 'test', it might look like this:

test x = case x of
    Assign v e1 e2 -> x
    Varref v -> x

(which is just id :: E m -> E m). Of course, we want to be able to write

>>> test (Varref v)

for any v :: V, and match the second case. But as 'Varref' does not add an AssignCap constraint, 'test' must not either.

Hope that helps. Steffen


Thanks,
   -Ryan


{-# LANGUAGE GADTs #-}

class AssignCap m
data PureT
data IOT
instance AssignCap IOT

data E m where
   Assign  :: AssignCap m => V -> E m -> E m -> E m
   Varref  :: V -> E m
-- ...

type V = String

-- I expected the following type but am not getting it:
-- test :: AssignCap m => E m -> E m
test x =
   case x of
    Assign v e1 e2 -> Assign v e1 e2
-- And this is the same:
    Assign v e1 e2 -> x



_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe

Reply via email to