[jhc] Classes

John Meacham john at repetae.net
Mon Mar 10 09:56:55 EDT 2008


On Fri, Mar 07, 2008 at 11:27:48PM -0500, Samuel Bronson wrote:
> John, can you please document your implementation of classes a bit?
> I'm trying to implement class aliases... we #haskellers are getting
> sick of having no such mechanism to play around with... but it would
> be a lot easier if I understood the module FrontEnd.Class.

Well, there are two parts to classes in jhc. There is the Front End,
which has to typecheck them, keep track of instances and so forth, and
the back end, which generates the code for them. Oddly enough, due to
the way jhc implements classes, there is no need for the two to
communicate :). Since jhc examines the type variables directly, after
type checking the class contexts on haskell functions are just
discarded when converting to jhc core.

For class aliases, you just need to worry about the front end, which,
unfortunately is the less clean of the two. The design evolved directly
from hatchet, which evolved from the THIH paper[1]. So, understanding
that paper might be a good place to start, however you should not need
to touch the type checker at all for class aliases so they can actually
be quite easy to implement.

The information about each class is collected in a
FrontEnd.Class.ClassRecord, a 'ClassHierarchy' is just a bunch of class
records. when reading in multiple files, their class hierarchies are
combined, which simply means combining the instances.

what actually happens in the compiler is:

a class definition

module Main where
class Foo a where
        foo :: a -> Int

produces the following bit of core (written in psuedo-haskell)

{-# NOINLINE foo #-}
Main.foo :: forall a . a -> Int
Main.foo = error "Placeholder" 

as far as everything else is concerned, this is just another routine
like any other, since it is never inlined, the fact that its body is
'error' is never exposed.

an instance

instance Foo Char where
        foo c = ord c

produces the following core

Instance at .Main.Foo.foo.Prelude.Char :: Char -> Int
Instance at .Main.Foo.foo.Prelude.Char c = ord c

{-# RULES "foo/char/instance"  Main.foo Char = Instance at .Main.Foo.foo.Prelude.Char #-}

(note the explicity application of Main.foo to Char in the head of the
rule, haskell hides these applications, the 'forall a' in foo's type
signature  is how you know it is secretly there)

now, whenever Main.foo is called at a Char, it gets replaced with the
appropriate instance method.

before final compilation, all the RULES attached to any placeholder are
turned into an explicit case on the type variable. This mechanism also
allows SUPERSPECIALIZE and allows for 'run time rules', though that has
not been explored.

Umm.. I guess I got sidetracked from class aliases... For those what you
want to do is add a new type of 'ClassRecord' that encodes all the
information about a class alias, then in the front end (the desugarer is
probably easiest, but in the type checker will probably allow better
error messages) when you come across a class alias, expand it to its
underlying class via the class alias rules. you should not need to
modify anything other than the frontend for that, though a few things
will have to be taught to ignore the new ClassAlias entries in
ClassHierarchy.

        John



-- 
John Meacham - ⑆repetae.net⑆john⑈


More information about the jhc mailing list