2011/3/8 Roel van Dijk <vandijk.r...@gmail.com>:
> Hello everyone,
Hello!
> But I lost the power of the context! How do I get it back?
The tagless interpreters splits the interpreter code (in your case,
the 'eval' function) into multiple functions on one or more type
classes. Now, the key insight is that your interpreter is actually
not 'eval' but 'go' =), which has type 'Ctx -> a' (instead of just
'a'). But you don't need to change any code that uses Lit, Add and
Mul, they work unmodified.
First of all, I'll generalize your context a bit:
data Ctx a = Empty
| AddL a (Ctx a)
| AddR a (Ctx a)
| MulL a (Ctx a)
| MulR a (Ctx a)
deriving (Show)
Now we can create a new interpreter:
newtype CtxInterpA a = CIA {unCIA :: Ctx a → a}
I'm appending A to its name because later on I'll propose another
interpreter B. The underlying type 'a' is the same 'a' from your
original 'eval' function, so we can't use 'lit' from 'Lit' type class.
So we create
class CtxLitA a where
ctxLitA :: Integer → Ctx a → a
Our interpreter's instance for 'Lit' is then simply
instance CtxLitA a ⇒ Lit (CtxInterpA a) where
lit = CIA∘ctxLitA
To get a result from 'CtxInterpA a' we just pass an empty context:
fromCtxInterpA :: CtxInterpA a → a
fromCtxInterpA x = unCIA x Empty
The 'Add' instance, however, is somewhat problematic. We need an 'a'
for our 'Ctx a', however the arguments given for 'add' are of type
'CtxInterpA a'. To get an 'a' from 'CtxInterpA a' we need, again, a
'Ctx a'.
instance Add a ⇒ Add (CtxInterpA a) where
add x y = CIA (λctx → let x' = unCIA x (AddL y' ctx)
y' = unCIA y (AddR x' ctx)
in x' `add` y')
The main problem with this instance with respect to your original
'eval' code is that in 'AddL' and 'AddR' we have y' and x', and not y
and x. So y' and x' are mutually recursive. The Mul instance is
similar.
This may or may not be what you wanted on your original problem.
Note, however, that there's a plan B. We can have different
definitions of CtxLitA and CtxInterpA, this time using 'Ctx Exp':
class CtxLitB a where
ctxLitB :: Integer → Ctx Exp → a
data CtxInterpB a = CIB {cibMake :: Ctx Exp → a
,cibExp :: Exp}
Besides our function that creates 'a's, we also keep note of the
corresponding 'Exp' and use it to create the 'Ctx Exp' without mutual
recursion:
instance CtxLitB a ⇒ Lit (CtxInterpB a) where
lit i = CIB (ctxLitB i) (lit i)
instance Add a ⇒ Add (CtxInterpB a) where
add x y = CIB (λctx → let x' = cibMake x (AddL (cibExp y) ctx)
y' = cibMake y (AddR (cibExp x) ctx)
in x' `add` y')
(add (cibExp x) (cibExp y))
The drawback of this approach should be obvious: we are tagging
everything =). So this sort of defeats the tagless interpreter
approach.
I don't know if this solves your real problem, but it may be a start
=). I'm attaching everything.
Cheers,
--
Felipe.
module Tagless where
class Lit a where lit :: Integer -> a
class Add a where add :: a -> a -> a
class Mul a where mul :: a -> a -> a
instance Lit Integer where lit = fromInteger
instance Add Integer where add = (+)
instance Mul Integer where mul = (*)
-- Newtype so I don't need FlexibleInstances.
newtype Str = Str {unS :: String}
instance Show Str where show = show . unS
addStr x y = "(" ++ x ++ " + " ++ y ++ ")"
mulStr x y = "(" ++ x ++ " * " ++ y ++ ")"
instance Lit Str where lit = Str . show
instance Add Str where add x y = Str $ addStr (unS x) (unS y)
instance Mul Str where mul x y = Str $ mulStr (unS x) (unS y)
t1 :: (Lit a, Add a, Mul a) => a
t1 = (lit 3 `add` lit 4) `mul` lit 2
data Exp = Lit Integer
| Add Exp Exp
| Mul Exp Exp
deriving (Show)
instance Lit Exp where lit = Lit
instance Add Exp where add = Add
instance Mul Exp where mul = Mul
data Ctx a = Empty
| AddL a (Ctx a)
| AddR a (Ctx a)
| MulL a (Ctx a)
| MulR a (Ctx a)
deriving (Show)
-- First approach
-- Drawback: mutual recursion on the definition of add and mul.
class CtxLitA a where
ctxLitA :: Integer -> Ctx a -> a
newtype CtxInterpA a = CIA {unCIA :: Ctx a -> a}
instance CtxLitA a => Lit (CtxInterpA a) where
lit = CIA . ctxLitA
instance Add a => Add (CtxInterpA a) where
add x y = CIA (\ctx -> let x' = unCIA x (AddL y' ctx)
y' = unCIA y (AddR x' ctx)
in x' `add` y')
instance Mul a => Mul (CtxInterpA a) where
mul x y = CIA (\ctx -> let x' = unCIA x (MulL y' ctx)
y' = unCIA y (MulR x' ctx)
in x' `mul` y')
fromCtxInterpA :: CtxInterpA a -> a
fromCtxInterpA x = unCIA x Empty
-- Second approach
-- Drawback: have to maintain two representations
class CtxLitB a where
ctxLitB :: Integer -> Ctx Exp -> a
data CtxInterpB a = CIB {cibMake :: Ctx Exp -> a
,cibExp :: Exp}
instance CtxLitB a => Lit (CtxInterpB a) where
lit i = CIB (ctxLitB i) (lit i)
instance Add a => Add (CtxInterpB a) where
add x y = CIB (\ctx -> let x' = cibMake x (AddL (cibExp y) ctx)
y' = cibMake y (AddR (cibExp x) ctx)
in x' `add` y')
(add (cibExp x) (cibExp y))
instance Mul a => Mul (CtxInterpB a) where
mul x y = CIB (\ctx -> let x' = cibMake x (MulL (cibExp y) ctx)
y' = cibMake y (MulR (cibExp x) ctx)
in x' `mul` y')
(mul (cibExp x) (cibExp y))
fromCtxInterpB :: CtxInterpB a -> a
fromCtxInterpB x = cibMake x Empty
_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe
