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 :: UserLED = LED1 | LED2 | LED3
  36 :: PinMode   = INPUT | OUTPUT | INPUT_PULLUP
  37 :: Pin     = Digital DigitalPin | Analog AnalogPin
  38
  39 class pin p | type, == p where
  40   pin :: p -> Pin
  41 instance pin DigitalPin
  42 instance pin AnalogPin
  43
  44 :: Upd   = Upd
  45 :: Expr  = Expr
  46 :: Stmt  = Stmt
  47 :: MTask = MTask Int // String
  48
  49 class isExpr a :: a -> Int
  50 instance isExpr Upd
  51 instance isExpr Expr
  52
  53 class isStmt a :: a -> Int
  54 instance isStmt Upd
  55 instance isStmt Expr
  56 instance isStmt Stmt
  57
  58 instance == MTask
  59
  60 :: Main a = {main :: a}
  61
  62 unMain :: (Main x) -> x
  63
  64 class arith v where
  65   lit :: t -> v t Expr | toCode t & toByteCode 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
  83 class IF v where
  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
  86 class var2 v where
  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
  89 class sds v where
  90   sds :: ((v t Upd)->In t (Main (v c s))) -> (Main (v c s)) | type, toByteCode, toCode t
  91   con :: ((v t Expr)  ->In t (Main (v c s))) -> (Main (v c s)) | type t
  92   pub :: (v t Upd) -> v t Expr | type t
  93 class seq v where
  94   (>>=.) infixr 0 :: (v t p) ((v t Expr) -> (v u q)) -> (v u Stmt) | type t & type u
  95   (:.) infixr 0 :: (v t p) (v u q) -> v u Stmt | type t & type u
  96 class step` v where
  97     (>>*.) infixl 1 :: (v t p) ((v t Expr) -> [Step v u]) -> v u Stmt | type t & type u
  98 :: Step v t = E.p.q: Cond (v Bool q) (v t p) | E.p: Ever (v t p)
  99 class assign v where
 100   (=.) infixr 2 :: (v t Upd) (v t p) -> v t Expr | type t & isExpr p
 101 class fun v t where
 102   fun :: ((t->v s Expr)->In (t->v s p) (Main (v u q))) -> Main (v u q) | type s
 103 class mtask v a where
 104   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 class lag v where
 106   lag :: (v delay r) (v t p) -> v MTask Expr | type t & long v delay
 107 class setDelay v where
 108   setDelay :: (v Long p) (v MTask Expr) -> (v MTask Expr) | isExpr p
 109 class mtasks v a b where
 110   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 class output v where
 112   output :: (v t p) -> v () Expr | type t & isExpr p
 113 class noOp v where noOp :: v t p
 114
 115 class pinMode v where
 116   pinmode :: p PinMode -> v () Expr | pin p
 117 class digitalIO v where
 118   digitalRead  :: p -> v Bool Expr | pin, readPinD p
 119   digitalWrite :: p (v Bool q) -> v Bool Expr | pin, writePinD  p
 120 class analogIO v where
 121   analogRead  :: AnalogPin -> v Int Expr
 122   analogWrite :: AnalogPin (v Int p) -> v Int Expr
 123 class dIO v where
 124     dIO :: p -> v Bool Upd | pin, readPinD p
 125 class aIO v where
 126     aIO :: AnalogPin -> v Int Upd
 127 class time v where
 128   delay  :: (v Long p) -> (v Long Expr)
 129   millis ::         (v Long Expr)
 130
 131 class userLed v where
 132         ledOn :: UserLED -> (v () Stmt)
 133         ledOff :: UserLED -> (v () Stmt)
 134
 135 class pio p t where pio :: p -> v t Upd | aIO v & dIO v
 136 instance pio AnalogPin Int
 137 instance pio AnalogPin Bool
 138 instance pio DigitalPin Bool
 139
 140 int :: (v Int p) -> (v Int p)
 141 bool :: (v Bool p) -> (v Bool p)
 142 char :: (v Char p) -> (v Char p)
 143
 144 class type t | showType, dyn, toCode, ==, type2string, varName t
 145 class type2string t :: t -> String
 146 instance type2string Int
 147 instance type2string Long
 148 instance type2string Real
 149 instance type2string Bool
 150 instance type2string Char
 151 instance type2string MTask
 152 instance type2string DigitalPin
 153 instance type2string AnalogPin
 154 instance type2string String
 155 instance type2string ()
 156 class varName a :: a -> String
 157 instance varName Int
 158 instance varName Long
 159 instance varName Bool
 160 instance varName Char
 161 instance varName Real
 162 instance varName x
 163
 164 class dsl t | arith, boolExpr, sds, assign, seq t
 165
 166 :: SV t = SV String
 167
 168 class showType2 t :: SV t
 169 instance showType2 ()
 170 instance showType2 Int
 171 instance showType2 Char
 172 instance showType2 Bool
 173 instance showType2 a
 174
 175 class showType t | showType2 /*, type*/ t :: (Code t p)
 176 instance showType ()
 177 instance showType Int
 178 instance showType Long
 179 instance showType Char
 180 instance showType Bool
 181 instance showType a
 182
 183 class typeSelector t | showType2, type t :: (Code t p)
 184 instance typeSelector Int
 185 instance typeSelector Char
 186 instance typeSelector Bool
 187 instance typeSelector a
 188
 189 :: In a b = In infix 0 a b
 190
 191 read` :: Int (ReadWrite a) State` -> (a,State`) | dyn a
 192
 193 // ----- long ----- //
 194
 195 :: Long = L Int // 32 bit on Arduino
 196 instance + Long
 197 instance - Long
 198 instance * Long
 199 instance / Long
 200 instance == Long
 201 instance one Long
 202 instance zero Long
 203
 204 class long v t :: (v t p) -> v Long Expr | isExpr p
 205 instance long Code Int
 206 instance long Code Long
 207 instance long Eval Int
 208 instance long Eval Long
 209
 210 // ----- tools ----- //
 211
 212 derive consName DigitalPin, AnalogPin, PinMode
 213
 214 instance == DigitalPin
 215 instance == AnalogPin
 216
 217 derive consIndex DigitalPin, AnalogPin
 218
 219 tab =: toString (repeatn tabSize ' ')
 220 tabSize :== 2
 221
 222 instance toString ()
 223
 224 a0 :== pio A0
 225 a1 :== pio A1
 226 a2 :== pio A2
 227 a3 :== pio A3
 228 a4 :== pio A4
 229 a5 :== pio A5
 230
 231 d0 :== pio D0
 232 d1 :== pio D1
 233 d2 :== pio D2
 234 d3 :== pio D3
 235 d4 :== pio D4
 236 d5 :== pio D5
 237 d6 :== pio D6
 238 d7 :== pio D7
 239 d8 :== pio D8
 240 d9 :== pio D9
 241 d10 :== pio D10
 242 d11 :== pio D11
 243 d12 :== pio D12
 244 d13 :== pio D13