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