Ambiguous types

Janis Voigtlaender voigt@orchid.inf.tu-dresden.de
Mon, 21 Jan 2002 09:25:34 +0100


"Daniel ." wrote:
> 
> {-code-}
> module ActorTest where
> 
> class Actor t where
> 
>   canAct :: t -> Bool
>   validActions :: (Action u) => t -> [u]
> 
>   canAct actor = validActions actor == []
>   validActions actor = []
> 
> class Eq t => Action t
> {-end code-}
> 
> Is the error saying that it is impossible to
> tell what specific type instance of the
> Action class will be returned by validActions?
> If so, why should it matter?  Isn't it enough
> to know that they results will be of the
> class Action?

I will give it a try, please anyone correct me if I'm going wrong:

validActions has type "(Action u) => t -> [u]", that is, if t is an
instance of Actor, and actor is a value of type t, then (validActions
actor) has type "(Action u) => [u]", because t and u are independent.
This means that (validActions actor) is polymorphic and must be able to
give you lists of any types that are instances of Action. Since there
are no methods of the Action class that would produce actions, the only
thing that (validActions actor) can return is the empty list, just as in
your example.
But now, in the definition of canAct, you are trying to compare two
values of type "(Action u) => [u]" with (==) which might seem okay,
since the Action constraint includes the Eq constraint. But instead it
is not okay, because the instance of (==) you are trying to use has type
"Eq u => [u] -> [u] -> Bool" which is not the same as something like
"(Eq u => [u]) -> (Eq u => [u]) -> Bool".
The difference here is similar to the difference between the two
first-order logic formulas "forall x . P(x) and Q(x) implies S" and
"(forall x . P(x)) and (forall x . Q(x)) implies S".

Hope that helps and doesn't just make the story more obscure ;-)

Janis.

--
Janis Voigtlaender
http://wwwtcs.inf.tu-dresden.de/~voigt/
mailto:voigt@tcs.inf.tu-dresden.de