mTask.icl

   1 implementation 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 gdynamic, gCons, GenEq, StdMisc, StdArray
  19 import mTaskCode
  20 import mTaskSerial, mTaskLCD
  21
  22 instance pin DigitalPin where
  23         pin p = Digital p
  24
  25 instance pin AnalogPin  where
  26   pin p = Analog  p
  27
  28 instance isExpr Upd  where isExpr _ = 0
  29 instance isExpr Expr where isExpr _ = 1
  30
  31 instance isStmt Upd where isStmt _ = 10
  32 instance isStmt Expr   where isStmt _ = 11
  33 instance isStmt Stmt   where isStmt _ = 12
  34
  35 instance == MTask where (==) (MTask x) (MTask y) = x == y
  36
  37 unMain :: (Main x) -> x
  38 unMain m = m.main //{main=x} = x
  39
  40 instance pio AnalogPin Int where pio p = aIO p
  41 instance pio AnalogPin Bool where pio p = dIO p
  42 instance pio DigitalPin Bool where pio p = dIO p
  43
  44 int :: (v Int p) -> (v Int p)
  45 int x = x
  46 bool :: (v Bool p) -> (v Bool p)
  47 bool x = x
  48 char :: (v Char p) -> (v Char p)
  49 char x = x
  50
  51 instance type2string Int        where type2string _ = "int"
  52 instance type2string Long       where type2string _ = "long"
  53 instance type2string Real       where type2string _ = "float"
  54 instance type2string Bool       where type2string _ = "bool" //"boolean"
  55 instance type2string Char       where type2string _ = "char"
  56 instance type2string MTask      where type2string _ = "task"
  57 instance type2string DigitalPin where type2string _ = "int"
  58 instance type2string AnalogPin  where type2string _ = "int"
  59 instance type2string String     where type2string _ = "Char []"
  60 instance type2string ()         where type2string _ = ""
  61
  62 instance varName Int    where varName _ = "vInt"
  63 instance varName Long   where varName _ = "vLong"
  64 instance varName Bool   where varName _ = "vBool"
  65 instance varName Char   where varName _ = "vChar"
  66 instance varName Real   where varName _ = "vFloat"
  67 instance varName x      where varName _ = ""
  68
  69 instance showType2 ()   where showType2 = SV "void "
  70 instance showType2 Int  where showType2 = SV "int "
  71 instance showType2 Char where showType2 = SV "char "
  72 instance showType2 Bool where showType2 = SV "bool "
  73 instance showType2 a    where showType2 = SV "word /* default */"
  74
  75 instance showType ()   where showType = c "void "
  76 instance showType Int  where showType = c "int "
  77 instance showType Long where showType = c "long "
  78 instance showType Char where showType = c "char "
  79 instance showType Bool where showType = c "bool "
  80 instance showType a    where showType = c "word /* default */ "
  81
  82 instance typeSelector Int  where typeSelector = c ".i"
  83 instance typeSelector Char where typeSelector = c ".c"
  84 instance typeSelector Bool where typeSelector = c ".b"
  85 instance typeSelector a    where typeSelector = c ".w"
  86
  87 read` :: Int (ReadWrite a) State` -> (a,State`) | dyn a
  88 read` n Rd       s = (fromJust (fromDyn (s.store !! n)), s)
  89 read` n (Wrt a)  s = (a,{s&store=updateAt n (toDyn a) s.store})
  90 read` n (Updt f) s=:{store}
  91   # obj = f (fromJust (fromDyn (store !! n)))
  92   = (obj, {s & store = updateAt n (toDyn obj) store})
  93
  94 // ----- long ----- //
  95
  96 :: Long = L Int // 32 bit on Arduino
  97 instance + Long where (+) (L x) (L y) = L (x + y)
  98 instance - Long where (-) (L x) (L y) = L (x + y)
  99 instance * Long where (*) (L x) (L y) = L (x + y)
 100 instance / Long where (/) (L x) (L y) = L (x + y)
 101 instance == Long where (==) (L x) (L y) = x == y
 102 instance one Long where one = L one
 103 instance zero Long where zero = L zero
 104 now = lit (L 0)
 105
 106 class long v t :: (v t p) -> v Long Expr | isExpr p
 107 instance long Code Int where
 108   long x = embed (c "long" +.+ brac x)
 109 instance long Code Long where
 110   long x = embed (c "long" +.+ brac x)
 111 instance long Eval Int where
 112   long x = x >>== rtrn o L
 113 instance long Eval Long where
 114   long (E x) = E x
 115
 116 // ----- tools ----- //
 117
 118 instance == DigitalPin where (==) x y = x === y
 119 instance == AnalogPin   where (==) x y = x === y
 120
 121 derive consName DigitalPin, AnalogPin, PinMode
 122 derive consIndex DigitalPin, AnalogPin
 123
 124 tab =: toString (repeatn tabSize ' ')
 125 tabSize :== 2
 126
 127 instance toString () where toString _ = "()"