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