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 class namedsds v where
  94   namedsds :: ((v t Upd)->In (Named t String) (Main (v c s))) -> (Main (v c s)) | type, mTaskType, toCode t
  95 class sdspub v where
  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 retrn v where
 101   retrn :: v () Expr
 102 class step` v where
 103     (>>*.) infixl 1 :: (v t p) ((v t Expr) -> [Step v u]) -> v u Stmt | type t & type u
 104 :: Step v t = E.p.q: Cond (v Bool q) (v t p) | E.p: Ever (v t p)
 105 class assign v where
 106   (=.) infixr 2 :: (v t Upd) (v t p) -> v t Expr | type t & isExpr p
 107 class fun v t where
 108   fun :: ((t->v s Expr)->In (t->v s p) (Main (v u q))) -> Main (v u q) | type s
 109 class mtask v a where
 110   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
 111 class lag v where
 112   lag :: (v delay r) (v t p) -> v MTask Expr | type t & long v delay
 113 class setDelay v where
 114   setDelay :: (v Long p) (v MTask Expr) -> (v MTask Expr) | isExpr p
 115 class mtasks v a b where
 116   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
 117 class output v where
 118   output :: (v t p) -> v () Expr | type t & isExpr p
 119 class noOp v where noOp :: v t p
 120
 121 class pinMode v where
 122   pinmode :: p PinMode -> v () Expr | pin p
 123 class digitalIO v where
 124   digitalRead  :: p -> v Bool Expr | pin, readPinD p
 125   digitalWrite :: p (v Bool q) -> v Bool Expr | pin, writePinD  p
 126 class analogIO v where
 127   analogRead  :: AnalogPin -> v Int Expr
 128   analogWrite :: AnalogPin (v Int p) -> v Int Expr
 129 class dIO v where
 130     dIO :: p -> v Bool Upd | pin, readPinD p
 131 class aIO v where
 132     aIO :: AnalogPin -> v Int Upd
 133 class time v where
 134   delay  :: (v Long p) -> (v Long Expr)
 135   millis ::         (v Long Expr)
 136
 137 class userLed v where
 138   ledOn :: (v UserLED q) -> (v () Stmt)
 139   ledOff :: (v UserLED q) -> (v () Stmt)
 140
 141 class pio p t where pio :: p -> v t Upd | aIO v & dIO v
 142 instance pio AnalogPin Int
 143 instance pio AnalogPin Bool
 144 instance pio DigitalPin Bool
 145
 146 int :: (v Int p) -> (v Int p)
 147 bool :: (v Bool p) -> (v Bool p)
 148 char :: (v Char p) -> (v Char p)
 149
 150 class type t | showType, dyn, toCode, ==, type2string, varName t
 151 class type2string t :: t -> String
 152 instance type2string Int
 153 instance type2string Long
 154 instance type2string Real
 155 instance type2string Bool
 156 instance type2string Char
 157 instance type2string MTask
 158 instance type2string DigitalPin
 159 instance type2string AnalogPin
 160 instance type2string UserLED
 161 instance type2string String
 162 instance type2string ()
 163 class varName a :: a -> String
 164 instance varName Int
 165 instance varName Long
 166 instance varName Bool
 167 instance varName Char
 168 instance varName Real
 169 instance varName x
 170
 171 class dsl t | arith, boolExpr, sds, assign, seq t
 172
 173 :: SV t = SV String
 174
 175 class showType2 t :: SV t
 176 instance showType2 ()
 177 instance showType2 Int
 178 instance showType2 Char
 179 instance showType2 Bool
 180 instance showType2 a
 181
 182 class showType t | showType2 /*, type*/ t :: (Code t p)
 183 instance showType ()
 184 instance showType Int
 185 instance showType Long
 186 instance showType Char
 187 instance showType Bool
 188 instance showType a
 189
 190 class typeSelector t | showType2, type t :: (Code t p)
 191 instance typeSelector Int
 192 instance typeSelector Char
 193 instance typeSelector Bool
 194 instance typeSelector a
 195
 196 :: In a b = In infix 0 a b
 197 :: Named a b = Named infix 1 a b
 198
 199 read` :: Int (ReadWrite a) State` -> (a,State`) | dyn a
 200
 201 // ----- long ----- //
 202
 203 :: Long = L Int // 32 bit on Arduino
 204 instance + Long
 205 instance - Long
 206 instance * Long
 207 instance / Long
 208 instance == Long
 209 instance one Long
 210 instance zero Long
 211
 212 class long v t :: (v t p) -> v Long Expr | isExpr p
 213 instance long Code Int
 214 instance long Code Long
 215 instance long Eval Int
 216 instance long Eval Long
 217
 218 // ----- tools ----- //
 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