[Haskell-beginners] Typeclasses vs. Data

Thomas haskell at phirho.com
Wed Jul 20 23:58:16 CEST 2011


Hello!

Trying to rewrite a program I ran into a type problem with typeclasses.

It's a mini-interpreter, the essential (extremely reduced) part is:

eval e k = case (car e) of
      (Id "begin") ->  eval_begin (cdr e) k
eval_begin e k = eval (car e) (if isNull (cdr e) then k else (BeginCont 
k (cdr e)))

Using "data" to define my data all is well:

data Continuation =
      BeginCont Continuation Expression
resume k e = case k of
        BeginCont k' es -> eval_begin es k'

Unfortunately when trying to extend the program by other types of 
"Continuation" I must add to the data definition and add a matching 
clause to "resume". That is I must modify the core module.
So I tried to decouple this using a typeclass like so:

class Continuation a where
    resume :: a -> Expression -> Expression

data BeginCont a = BeginCont a Expression deriving (Show)
instance (Continuation a) => Continuation (BeginCont a) where
   resume (BeginCont k es) v = eval_begin es k

This, however, results in an "infinite type" error.

Is there a way to make the typeclass version typecheck?
If not: How can one decouple this code in Haskell?

What also puzzles me are the differences in "infinite" types.
The above data declaration for "Continuation" is essentially infinite, 
too. But it works. And I thought I had understood this part...

Any hints greatly appreciated!
Thanks in advance,
Thomas


PS:
The minimal "program" to get it type check is:

data Expression = Null | Num Int | Id String | List [Expression]
      deriving (Eq, Show)

cdr :: Expression -> Expression
cdr (List []) = error "cdr Null !"
cdr (List (_:[])) = Null
cdr (List (l:ls)) = List ls

car :: Expression -> Expression
car (List l) = head l

isNull Null = True
isNull _ = False

eval e k = case (car e) of
      (Id "begin") ->  eval_begin (cdr e) k

eval_begin e k = eval (car e) (if isNull (cdr e) then k else (BeginCont 
k (cdr e)))

-- replace the following 5 lines...
data Continuation =
      BeginCont Continuation Expression

resume k e = case k of
        BeginCont k' es -> eval_begin es k'

{- ... with these to see the error
class Continuation a where
    resume :: a -> Expression -> Expression

data BeginCont a = BeginCont a Expression deriving (Show)
instance (Continuation a) => Continuation (BeginCont a) where
   resume (BeginCont k es) v = eval_begin es k
-]



More information about the Beginners mailing list