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
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 String where type2string _ = "Char []"
63 instance type2string () where type2string _ = ""
65 instance varName Int where varName _ = "vInt"
66 instance varName Long where varName _ = "vLong"
67 instance varName Bool where varName _ = "vBool"
68 instance varName Char where varName _ = "vChar"
69 instance varName Real where varName _ = "vFloat"
70 instance varName x where varName _ = ""
72 instance showType2 () where showType2 = SV "void "
73 instance showType2 Int where showType2 = SV "int "
74 instance showType2 Char where showType2 = SV "char "
75 instance showType2 Bool where showType2 = SV "bool "
76 instance showType2 a where showType2 = SV "word /* default */"
78 instance showType () where showType = c "void "
79 instance showType Int where showType = c "int "
80 instance showType Long where showType = c "long "
81 instance showType Char where showType = c "char "
82 instance showType Bool where showType = c "bool "
83 instance showType a where showType = c "word /* default */ "
85 instance typeSelector Int where typeSelector = c ".i"
86 instance typeSelector Char where typeSelector = c ".c"
87 instance typeSelector Bool where typeSelector = c ".b"
88 instance typeSelector a where typeSelector = c ".w"
90 read` :: Int (ReadWrite a) State` -> (a,State`) | dyn a
91 read` n Rd s = (fromJust (fromDyn (s.store !! n)), s)
92 read` n (Wrt a) s = (a,{s&store=updateAt n (toDyn a) s.store})
93 read` n (Updt f) s=:{store}
94 # obj = f (fromJust (fromDyn (store !! n)))
95 = (obj, {s & store = updateAt n (toDyn obj) store})
97 // ----- long ----- //
99 :: Long = L Int // 32 bit on Arduino
100 instance + Long where (+) (L x) (L y) = L (x + y)
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) = x == y
105 instance one Long where one = L one
106 instance zero Long where zero = L zero
109 class long v t :: (v t p) -> v Long Expr | isExpr p
110 instance long Code Int where
111 long x = embed (c "long" +.+ brac x)
112 instance long Code Long where
113 long x = embed (c "long" +.+ brac x)
114 instance long Eval Int where
115 long x = x >>== rtrn o L
116 instance long Eval Long where
119 // ----- tools ----- //
121 instance == DigitalPin where (==) x y = x === y
122 instance == AnalogPin where (==) x y = x === y
124 derive consName DigitalPin, AnalogPin, PinMode
125 derive consIndex DigitalPin, AnalogPin
127 tab =: toString (repeatn tabSize ' ')
130 instance toString () where toString _ = "()"