Map Contstructor in a DSL

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
> 
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!

> {-# LANGUAGE NoMonomorphismRestriction,
>              FlexibleInstances,
>              GADTs,
>              StandaloneDeriving#-}
             
> import Control.Applicative
> import Control.Monad.State
> import Data.Typeable
> data Obs a where
>    ProposedBy :: Obs PlayerNumber 
>    RuleNumber :: Obs RuleNumber   
>    SelfNumber :: Obs RuleNumber   
>    Official   :: Obs Bool         
>    AllPlayers :: Obs [PlayerNumber]
>    Equ        :: (Eq a, Show a, Typeable a) => Obs a -> Obs a -> Obs Bool
>    Plus       :: (Num a) => Obs a -> Obs a -> Obs a
>    Time       :: (Num a) => Obs a -> Obs a -> Obs a
>    Minus      :: (Num a) => Obs a -> Obs a -> Obs a
>    And        :: Obs Bool -> Obs Bool -> Obs Bool
>    Or         :: Obs Bool -> Obs Bool -> Obs Bool
>    Not        :: Obs Bool -> Obs Bool
>    If         :: Obs Bool -> Obs a -> Obs a -> Obs a
>    Konst      :: a -> Obs a
>    Map        :: (Obs a -> Obs b) -> Obs [a] -> Obs [b]
>    Foldr      :: (Obs a -> Obs b -> Obs b) -> Obs b -> Obs [a] -> Obs b
>    Vote       :: Obs String -> Obs Int -> Obs Bool

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)
> --and others
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 ;)

Thanks for your help.
Corentin


Below is some helper code:

> type Evaluator a = State Game (Either Actions a)
> 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
        
Combined lifters for Evaluator

> liftE  = liftM  . liftA
> liftE2 = liftM2 . liftA2
> liftE3 = liftM3 . liftA3
> if3 a b c = if a then b else c
Stubbed out types:

> type PlayerNumber = Int
> type RuleNumber = Int
> type Game = Int
> type Comm = Int
> type Action = Int
> type Actions = [Action]