[Haskell-cafe] Are GADTs what I need?

Luke Palmer lrpalmer at gmail.com
Mon Jul 13 16:25:38 EDT 2009


On Mon, Jul 13, 2009 at 6:09 AM, Chris Eidhof <chris at eidhof.nl> wrote:

> Hey Kev,
>
> The types are "thrown away" during compile time. Therefore, if you have a
> constructor "VWrapper :: a -> Value" nothing is known about that "a" when
> you scrutinize it.
>
> What you could do, however, is something like this:
>
>  data Value a where
>>  VInt :: Integer -> Value Integer
>>  ...
>>  VWrapper :: a -> Value a
>>
>
> And then you can write a function doSomething:
>
>  doSomething :: Value String -> String
>> doSomething (VWrapper s) = s
>
>
I would like to put in a thumbs up on this approach.  I'm currently
experimenting with interpreters, and have found that parameterizing over the
value type works quite smoothly.

Specifically, this is my usual starting point for the values:

    data Value a
        = VFun (Value a -> Value a)
        | VPrim a

Then I use a typeclass to endow the primitives with the structure they need:

    class ValueType a where
        apply :: a -> a -> a

Here's a simple interpreter for terms in De Bruijn notation:

    data Term a
        = TLit a
        | TApp (Term a) (Term a)
        | TLam (Term a)
        | TVar Int

    eval :: (ValueType a) => Term a -> [Value a] -> Value a
    eval (TLit x) = const (VPrim x)
    eval (TApp x y) =
        let x' = eval x
            y' = eval y
        in \env -> x' env % y' env
    eval (TLam body) =
        let body' = eval body
        in \env -> VFun (\x -> body (x:env))
    eval (TVar z) = \env -> env !! z

    (%) :: (ValueType a) => Value a -> Value a -> Value a
    VFun f % x = f x
    VPrim x % VFun _ = error "Apply primitive to function not supported"
    VPrim x % VPrim y = VLit (x `apply` y)

And an example ValueType:

    data Prim = PInt Int | PSucc
    instance ValueType Prim where
        apply PSucc (PInt z) = PInt $! z+1
        apply _ _ = error "Type error"

This approach has been very nice and modular for experimenting with
dynamically typed interpreters. You could support application of literals to
functions with some more support from the type class, but it wasn't worth it
to me (and would limit the interpretation strategies that I would be able to
use).

The decision about what suite of primitives to include and how they combine
with each other is pushed out to the user, and the interpreter just focuses
on the important things: functions.  You could even write a little primitive
combinator library (perhaps made more composable by switching to dictionary
passing for ValueType instead of typeclass), so that users can easily
specify any suite of primitives.

Anyway, those were just some thoughts for you.

Luke
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/haskell-cafe/attachments/20090713/e45c566f/attachment.html


More information about the Haskell-Cafe mailing list