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