[jhc] Classes

Samuel Bronson naesten at gmail.com
Mon Mar 10 13:50:09 EDT 2008


On 3/10/08, John Meacham <john at repetae.net> wrote:

> 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 #-}

Hmm. What should I name default implementations?


More information about the jhc mailing list