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