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