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