[Haskell-beginners] Ambiguous type variable

David McBride dmcbride at neondsl.com
Sat Jul 30 22:30:29 CEST 2011


I can't run your code to be sure, but I think your problem is the ==.
It implies that whatever a is, it has an Eq constraint, but none of
your type signatures imply that.  Try this:

      case pop EmptyStack) of
        (Nothing, EmptyStack) -> blah
        otherwise -> do something else or nothing

That way you are using pattern matching instead of equality testing.

On Sat, Jul 30, 2011 at 4:19 PM, Ovidiu Deac <ovidiudeac at gmail.com> wrote:
> I'm playing with Haskell so I wrote a stack module (see the code
> below). I have a problem with the pop function which returns a tuple
> (Nothing, EmptyStack) if called with an EmptyStack.
>
> I kind of understand that the compiler cannot cannot figure out what
> type to use for a. But how could I tell the compiler that if the list
> is empty I don't care about that type?
>
> Thanks,
> Ovidiu
>
> /////////////////
> This is the hspec
> ...
>    it "pop empty stack gives Nothing"
>        ( (pop EmptyStack) ≡ (Nothing, EmptyStack))
> ...
>
> This is the code:
> module Stack where
> import Prelude
>
> data Stack a =
>    EmptyStack |
>    StackEntry a (Stack a)
>    deriving(Show, Eq)
> ...
> pop :: Stack a →  (Maybe a, Stack a)
> pop EmptyStack = (Nothing, EmptyStack)
> pop (StackEntry a s) = ((Just a), s)
>
> ...and this is the error I get:
> test/TestStack.hs:20:28:
>    Ambiguous type variable `a0' in the constraint:
>      (Eq a0) arising from a use of `=='
>    Probable fix: add a type signature that fixes these type variable(s)
>    In the second argument of `it', namely
>      `((pop EmptyStack) == (Nothing, EmptyStack))'
>    In the expression:
>      it
>        "pop empty stack gives Nothing"
>        ((pop EmptyStack) == (Nothing, EmptyStack))
>    In the second argument of `describe', namely
>      `[it "empty stack is empty" (isEmpty EmptyStack),
>        it
>          "non-empty stack is not empty"
>          (not (isEmpty (push 10 EmptyStack))),
>        it
>          "push then pop retrieves the same value"
>          ((pop $ push 10 EmptyStack) == (Just 10, EmptyStack)),
>        it
>          "push push then pop retrieves the last value"
>          ((pop $ push 2 (push 1 EmptyStack))
>         ==
>           (Just 2, (push 1 EmptyStack))),
>        ....]'
> make: *** [test] Error 1
>
> _______________________________________________
> Beginners mailing list
> Beginners at haskell.org
> http://www.haskell.org/mailman/listinfo/beginners
>



More information about the Beginners mailing list