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
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
|
definition module uFPL
from StdGeneric import :: Bimap
from StdOverloaded import class +, class -, class *, class /, class ==, class <, class toString
from Data.Map import :: Map
from Data.Maybe import :: Maybe
from uFPL.C import :: CType, :: CExpr, :: CBody, :: CVar, :: CFun, :: CProg
:: RO = RO
:: RW = RW
:: UShared t rw =
{ sname :: String
, stype :: CType
, sinit :: t
, srepr :: Bimap t CExpr
, srw :: rw // to be able to check this in uFPL.Sim
}
:: Shares
= NoShares
| E.t rw: Shares (UShared t rw) Shares & Expr t
removeDupShares :: Shares -> Shares
sharesMap :: (A.t rw: (UShared t rw) -> a | Expr t) Shares -> [a]
class allShares t
where
allShares` :: t -> Shares
allShares :: t -> Shares
allShares x :== removeDupShares (allShares` x)
instance allShares [t] | allShares t
instance allShares (Expr t rw) | Expr t
instance allShares Trigger
instance allShares Rule
instance allShares NamedRule
class allTriggers t :: t -> [Trigger]
instance allTriggers [t] | allTriggers t
instance allTriggers Trigger
instance allTriggers Rule
instance allTriggers NamedRule
class Expr t | TC t where litExpr :: t -> CExpr
instance Expr Int
instance Expr Bool
instance Expr Char
:: Expr t rw
= ELit t
| EShared (UShared t rw)
| E.rwa rwb: (+.) infixl 6 (Expr t rwa) (Expr t rwb) & + t
| E.rwa rwb: (-.) infixl 6 (Expr t rwa) (Expr t rwb) & - t
| E.rwa rwb: (*.) infixl 7 (Expr t rwa) (Expr t rwb) & * t
| E.rwa rwb: (/.) infixl 7 (Expr t rwa) (Expr t rwb) & / t
| E.rwa rwb u: EEq (Bimap t Bool) (Expr u rwa) (Expr u rwb) & Expr, == u
| E.rwa rwb u: ELt (Bimap t Bool) (Expr u rwa) (Expr u rwb) & Expr, < u
| E.rwa rwb: EAnd (Bimap t Bool) (Expr Bool rwa) (Expr Bool rwb)
| E.rwa rwb: EOr (Bimap t Bool) (Expr Bool rwa) (Expr Bool rwb)
| E.rwa rwb rwc: EIf (Expr Bool rwa) (Expr t rwb) (Expr t rwc)
lit :: (t -> Expr t RO)
(?) infix 5 :: (Expr Bool rwa) (Expr t rwb, Expr t rwc) -> Expr t RO
(==.) infix 4 :: (Expr t rwa) (Expr t rwb) -> Expr Bool RO | Expr, == t
(<.) infix 4 :: (Expr t rwa) (Expr t rwb) -> Expr Bool RO | Expr, < t
(>.) infix 4 :: (Expr t rwa) (Expr t rwb) -> Expr Bool RO | Expr, < t
(&&.) infixr 3 :: (Expr Bool rwa) (Expr Bool rwb) -> Expr Bool RO
(||.) infixr 4 :: (Expr Bool rwa) (Expr Bool rwb) -> Expr Bool RO
:: Trigger
= E.t rw: Change (Expr t rw) & Expr t
| E.t rwa rwb: (?=) (Expr t rwa) (Expr t rwb) & Expr, == t
| (?&) infixr 3 Trigger Trigger
| (?|) infixr 4 Trigger Trigger
pressed :: (Expr Bool RO) -> Trigger
:: Rule
= E.t rw: (<#) infix 4 (Expr t RW) (Expr t rw) & Expr t
| E.rw: When (Expr Bool rw) [Rule]
| (>>>) infixr 2 Trigger [Rule]
| E.rwa rwb: SetCursor (Expr Int rwa, Expr Int rwb)
| E.t rw: Print (Expr t rw) & Expr, toString t
:: NamedRule = E.r: (:=:) infixr 1 String r & gen r CBody & run, allShares, allTriggers, TC r
class gen f t :: f -> t
class (:.) infixr 1 r :: Rule r -> [Rule]
instance :. Rule
instance :. [Rule]
class (|||) infixr 0 r :: NamedRule r -> [NamedRule]
instance ||| NamedRule
instance ||| [NamedRule]
instance gen (Expr t rw) CExpr | Expr t
instance gen (UShared t rw) CVar
instance gen Trigger CExpr
instance gen Rule CBody
instance gen [r] CBody | gen r CBody
instance gen NamedRule CFun
instance gen NamedRule CProg
instance gen [NamedRule] CProg
:: ShareState =
{ val :: Dynamic
, dirty :: Int
, subscriptions :: Int
}
:: Display =
{ size :: (Int, Int)
, cursor :: (Int, Int)
, text :: Map (Int, Int) Char
}
instance toString Display
:: State =
{ vars :: Map String ShareState
, display :: Display
}
display :: String Display -> Display
eval :: (Expr t rw) State -> Maybe t | Expr t
evalTrigger :: Trigger State -> Maybe (Bool, State)
class run r :: r -> State -> Maybe State
instance run [r] | run r
instance run Rule
instance run NamedRule
|
