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