1 implementation 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 Generics.gdynamic
21 import GenEq, StdMisc, StdArray, GenBimap
23 import mTaskSerial, mTaskLCD
25 instance pin DigitalPin where
28 instance pin AnalogPin where
31 instance isExpr Upd where isExpr _ = 0
32 instance isExpr Expr where isExpr _ = 1
34 instance isStmt Upd where isStmt _ = 10
35 instance isStmt Expr where isStmt _ = 11
36 instance isStmt Stmt where isStmt _ = 12
38 instance == MTask where (==) (MTask x) (MTask y) = x == y
40 unMain :: (Main x) -> x
41 unMain m = m.main //{main=x} = x
43 instance pio AnalogPin Int where pio p = aIO p
44 instance pio AnalogPin Bool where pio p = dIO p
45 instance pio DigitalPin Bool where pio p = dIO p
47 int :: (v Int p) -> (v Int p)
49 bool :: (v Bool p) -> (v Bool p)
51 char :: (v Char p) -> (v Char p)
54 instance type2string Int where type2string _ = "int"
55 instance type2string Long where type2string _ = "long"
56 instance type2string Real where type2string _ = "float"
57 instance type2string Bool where type2string _ = "bool" //"boolean"
58 instance type2string Char where type2string _ = "char"
59 instance type2string MTask where type2string _ = "task"
60 instance type2string DigitalPin where type2string _ = "int"
61 instance type2string AnalogPin where type2string _ = "int"
62 instance type2string UserLED where type2string _ = "int"
63 instance type2string String where type2string _ = "Char []"
64 instance type2string () where type2string _ = ""
66 instance varName Int where varName _ = "vInt"
67 instance varName Long where varName _ = "vLong"
68 instance varName Bool where varName _ = "vBool"
69 instance varName Char where varName _ = "vChar"
70 instance varName Real where varName _ = "vFloat"
71 instance varName x where varName _ = ""
73 instance showType2 () where showType2 = SV "void "
74 instance showType2 Int where showType2 = SV "int "
75 instance showType2 Char where showType2 = SV "char "
76 instance showType2 Bool where showType2 = SV "bool "
77 instance showType2 a where showType2 = SV "word /* default */"
79 instance showType () where showType = c "void "
80 instance showType Int where showType = c "int "
81 instance showType Long where showType = c "long "
82 instance showType Char where showType = c "char "
83 instance showType Bool where showType = c "bool "
84 instance showType a where showType = c "word /* default */ "
86 instance typeSelector Int where typeSelector = c ".i"
87 instance typeSelector Char where typeSelector = c ".c"
88 instance typeSelector Bool where typeSelector = c ".b"
89 instance typeSelector a where typeSelector = c ".w"
91 read` :: Int (ReadWrite a) State` -> (a,State`) | dyn a
92 read` n Rd s = (fromJust (fromDyn (s.store !! n)), s)
93 read` n (Wrt a) s = (a,{s&store=updateAt n (toDyn a) s.store})
94 read` n (Updt f) s=:{store}
95 # obj = f (fromJust (fromDyn (store !! n)))
96 = (obj, {s & store = updateAt n (toDyn obj) store})
98 // ----- long ----- //
100 :: Long = L Int // 32 bit on Arduino
101 instance + Long where (+) (L x) (L y) = L (x + y)
102 instance - Long where (-) (L x) (L y) = L (x + y)
103 instance * Long where (*) (L x) (L y) = L (x + y)
104 instance / Long where (/) (L x) (L y) = L (x + y)
105 instance == Long where (==) (L x) (L y) = x == y
106 instance one Long where one = L one
107 instance zero Long where zero = L zero
110 class long v t :: (v t p) -> v Long Expr | isExpr p
111 instance long Code Int where
112 long x = embed (c "long" +.+ brac x)
113 instance long Code Long where
114 long x = embed (c "long" +.+ brac x)
115 instance long Eval Int where
116 long x = x >>== rtrn o L
117 instance long Eval Long where
120 // ----- tools ----- //
122 instance == DigitalPin where (==) x y = x === y
123 instance == AnalogPin where (==) x y = x === y
124 instance == UserLED where (==) x y = x === y
126 //derive class gCons UserLED, Long, Pin, Button, UserLED, AnalogPin, DigitalPin, PinMode
127 //derive class iTask UserLED, Long, Pin, Button, UserLED, AnalogPin, DigitalPin, PinMode
129 tab =: toString (repeatn tabSize ' ')
132 instance toString () where toString _ = "()"