mTask.dcl

   1 definition module mTask
   2
   3 /*
   4     Pieter Koopman pieter@cs.ru.nl
   5     Final version for TFP2016
   6
   7     -2: assignment =. suited for digital and analog input and output
   8     -3: ad hoc tasks
   9
  10 todo:
  11         move task-loop ti setup()
  12         adhoc tasks
  13         task combinators
  14         imporove setp: >>*.
  15 */
  16
  17 import iTasks
  18
  19 import iTasks._Framework.Generic
  20 from iTasks._Framework.Task import :: Task
  21 import StdClass
  22 import gdynamic, gCons, GenEq, StdMisc, StdArray
  23
  24 import mTaskCode, mTaskSimulation, mTaskInterpret
  25 import mTaskSerial, mTaskLCD
  26
  27 // =================== mTask ===================
  28
  29
  30 // ----- dsl definition ----- //
  31
  32 :: DigitalPin
  33    = D0 | D1 | D2 | D3 | D4 | D5 |D6 | D7 | D8 | D9 | D10 | D11 | D12 | D13
  34 :: AnalogPin = A0 | A1 | A2 | A3 | A4 | A5
  35 :: PinMode   = INPUT | OUTPUT | INPUT_PULLUP
  36 :: Pin     = Digital DigitalPin | Analog AnalogPin
  37
  38 class pin p | type, == p where
  39   pin :: p -> Pin
  40 instance pin DigitalPin
  41 instance pin AnalogPin
  42
  43 :: Upd   = Upd
  44 :: Expr  = Expr
  45 :: Stmt  = Stmt
  46 :: MTask = MTask Int // String
  47
  48 class isExpr a :: a -> Int
  49 instance isExpr Upd
  50 instance isExpr Expr
  51
  52 class isStmt a :: a -> Int
  53 instance isStmt Upd
  54 instance isStmt Expr
  55 instance isStmt Stmt
  56
  57 instance == MTask
  58
  59 :: Main a = {main :: a}
  60
  61 unMain :: (Main x) -> x
  62
  63 class arith v where
  64   lit :: t -> v t Expr | toCode t & toByteCode t
  65   (+.) infixl 6 :: (v t p) (v t q) -> v t Expr | type, +, zero t & isExpr p & isExpr q //& toExpr2 p & toExpr2 q
  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 7 :: (v t p) (v t q) -> v t Expr | type, *, zero, one t & isExpr p & isExpr q //& toExpr2 p & toExpr2 q
  68   (/.) infixl 7 :: (v t p) (v t q) -> v t Expr | type, / t & isExpr p & isExpr q //& toExpr2 p & toExpr2 q
  69 class boolExpr v where
  70   (&.) infixr 3 :: (v Bool p) (v Bool q) -> v Bool Expr | isExpr p & isExpr q //& toExpr2 p & toExpr2 q
  71   (|.) infixr 2 :: (v Bool p) (v Bool q) -> v Bool Expr | isExpr p & isExpr q //& toExpr2 p & toExpr2 q
  72   Not           :: (v Bool p) -> v Bool Expr | isExpr p //& toExpr2 p
  73   (==.) infix 4 :: (v a p) (v a q) -> v Bool Expr | ==, toCode a & isExpr p & isExpr q //& toExpr2 p & toExpr2 q
  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 | <, Ord,  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 // using functional dependencies
  80 class If v q r ~s where
  81   If :: (v Bool p) (v t q) (v t r) -> v t s | isExpr p & type t
  82 class IF v where
  83   IF :: (v Bool p) (v t q) (v s r) -> v () Stmt | isExpr p
  84   (?) infix 1 :: (v Bool p) (v t q) -> v () Stmt | isExpr p
  85 class var2 v where
  86   var2 :: t ((v t Upd)->(Main (v c s))) -> (Main (v c s)) | type, toCode t
  87   con2 :: t ((v t Expr)  ->(Main (v c s))) -> (Main (v c s)) | type t
  88 class sds v where
  89   sds :: ((v t Upd)->In t (Main (v c s))) -> (Main (v c s)) | type, toByteCode, toCode t
  90   con :: ((v t Expr)  ->In t (Main (v c s))) -> (Main (v c s)) | type t
  91   pub :: (v t Upd) -> v t Expr | type t
  92 class seq v where
  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
  95 class step` v where
  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)
  98 class assign v where
  99   (=.) infixr 2 :: (v t Upd) (v t p) -> v t Expr | type t & isExpr p
 100 class fun v t where
 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
 104 class lag v where
 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
 110 class output v where
 111   output :: (v t p) -> v () Expr | type t & isExpr p
 112 class noOp v where noOp :: v t p
 113
 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
 122 class dIO v where
 123     dIO :: p -> v Bool Upd | pin, readPinD p
 124 class aIO v where
 125     aIO :: AnalogPin -> v Int Upd
 126 class time v where
 127   delay  :: (v Long p) -> (v Long Expr)
 128   millis ::         (v Long Expr)
 129
 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
 134
 135 int :: (v Int p) -> (v Int p)
 136 bool :: (v Bool p) -> (v Bool p)
 137 char :: (v Char p) -> (v Char p)
 138
 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
 152 instance varName Int
 153 instance varName Long
 154 instance varName Bool
 155 instance varName Char
 156 instance varName Real
 157 instance varName x
 158
 159 class dsl t | arith, boolExpr, sds, assign, seq t
 160
 161 :: SV t = SV String
 162
 163 class showType2 t :: SV t
 164 instance showType2 ()
 165 instance showType2 Int
 166 instance showType2 Char
 167 instance showType2 Bool
 168 instance showType2 a
 169
 170 class showType t | showType2 /*, type*/ t :: (Code t p)
 171 instance showType ()
 172 instance showType Int
 173 instance showType Long
 174 instance showType Char
 175 instance showType Bool
 176 instance showType a
 177
 178 class typeSelector t | showType2, type t :: (Code t p)
 179 instance typeSelector Int
 180 instance typeSelector Char
 181 instance typeSelector Bool
 182 instance typeSelector a
 183
 184 :: In a b = In infix 0 a b
 185
 186 read` :: Int (ReadWrite a) State` -> (a,State`) | dyn a
 187
 188 // ----- long ----- //
 189
 190 :: Long = L Int // 32 bit on Arduino
 191 instance + Long
 192 instance - Long
 193 instance * Long
 194 instance / Long
 195 instance == Long
 196 instance one Long
 197 instance zero Long
 198
 199 class long v t :: (v t p) -> v Long Expr | isExpr p
 200 instance long Code Int
 201 instance long Code Long
 202 instance long Eval Int
 203 instance long Eval Long
 204
 205 // ----- tools ----- //
 206
 207 derive consName DigitalPin, AnalogPin, PinMode
 208
 209 instance == DigitalPin
 210 instance == AnalogPin
 211
 212 derive consIndex DigitalPin, AnalogPin
 213
 214 tab =: toString (repeatn tabSize ' ')
 215 tabSize :== 2
 216
 217 instance toString ()
 218
 219 a0 :== pio A0
 220 a1 :== pio A1
 221 a2 :== pio A2
 222 a3 :== pio A3
 223 a4 :== pio A4
 224 a5 :== pio A5
 225
 226 d0 :== pio D0
 227 d1 :== pio D1
 228 d2 :== pio D2
 229 d3 :== pio D3
 230 d4 :== pio D4
 231 d5 :== pio D5
 232 d6 :== pio D6
 233 d7 :== pio D7
 234 d8 :== pio D8
 235 d9 :== pio D9
 236 d10 :== pio D10
 237 d11 :== pio D11
 238 d12 :== pio D12
 239 d13 :== pio D13