[Haskell-cafe] Map constructor in a DSL
Dupont Corentin
corentin.dupont at gmail.com
Tue Oct 26 12:07:22 EDT 2010
Hello café,
I have a little DSL in my program as follow.
Now I'd like to add a Map constructor in it. Thats where I would need help!
> data Obs a where
> AllPlayers :: Obs [Int]
> Plus :: (Num a) => Obs a -> Obs a -> Obs a
> And :: Obs Bool -> Obs Bool -> Obs Bool
> Vote :: Obs String -> Obs Int -> Obs Bool
> *Map :: (Obs a -> Obs b) -> Obs [a] -> Obs [b]*
> -- and others
Here is the evaluator for Obs:
> evalObs :: Obs a -> Evaluator a
> evalObs (Konst a) = return $ pure a
> evalObs (Not a) = liftE not (evalObs a)
> evalObs (Plus a b) = liftE2 (+) (evalObs a) (evalObs b)
> evalObs (Minus a b) = liftE2 (-) (evalObs a) (evalObs b)
> evalObs (Time a b) = liftE2 (*) (evalObs a) (evalObs b)
> evalObs (And a b) = liftE2 (&&) (evalObs a) (evalObs b)
> evalObs (Or a b) = liftE2 (||) (evalObs a) (evalObs b)
> evalObs (Equ a b) = liftE2 (==) (evalObs a) (evalObs b)
> evalObs (If a b c) = liftE3 (if3) (evalObs a) (evalObs b) (evalObs c)
How you can see it is quite neat...
But how can I write the evaluator for Map?
Actually I have some half baked solution, 15 lines long that I don't
dare to show ;)
Actually compiling code excerpt is here:
http://hpaste.org/40897/map_contstructor_in_a_dsl
Thanks for your help.
Corentin
Below is some helper code:
type Evaluator a = StateT Game Comm a (Either Actions a)
-- | Combined lifters for Evaluator
liftE = liftM . liftA
liftE2 = liftM2 . liftA2
liftE3 = liftM3 . liftA3
instance Applicative (Either Actions) where
pure x = Right x
(Right f) <*> (Right x) = Right $ f x
(Right _) <*> (Left u) = Left u
(Left u) <*> (Right _) = Left u
(Left u) <*> (Left v) = Left $ u ++ v
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/haskell-cafe/attachments/20101026/f3798819/attachment-0001.html
More information about the Haskell-Cafe
mailing list