How do I write the type of 'inverse'?
G Michael Sawka
gmsawka@yahoo.com
16 Nov 2001 13:53:01 -0800
<marku@cs.waikato.ac.nz> writes:
> I have a class whose instances can extract a field of type a.
> Is there a way of referring to that type 'a' in the signatures
> of functions that use the class? Sigh! That wasn't very clear.
>
> I'll try explaining via example:
> I am trying to define a `Pairable' class, which is an abstraction
> of all kinds of pairs: (a,b), Pair a b, etc.
>
> > class Ord p => Pairable p where
> > is_pair :: p -> Bool
> > pair_fst :: Ord a => p -> a -- Precondition: is_pair
> > pair_snd :: Ord b => p -> b -- Precondition: is_pair
> > make_pair :: (Ord a, Ord b) => a -> b -> p
>
> > instance (Ord a, Ord b) => Pairable (a,b) where
> > is_pair (a,b) = True
> > pair_fst (a,b) = a
> > pair_snd (a,b) = b
> > make_pair a b = (a,b)
Haskell's class system is extremely confusing --
although beautiful + very powerful :)
I think what you want, is a class and an instance declaration that
looks like this:
class Pairable p where
is_pair :: p a b -> Bool
pair_fst :: p a b -> a
pair_snd :: p a b -> b
make_pair :: a -> b -> p a b
instance Pairable (,) where
is_pair (_,_) = True
pair_fst (a,_) = a
pair_snd (_,b) = b
make_pair a b = (a,b)
Now, what makes this confusing, at least to me, is the fact that in
the class decl you can say "p a b -> a". "p" in this case is a
function over type-variables, not just a normal run-of-the-mill type
variable (the Monad class uses this same principle). In more
technical terms, "p" has a "kind" of * -> * -> *, whereas all "normal"
values have kind "*". This means that we can create an instance only
out of a constructor that has "kind" * -> * -> *, of which (,) (the
pair constructor) is one of. The idea is that "p a b" is "p" with "a"
and "b" applied to it! So in the instance the types become:
is_pair :: (,) a b -> Bool
pair_fst :: (,) a b -> a
... etc.
Everything works out. This compiles, and you can do neat tricks like:
main = putStrLn (pair_snd (1,"hello world"))
Just be careful with the function "make_pair". If you try to use it
in a pain, vanilla context you will get a type ambiguity:
main = putStrLn (pair_snd (make_pair 1, "foo"))
Ambiguous type variable(s) `p' in the constraint `Pairable p'
arising from use of `make_pair' at tf.hs:21
In the first argument of `pair_snd', namely
`((make_pair 1 "foo"))'
In the first argument of `putStrLn', namely
`(pair_snd ((make_pair 1 "foo")))'
The problem is that the compiler does not know which instance of pair
to use for make_pair! If I also declared:
data Foo a b = Foo a b
instance Pairable Foo where
is_pair Foo a b = True
pair_fst Foo a _ = a
pair_snd Foo _ b = b
make_pair a b = Foo a b
it would be impossible to know which instance to use in the example.
should it construct a "Foo" and then take pair_snd, or should it
construct a Pair and then take pair_snd? (The same problems exist
with the "return" of the Monad class). The solution is just to show
the compiler which one you want:
main = putStrLn (pair_snd ((make_pair 1 "hello!") :: (Int,[Char])))
I hope this helps some :)
If you're still confused about values with kinds other than "*", take
a look at the Monad class or the language reference. Very cool stuff.
-mike.
_________________________________________________________
Do You Yahoo!?
Get your free @yahoo.com address at http://mail.yahoo.com