1 definition module mTask
4 Pieter Koopman pieter@cs.ru.nl
5 Final version for TFP2016
7 -2: assignment =. suited for digital and analog input and output
11 move task-loop ti setup()
18 import iTasks._Framework.Generic
19 import iTasks._Framework.Task
21 from iTasks.API.Core.Types import :: Display
22 import gdynamic, gCons, GenEq, StdMisc, StdArray
24 import mTaskSerial, mTaskLCD
26 // =================== mTask ===================
29 // ----- dsl definition ----- //
32 = D0 | D1 | D2 | D3 | D4 | D5 |D6 | D7 | D8 | D9 | D10 | D11 | D12 | D13
33 :: AnalogPin = A0 | A1 | A2 | A3 | A4 | A5
34 :: PinMode = INPUT | OUTPUT | INPUT_PULLUP
35 :: Pin = Digital DigitalPin | Analog AnalogPin
38 class pin p | type, == p where
40 instance pin DigitalPin
41 instance pin AnalogPin
46 :: MTask = MTask Int // String
48 class isExpr a :: a -> Int
52 class isStmt a :: a -> Int
60 :: Main a = {main :: a}
62 unMain :: (Main x) -> x
65 lit :: t -> v t Expr | toCode t
66 (+.) infixl 6 :: (v t p) (v t q) -> v t Expr | type, +, zero t & isExpr p & isExpr q //& toExpr2 p & toExpr2 q
67 (-.) infixl 6 :: (v t p) (v t q) -> v t Expr | type, -, zero t & isExpr p & isExpr q //& toExpr2 p & toExpr2 q
68 (*.) infixl 7 :: (v t p) (v t q) -> v t Expr | type, *, zero, one t & isExpr p & isExpr q //& toExpr2 p & toExpr2 q
69 (/.) infixl 7 :: (v t p) (v t q) -> v t Expr | type, / t & isExpr p & isExpr q //& toExpr2 p & toExpr2 q
70 class boolExpr v where
71 (&.) infixr 3 :: (v Bool p) (v Bool q) -> v Bool Expr | isExpr p & isExpr q //& toExpr2 p & toExpr2 q
72 (|.) infixr 2 :: (v Bool p) (v Bool q) -> v Bool Expr | isExpr p & isExpr q //& toExpr2 p & toExpr2 q
73 Not :: (v Bool p) -> v Bool Expr | isExpr p //& toExpr2 p
74 (==.) infix 4 :: (v a p) (v a q) -> v Bool Expr | ==, toCode a & isExpr p & isExpr q //& toExpr2 p & toExpr2 q
75 (!=.) infix 4 :: (v a p) (v a q) -> v Bool Expr | ==, toCode a & isExpr p & isExpr q //& toExpr2 p & toExpr2 q
76 (<.) infix 4 :: (v a p) (v a q) -> v Bool Expr | <, Ord, toCode a & isExpr p & isExpr q //& toExpr2 p & toExpr2 q
77 (>.) infix 4 :: (v a p) (v a q) -> v Bool Expr | <, Ord, toCode a & isExpr p & isExpr q //& toExpr2 p & toExpr2 q
78 (<=.) infix 4 :: (v a p) (v a q) -> v Bool Expr | <, Ord, toCode a & isExpr p & isExpr q //& toExpr2 p & toExpr2 q
79 (>=.) infix 4 :: (v a p) (v a q) -> v Bool Expr | <, Ord, toCode a & isExpr p & isExpr q //& toExpr2 p & toExpr2 q
80 // using functional dependencies
81 class If v q r ~s where
82 If :: (v Bool p) (v t q) (v t r) -> v t s | isExpr p & type t
84 IF :: (v Bool p) (v t q) (v s r) -> v () Stmt | isExpr p
85 (?) infix 1 :: (v Bool p) (v t q) -> v () Stmt | isExpr p
87 var2 :: t ((v t Upd)->(Main (v c s))) -> (Main (v c s)) | type, toCode t
88 con2 :: t ((v t Expr) ->(Main (v c s))) -> (Main (v c s)) | type t
90 sds :: ((v t Upd)->In t (Main (v c s))) -> (Main (v c s)) | type, toCode t
91 con :: ((v t Expr) ->In t (Main (v c s))) -> (Main (v c s)) | type t
93 (>>=.) infixr 0 :: (v t p) ((v t Expr) -> (v u q)) -> (v u Stmt) | type t & type u
94 (:.) infixr 0 :: (v t p) (v u q) -> v u Stmt | type t & type u
96 (>>*.) infixl 1 :: (v t p) ((v t Expr) -> [Step v u]) -> v u Stmt | type t & type u
97 :: Step v t = E.p.q: Cond (v Bool q) (v t p) | E.p: Ever (v t p)
99 (=.) infixr 2 :: (v t Upd) (v t p) -> v t Expr | type t & isExpr p
101 fun :: ((t->v s Expr)->In (t->v s p) (Main (v u q))) -> Main (v u q) | type s
102 class mtask v a where
103 task :: (((v delay r) a->v MTask Expr)->In (a->v u p) (Main (v t q))) -> Main (v t q) | type t & type u & isExpr r & long v delay
105 lag :: (v delay r) (v t p) -> v MTask Expr | type t & long v delay
106 class setDelay v where
107 setDelay :: (v Long p) (v MTask Expr) -> (v MTask Expr) | isExpr p
108 class mtasks v a b where
109 tasks :: (((v delay r1) a->v MTask Expr, (v delay r2) b->v MTask Expr)->In (a->v t p, b->v u p) (Main (v s q))) -> Main (v s q) | type s & isExpr r1 & isExpr r2 & long v delay
111 output :: (v t p) -> v () Expr | type t & isExpr p
112 class noOp v where noOp :: v t p
114 class pinMode v where
115 pinmode :: p PinMode -> v () Expr | pin p
116 class digitalIO v where
117 digitalRead :: p -> v Bool Expr | pin, readPinD p
118 digitalWrite :: p (v Bool q) -> v Bool Expr | pin, writePinD p
119 class analogIO v where
120 analogRead :: AnalogPin -> v Int Expr
121 analogWrite :: AnalogPin (v Int p) -> v Int Expr
123 dIO :: p -> v Bool Upd | pin, readPinD p
125 aIO :: AnalogPin -> v Int Upd
127 delay :: (v Long p) -> (v Long Expr)
128 millis :: (v Long Expr)
130 class pio p t where pio :: p -> v t Upd | aIO v & dIO v
131 instance pio AnalogPin Int
132 instance pio AnalogPin Bool
133 instance pio DigitalPin Bool
135 int :: (v Int p) -> (v Int p)
136 bool :: (v Bool p) -> (v Bool p)
137 char :: (v Char p) -> (v Char p)
139 class type t | showType, dyn, toCode, ==, type2string, varName t
140 class type2string t :: t -> String
141 instance type2string Int
142 instance type2string Long
143 instance type2string Real
144 instance type2string Bool
145 instance type2string Char
146 instance type2string MTask
147 instance type2string DigitalPin
148 instance type2string AnalogPin
149 instance type2string String
150 instance type2string ()
151 class varName a :: a -> String
153 instance varName Long
154 instance varName Bool
155 instance varName Char
156 instance varName Real
159 class dsl t | arith, boolExpr, sds, assign, seq t
161 argType :: (((Code a p)->Code b q)->In ((Code a p)->Code b q) (Code c s)) -> a | type a
163 class argTypes t :: ((t->Code b Expr)->In (t->Code b2 q) (Main (Code c s))) -> t
164 instance argTypes (Code a p) | showType a
165 instance argTypes (Code a p, Code b q) | showType a & showType b
166 instance argTypes (Code a p, Code b q, Code c r) | showType a & showType b & showType c
168 resType :: ((t->Code b Expr)->In (t->Code b q) (Main (Code c s))) -> Code b q | showType b
170 var2Type :: (Code t p) -> Code t p | showType t
172 resType2 :: ((t->Code b Expr)->In (t->Code b q) (Main (Code c s))) -> SV b | showType2 b
175 instance toCode (SV t)
177 class showType2 t :: SV t
178 instance showType2 ()
179 instance showType2 Int
180 instance showType2 Char
181 instance showType2 Bool
184 class showType t | showType2 /*, type*/ t :: (Code t p)
186 instance showType Int
187 instance showType Long
188 instance showType Char
189 instance showType Bool
192 class typeSelector t | showType2, type t :: (Code t p)
193 instance typeSelector Int
194 instance typeSelector Char
195 instance typeSelector Bool
196 instance typeSelector a
198 :: In a b = In infix 0 a b
200 read` :: Int (ReadWrite a) State -> (a,State) | dyn a
202 // ----- code generation ----- //
205 instance boolExpr Code
206 instance If Code Stmt Stmt Stmt
207 instance If Code e Stmt Stmt
208 instance If Code Stmt e Stmt
209 instance If Code x y Expr
213 defCode :: ((Code t p) -> In t (Main (Code u q))) -> Main (Code u r) | type t
215 var :: String (ReadWrite (Code v q)) CODE -> CODE
220 codeSteps :: [Step Code t] -> Code u p
221 optBreak :: Mode -> Code u p
223 instance setDelay Code
224 instance mtask Code a | taskImp2 a & types a
225 instance mtasks Code a b | taskImp2 a & types a & taskImp2 b & types b
227 loopCode :: Int (Code a b) -> Code c d
229 class taskImp2 a :: Int a -> ((Code Long p) a->Code MTask Expr, a) | /*long Code delay &*/ isExpr p
231 instance taskImp2 (Code t p)
232 instance taskImp2 (Code a p, Code b q)
233 instance taskImp2 (Code a p, Code b q, Code c r)
234 instance taskImp2 (Code a p, Code b q, Code c r, Code d s)
236 class taskImp a :: Int a -> (Int a->Code MTask Expr, a)
238 instance taskImp (Code t p)
239 instance taskImp (Code a p, Code b q)
240 instance taskImp (Code a p, Code b q, Code c r)
241 instance taskImp (Code a p, Code b q, Code c r, Code d s)
243 tasksMain :: Int Int ((a->Code MTask Expr,b->Code MTask Expr) -> In (a->Code c d,b->Code e f) (Main (Code g h))) -> Main (Code i j) | taskImp a & types a & taskImp b & types b
246 instance types (Code a p) | typeSelector a & isExpr p
247 instance types (Code a p, Code b q) | typeSelector a & isExpr p & typeSelector b & isExpr q
248 instance types (Code a p, Code b q, Code c r) | typeSelector a & isExpr p & typeSelector b & isExpr q & typeSelector c & isExpr r
249 instance types (Code a p, Code b q, Code c r, Code d s) | typeSelector a & isExpr p & typeSelector b & isExpr q & typeSelector c & isExpr r & typeSelector d & isExpr s
251 codeMTaskBody :: (Code v w) (Code c d) -> Code e f
253 instance fun Code (Code t p) | type, showType t & isExpr p
254 instance fun Code (Code a p, Code b q) | showType a & showType b
255 instance fun Code (Code a p, Code b q, Code c r) | showType a & showType b & showType c
257 instance pinMode Code
258 instance digitalIO Code
261 instance analogIO Code
264 :: Code a p = C ((ReadWrite (Code a Expr)) CODE -> CODE)
276 , includes :: [String]
282 unC :: (Code a p) -> ((ReadWrite (Code a Expr)) CODE -> CODE)
284 :: Def = Var | Fun | Setup | Loop
285 :: Mode = /*MainMode |*/ NoReturn | Return String | SubExp | Assign String
287 setMode :: Mode -> Code a p
288 getMode :: (Mode -> Code a p) -> Code a p
289 embed :: (Code a p) -> Code a p
290 (+.+) infixl 5 :: (Code a p) (Code b q) -> Code c r
291 fresh :: (Int -> (Code a p)) -> (Code a p)
292 freshMTask :: (Int -> (Code a p)) -> (Code a p)
293 setCode :: Def -> (Code a p)
294 getCode :: (Def -> Code a p) -> (Code a p)
295 brac :: (Code a p) -> Code b q
296 funBody :: (Code a p) -> Code b q
297 codeOp2 :: (Code a p) String (Code b q) -> Code c r
298 include :: String -> Code a b
299 argList :: [a] -> String | toCode a
300 c :: a -> Code b p | toCode a
304 setBinds :: [String] -> Code a p
305 addBinds :: String -> Code a p
306 getBinds :: ([String] -> Code a p) -> (Code a p)
308 // ----- driver ----- //
310 compile :: (Main (Code a p)) -> [String]
311 mkset :: [a] -> [a] | Eq a
314 // ----- simulation ----- //
316 eval :: (Main (Eval t p)) -> [String] | toString t
318 { tasks :: [(Int, State->State)]
320 , dpins :: [(DigitalPin, Bool)]
321 , apins :: [(AnalogPin, Int)]
328 //:: TaskSim :== (Int, State->State)
329 :: Eval t p = E ((ReadWrite t) State -> (t, State))
330 toS2S :: (Eval t p) -> (State->State)
332 unEval :: (Eval t p) -> ((ReadWrite t) State -> (t, State))
334 :: ReadWrite t = Rd | Wrt t | Updt (t->t)
336 (>>==) infixl 1 :: (Eval a p) (a -> Eval b q) -> Eval b r
337 //(>>== ) (E f) g = E \r s. let (a, s2) = f Rd s; (E h) = g a in h Rd s2
339 rtrn :: t -> Eval t p
341 yield :: t (Eval s p) -> Eval t Expr
342 //yield a (E f) = E (\r s.(\(_,t).(a,t)) (f r s))
345 instance boolExpr Eval
346 instance If Eval p q Expr
350 defEval2 :: t ((Eval t p)->Main (Eval u q)) -> (Main (Eval u q)) | dyn t
353 defEval :: ((Eval t p)->In t (Main (Eval u q))) -> (Main (Eval u q)) | dyn t
354 instance fun Eval x | arg x
355 instance mtask Eval x | arg x
356 instance mtasks Eval x y | arg x & arg y
357 instance setDelay Eval
359 class toExpr v where toExpr :: (v t p) -> v t Expr
365 instance pinMode Eval
366 instance digitalIO Eval
367 instance analogIO Eval
370 class arg x :: x -> Int
372 instance arg (Eval t p) | type t
373 instance arg (Eval t p, Eval u q) | type t & type u
374 instance arg (Eval t p, Eval u q, Eval v r) | type t & type u & type v
375 instance arg (Eval t p, Eval u q, Eval v r, Eval w s) | type t & type u & type v
379 readPinA :: AnalogPin [(AnalogPin, Int)] -> Int
380 writePinA :: AnalogPin Int State -> State
382 class readPinD p :: p [(DigitalPin,Bool)] [(AnalogPin,Int)] -> Bool
383 instance readPinD DigitalPin
384 instance readPinD AnalogPin
386 class writePinD p :: p Bool State -> State
387 instance writePinD DigitalPin
388 instance writePinD AnalogPin
390 // ----- Interactive Simulation ----- //
392 derive class iTask DigitalPin, AnalogPin, Dyn, StateInterface, DisplayVar, Pin
394 simulate :: (Main (Eval a p)) -> Task ()
395 toView :: State -> StateInterface
396 mergeView :: State StateInterface -> State
398 { serialOut :: Display [String]
399 , analogPins :: [(AnalogPin, Int)]
400 , digitalPins :: [(DigitalPin, Bool)]
401 , var2iables :: [DisplayVar]
403 , taskCount :: Display Int
406 toDisplayVar :: Dyn -> DisplayVar
407 fromDisplayVar :: DisplayVar Dyn -> Dyn
413 | LCD16x2 String String
414 | DisplayVar [String]
416 step` :: State -> State
418 class stringQuotes t | type t :: (Code t p) -> Code t p
419 instance stringQuotes String
420 instance stringQuotes t
422 derive toGenDynamic (), MTask, DigitalPin, AnalogPin, Pin, [], Long //, Servo
423 derive fromGenDynamic (), MTask, DigitalPin, AnalogPin, Pin, [], Long //, Servo
427 // ----- long ----- //
429 :: Long = L Int // 32 bit on Arduino
439 class long v t :: (v t p) -> v Long Expr | isExpr p
440 instance long Code Int
441 instance long Code Long
442 instance long Eval Int
443 instance long Eval Long
445 // ----- tools ----- //
447 class toCode a :: a -> String
452 instance toCode String
453 instance toCode DigitalPin
454 instance toCode AnalogPin
455 derive consName DigitalPin, AnalogPin, PinMode
457 instance == DigitalPin
458 instance == AnalogPin
460 derive consIndex DigitalPin, AnalogPin
462 tab =: toString (repeatn tabSize ' ')