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 mTaskSerial, mTaskLCD
  20
  21 instance toCode Pin where
  22     toCode (Digital p) = toCode p
  23     toCode (Analog  p) = toCode p
  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 instance toCode MTask where toCode (MTask x) = "Task " + toCode x
  40
  41 unMain :: (Main x) -> x
  42 unMain m = m.main //{main=x} = x
  43
  44 instance pio AnalogPin Int where pio p = aIO p
  45 instance pio AnalogPin Bool where pio p = dIO p
  46 instance pio DigitalPin Bool where pio p = dIO p
  47
  48 int :: (v Int p) -> (v Int p)
  49 int x = x
  50 bool :: (v Bool p) -> (v Bool p)
  51 bool x = x
  52 char :: (v Char p) -> (v Char p)
  53 char x = x
  54
  55 instance type2string Int        where type2string _ = "int"
  56 instance type2string Long       where type2string _ = "long"
  57 instance type2string Real       where type2string _ = "float"
  58 instance type2string Bool       where type2string _ = "bool" //"boolean"
  59 instance type2string Char       where type2string _ = "char"
  60 instance type2string MTask      where type2string _ = "task"
  61 instance type2string DigitalPin where type2string _ = "int"
  62 instance type2string AnalogPin  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 argType :: (((Code a p)->Code b q)->In ((Code a p)->Code b q) (Code c s)) -> a | type a
  74 argType f = undef
  75
  76 instance argTypes (Code a p) | showType a where argTypes f = showType
  77 instance argTypes (Code a p, Code b q) | showType a & showType b where argTypes f = (showType, showType)
  78 instance argTypes (Code a p, Code b q, Code c r) | showType a & showType b & showType c where argTypes f = (showType, showType, showType)
  79
  80 resType :: ((t->Code b Expr)->In (t->Code b q) (Main (Code c s))) -> Code b q | showType b
  81 resType f = showType
  82
  83 var2Type :: (Code t p) -> Code t p | showType t
  84 var2Type x = showType
  85
  86 resType2 :: ((t->Code b Expr)->In (t->Code b q) (Main (Code c s))) -> SV b | showType2 b
  87 resType2 f = showType2
  88
  89 instance toCode (SV t) where toCode (SV s) = s
  90
  91 instance showType2 ()   where showType2 = SV "void "
  92 instance showType2 Int  where showType2 = SV "int "
  93 instance showType2 Char where showType2 = SV "char "
  94 instance showType2 Bool where showType2 = SV "bool "
  95 instance showType2 a    where showType2 = SV "word /* default */"
  96
  97 instance showType ()   where showType = c "void "
  98 instance showType Int  where showType = c "int "
  99 instance showType Long where showType = c "long "
 100 instance showType Char where showType = c "char "
 101 instance showType Bool where showType = c "bool "
 102 instance showType a    where showType = c "word /* default */ "
 103
 104 instance typeSelector Int  where typeSelector = c ".i"
 105 instance typeSelector Char where typeSelector = c ".c"
 106 instance typeSelector Bool where typeSelector = c ".b"
 107 instance typeSelector a    where typeSelector = c ".w"
 108
 109 read` :: Int (ReadWrite a) State -> (a,State) | dyn a
 110 read` n Rd       s = (fromJust (fromDyn (s.store !! n)), s)
 111 read` n (Wrt a)  s = (a,{s&store=updateAt n (toDyn a) s.store})
 112 read` n (Updt f) s=:{store}
 113   # obj = f (fromJust (fromDyn (store !! n)))
 114   = (obj, {s & store = updateAt n (toDyn obj) store})
 115
 116 // ----- code generation ----- //
 117
 118 instance arith Code where
 119   lit a = embed (c a)
 120   (+.) x y = codeOp2 x " + " y
 121   (-.) x y = codeOp2 x " - " y
 122   (*.) x y = codeOp2 x " * " y
 123   (/.) x y = codeOp2 x " / " y
 124 instance boolExpr Code where
 125   (&.) x y  = codeOp2 x " && " y
 126   (|.) x y  = codeOp2 x " || " y
 127   Not x     = embed (brac (c "! " +.+ brac x))
 128   (==.) x y = codeOp2 x " == " y
 129   (!=.) x y = codeOp2 x " != " y
 130   (<.)  x y = codeOp2 x " < "  y
 131   (<=.) x y = codeOp2 x " <= " y
 132   (>.)  x y = codeOp2 x " > "  y
 133   (>=.) x y = codeOp2 x " >= " y
 134 instance If Code Stmt Stmt Stmt where If c t e = IfStmt c t e
 135 instance If Code e    Stmt Stmt where If c t e = IfStmt c t e
 136 instance If Code Stmt e    Stmt where If c t e = IfStmt c t e
 137 instance If Code x    y    Expr where If c t e = IfExpr c t e
 138 IfExpr b t e = embed (brac (b +.+ indent +.+ nl +.+ c " ? " +.+ t +.+ nl +.+ c " : " +.+ e +.+ unindent))
 139 IfStmt b t e =
 140   getMode \mode.
 141   let
 142     v = varName t
 143     newMode =
 144       case mode of
 145         Return s = Return s
 146         Assign v = Assign v
 147         _    = if (v == "") NoReturn (Assign v)
 148   in
 149     setMode SubExp +.+
 150     c "if " +.+ brac b +.+ c " {" +.+
 151       indent +.+ nl +.+ setMode newMode +.+ t +.+ unindent +.+ nl +.+ c "} else {" +.+
 152       indent +.+ nl +.+ setMode newMode +.+ e +.+ unindent +.+ nl +.+ c "}"
 153 instance IF Code where
 154   IF b t e  = IfStmt b t e
 155   (?) b t =
 156     getMode \mode.
 157     c "if " +.+ setMode SubExp +.+ brac b +.+ c " {" +.+
 158     indent +.+ nl +.+ setMode mode +.+ t +.+ c ";" +.+ unindent +.+ nl +.+ c "}"
 159
 160 instance sds Code where
 161   sds f = // defCode f
 162    {main = fresh \n.
 163     let name = "sds"+toCode n
 164         (v In body) = f (C (var name))
 165     in setCode Var +.+ c (type2string v + " " + name + " = " + toCode v +
 166        ";\n") +.+ setCode Setup +.+ unMain body}
 167   con f = defCode f
 168
 169 defCode :: ((Code t p) -> In t (Main (Code u q))) -> Main (Code u r) | type t
 170 defCode f =
 171   {main = fresh \n.
 172     let name = "sds"+toCode n
 173         (v In body) = f (C (var name))
 174     in  setCode Var +.+ c (type2string v + " " + name + " = " + toCode v +
 175         ";\n") +.+ setCode Setup +.+ unMain body}
 176
 177 var :: String (ReadWrite (Code v q)) CODE -> CODE
 178 var sds Rd      s = unC (embed (c sds)) Rd s
 179 var sds (Wrt v) s = unC (embed (c ("(" + sds + " = ") +.+ v +.+ c ")")) Rd s
 180
 181 instance assign Code where
 182   (=.) (C v) e = embed (setMode SubExp +.+ C \rw c.v (Wrt (toExpr e)) c)
 183 instance seq Code where
 184   (>>=.) x f =
 185     getMode \mode. fresh \n. let v = "b" + toCode n in
 186     addBinds v +.+ var2Type x +.+ c (v + ";") +.+ nl +.+
 187     setMode (Assign v) +.+ x +.+ nl +.+ setMode mode +.+ f (embed (c v))
 188   (:.) x y = getMode \mode. setMode NoReturn +.+ embed x +.+ nl +.+ setMode mode +.+ y
 189 instance step` Code where
 190     (>>*.) x f =
 191         getMode \mode. fresh \n.
 192             let v = "s" + toCode n in
 193             c "while(true) {" +.+ indent +.+ nl +.+
 194             var2Type x +.+ c (v + ";") +.+ nl +.+
 195             setMode (Assign v) +.+ x +.+ nl +.+
 196             setMode mode +.+ codeSteps (f (c v)) +.+
 197             unindent +.+ nl +.+ c "}"
 198 codeSteps :: [Step Code t] -> Code u p
 199 codeSteps [] = C \rw c.c
 200 codeSteps [Cond b e:x] =
 201     getMode \mode. setMode SubExp +.+
 202     c "if (" +.+ b +.+ c ") {" +.+ indent +.+ nl +.+
 203     setMode mode +.+ e +.+
 204     optBreak mode +.+ unindent +.+ nl +.+ c "}" +.+ nl +.+ setMode mode +.+ codeSteps x
 205 codeSteps [Ever e:x] =
 206     getMode \mode. e +.+ optBreak mode
 207
 208 optBreak :: Mode -> Code u p
 209 optBreak mode =
 210     case mode of
 211         Return s    = C \rw c.c
 212         _           = nl +.+ c "break;"
 213
 214 instance setDelay Code where
 215   setDelay d t = embed (c "setDelay" +.+ brac (t +.+ c ", " +.+ d))
 216 instance mtask Code a | taskImp2 a & types a where
 217   task f =
 218    {main = freshMTask \n.
 219    let (app, a)  = taskImp2 n types
 220        (b In main) = f (\d a.app (long d) a)
 221    in codeMTaskBody (loopCode n (b a)) (unMain main)}
 222 instance mtasks Code a b | taskImp2 a & types a  & taskImp2 b & types b  where
 223   tasks f =
 224     {main =
 225             freshMTask \t1.
 226             freshMTask \t2.
 227             let (app1, a1) = taskImp2 t1 types
 228                 (app2, a2) = taskImp2 t2 types
 229                 ((b1, b2) In main) = f ((\d a.app1 (long d) a),(\d a.app2 (long d) a))
 230             in codeMTaskBody (loopCode t2 (b2 a2)) (codeMTaskBody (loopCode t1 (b1 a1)) (unMain main))}
 231 loopCode :: Int (Code a b) -> Code c d
 232 loopCode n b =
 233   nl +.+ c "case " +.+ c n +.+ c ": {" +.+ indent +.+ nl +.+
 234   setMode NoReturn +.+ b +.+ nl +.+ c "break;" +.+
 235   unindent +.+ nl +.+ c "} "
 236
 237 class taskImp2 a :: Int a -> ((Code Long p) a->Code MTask Expr, a) | /*long Code delay &*/ isExpr p
 238 instance taskImp2 () where
 239   taskImp2 n () = (app, ())
 240   where app d a = setBinds [] +.+ embed (c "newTask(" +.+ c n +.+ c ", " +.+ d +.+ c ")")
 241 instance taskImp2 (Code t p) where
 242   taskImp2 n type1 = (app, ta)
 243     where
 244       n0 = "t0p->a[0]"
 245       ta = c n0 +.+ type1
 246       app d a =
 247         setBinds [n0] +.+ embed (c "newTask(" +.+
 248           c n +.+ c ", " +.+
 249           d +.+ c ", " +.+
 250           a +.+ c ")")
 251 instance taskImp2 (Code a p, Code b q) where
 252   taskImp2 n (type1, type2) = (app, (ta1, ta2)) where
 253     n0 = "t0p->a[0]"
 254     n1 = "t0p->a[1]"
 255     ta1 = c n0 +.+ type1
 256     ta2 = c n1 +.+ type2
 257     app d (a1, a2) =
 258             setBinds [n0,n1] +.+ embed (c "newTask(" +.+ c n +.+ c ", " +.+ long d +.+
 259             c ", " +.+ a1 +.+ c ", " +.+ a2 +.+ c ")")
 260 instance taskImp2 (Code a p, Code b q, Code c r) where
 261   taskImp2 n (type1, type2, type3) = (app, (ta1, ta2, ta3))
 262     where
 263       n0 = "t0p->a[0]"
 264       n1 = "t0p->a[1]"
 265       n2 = "t0p->a[2]"
 266       ta1 = c n0 +.+ type1
 267       ta2 = c n1 +.+ type2
 268       ta3 = c n2 +.+ type3
 269       app d (a1, a2, a3) =
 270         setBinds [n0,n1,n2] +.+ embed (c "newTask(" +.+
 271           c n +.+ c ", " +.+
 272           d  +.+ c ", " +.+
 273           a1 +.+ c ", " +.+
 274           a2 +.+ c ", " +.+
 275           a3 +.+ c ", 0)")
 276 instance taskImp2 (Code a p, Code b q, Code c r, Code d s) where
 277   taskImp2 n (type1, type2, type3, type4) = (app, (ta1, ta2, ta3, ta4))
 278     where
 279       n0 = "t0p->a[0]"
 280       n1 = "t0p->a[1]"
 281       n2 = "t0p->a[2]"
 282       n3 = "t0p->a[3]"
 283       ta1 = c n0 +.+ type1
 284       ta2 = c n1 +.+ type2
 285       ta3 = c n2 +.+ type3
 286       ta4 = c n3 +.+ type4
 287       app d (a1, a2, a3, a4) =
 288         setBinds [n0,n1,n2,n3] +.+ embed (c "newTask(" +.+
 289           c n +.+ c ", " +.+
 290           d  +.+ c ", " +.+
 291           a1 +.+ c ", " +.+
 292           a2 +.+ c ", " +.+
 293           a3 +.+ c ", " +.+
 294           a4 +.+ c ")")
 295
 296 class taskImp a :: Int a -> (Int a->Code MTask Expr, a)
 297 instance taskImp () where
 298   taskImp n () = (app, ())
 299     where app i a = embed (c "newTask(" +.+ c n +.+ c ", " +.+ c i +.+ c ")")
 300 instance taskImp (Code t p) where
 301   taskImp n type1 = (app, ta)
 302     where
 303       ta = c "t0p->a[0]" +.+ type1
 304       app i a =
 305         embed (c "newTask(" +.+
 306           c n +.+ c ", " +.+
 307           c i +.+ c ", " +.+
 308           a +.+ c ")")
 309 instance taskImp (Code a p, Code b q) where
 310   taskImp n (type1, type2) = (app, (ta1, ta2)) where
 311           ta1 = c "t0p->a[0]" +.+ type1
 312           ta2 = c "t0p->a[1]" +.+ type2
 313           app i (a1, a2) =
 314             embed (c "newTask(" +.+ c n +.+ c ", " +.+  c i +.+
 315             c ", " +.+ a1 +.+ c ", " +.+ a2 +.+ c ")")
 316 instance taskImp (Code a p, Code b q, Code c r) where
 317   taskImp n (type1, type2, type3) = (app, (ta1, ta2, ta3))
 318     where
 319       ta1 = c "t0p->a[0]" +.+ type1
 320       ta2 = c "t0p->a[1]" +.+ type2
 321       ta3 = c "t0p->a[2]" +.+ type3
 322       app i (a1, a2, a3) =
 323         embed (c "newTask(" +.+
 324           c n +.+ c ", " +.+
 325           c i +.+ c ", " +.+
 326           a1 +.+ c ", " +.+
 327           a2 +.+ c ", " +.+
 328           a3 +.+ c ")")
 329 instance taskImp (Code a p, Code b q, Code c r, Code d s) where
 330   taskImp n (type1, type2, type3, type4) = (app, (ta1, ta2, ta3, ta4))
 331     where
 332       ta1 = c "t0p->a[0]" +.+ type1
 333       ta2 = c "t0p->a[1]" +.+ type2
 334       ta3 = c "t0p->a[2]" +.+ type3
 335       ta4 = c "t0p->a[3]" +.+ type4
 336       app i (a1, a2, a3, a4) =
 337         embed (c "newTask(" +.+
 338           c n +.+ c ", " +.+
 339           c i +.+ c ", " +.+
 340           a1 +.+ c ", " +.+
 341           a2 +.+ c ", " +.+
 342           a3 +.+ c ", " +.+
 343           a4 +.+ c ")")
 344
 345 tasksMain :: Int Int ((a->Code MTask Expr,b->Code MTask Expr) -> In (a->Code c d,b->Code e f) (Main (Code g h))) -> Main (Code i j) | taskImp a & types a & taskImp b & types b
 346 tasksMain i j f =
 347     { main =
 348       freshMTask \n. freshMTask \m.
 349         let
 350           (app1, a1) = taskImp n types
 351           (app2, a2) = taskImp m types
 352           ((b1, b2) In {main = e}) = f (app1 i, app2 j)
 353         in
 354           codeMTaskBody (loopCode n (b1 a1) +.+ setMode NoReturn +.+ loopCode m (b2 a2)) e
 355     }
 356 class types a :: a
 357 instance types () where types = ()
 358 instance types (Code a p) | typeSelector a & isExpr p
 359   where types = typeSelector
 360 instance types (Code a p, Code b q) | typeSelector a & isExpr p & typeSelector b & isExpr q
 361   where types = (typeSelector, typeSelector)
 362 instance types (Code a p, Code b q, Code c r) | typeSelector a & isExpr p & typeSelector b & isExpr q & typeSelector c & isExpr r
 363   where types = (typeSelector, typeSelector, typeSelector)
 364 instance types (Code a p, Code b q, Code c r, Code d s) | typeSelector a & isExpr p & typeSelector b & isExpr q & typeSelector c & isExpr r & typeSelector d & isExpr s
 365   where types = (typeSelector, typeSelector, typeSelector, typeSelector)
 366
 367 codeMTaskBody :: (Code v w) (Code c d) -> Code e f
 368 codeMTaskBody loop e =
 369   getMode \mode.
 370     setMode NoReturn +.+
 371     setCode Loop +.+ loop +.+
 372     setMode mode +.+ setCode Setup +.+ embed e
 373 instance fun Code () where
 374   fun f  =
 375    {main = getMode \mode. fresh \n.
 376         let fname = c ("f" + toCode n)
 377         (g In {main=e}) = f (\x.embed (fname +.+ c " ()"))
 378     in setCode Fun +.+ c "\n" +.+ resType f +.+ c " " +.+ fname +.+ c " () " +.+
 379        funBody (setMode (Return (toCode (resType2 f))) +.+ setBinds [] +.+ g ()) +.+ setCode Setup +.+ setMode mode +.+ e
 380    }
 381 instance fun Code (Code t p) | type, showType t & isExpr p  where
 382   fun f  =
 383     {main =
 384       getMode \mode. fresh \n.
 385         let fname = c ("f" + toCode n)
 386             aname = "a" + toCode n
 387             (g In {main=e}) = f (\x.embed (fname +.+ c " " +.+ brac x))
 388         in  setCode Fun +.+ c "\n" +.+ resType f +.+ c " " +.+ fname +.+ c " " +.+
 389           brac (argTypes f +.+ c (" " + aname)) +.+
 390           funBody (setMode (Return (toCode (resType2 f))) +.+ setBinds [aname] +.+ g (embed (c aname))) +.+ setCode Setup +.+ setMode mode +.+ e
 391     }
 392 instance fun Code (Code a p, Code b q) | showType a & showType b where
 393   fun f =
 394          {main =
 395           getMode \mode. fresh \n.
 396           let fname = c ("f" + toCode n + " ")
 397               aname = "a" + toCode n //+ " "
 398               bname = "b" + toCode n //+ " "
 399               (atype, btype) = argTypes f
 400               (g In main)
 401                = f (\(x,y).embed (fname +.+ codeOp2 x ", " y))
 402           in setCode Fun +.+ nl +.+ resType f +.+ fname +.+
 403              codeOp2 (atype +.+ c aname) ", " (btype +.+ c bname) +.+
 404              funBody (setMode (Return (toCode (resType2 f))) +.+
 405              setBinds [aname,bname] +.+ g (embed (c aname), embed (c bname))) +.+
 406              setCode Setup +.+ setMode mode +.+ unMain main
 407          }
 408 instance fun Code (Code a p, Code b q, Code c r) | showType a & showType b & showType c where
 409   fun f  =
 410     {main =
 411       getMode \mode. fresh \n.
 412         let fname = c ("f" + toCode n)
 413             aname = "a" + toCode n
 414             bname = "b" + toCode n
 415             cname = "c" + toCode n
 416             (atype,btype,ctype) = argTypes f
 417             (g In {main=e}) = f (\(x,y,z).embed (fname +.+ c " " +.+ brac (x +.+ c ", " +.+ y +.+ c ", " +.+ z)))
 418         in setCode Fun +.+ c "\n" +.+ resType f +.+ c " " +.+ fname +.+ c " " +.+
 419            brac (atype +.+ c (" " + aname + ", ") +.+ btype +.+ c (" " + bname + ", ") +.+ ctype +.+ c (" " + cname)) +.+
 420            funBody (setMode (Return (toCode (resType2 f))) +.+
 421            setBinds [aname,bname,cname] +.+ g (embed (c aname), embed (c bname), embed (c cname))) +.+ setCode Setup +.+ setMode mode +.+ e
 422     }
 423 instance output Code where
 424   output x = embed (c "Serial.println(" +.+ x +.+ c ")")
 425 instance pinMode Code where
 426   pinmode p m = embed (c ("pinMode(" + toCode p + ", " + consName{|*|} m + ")"))
 427 instance digitalIO Code where
 428   digitalRead p = embed (c ("digitalRead(" + toCode p + ")"))
 429   digitalWrite p b = embed (c ("digitalWrite(" + toCode p + ", ") +.+ b +.+ c ")")
 430 instance dIO Code where
 431   dIO p = C (ioc p) where
 432     ioc :: p (ReadWrite (Code t q)) CODE -> CODE | pin, readPinD p
 433     ioc p Rd   s = f Rd s where (C f) = embed (c ("digitalRead(" + toCode p + ")"))
 434     ioc p (Wrt v) s = f Rd s where (C f) = embed (c ("pWrite(" + toCode p + ", ") +.+ v +.+ c ")")
 435 instance aIO Code where
 436   aIO p = C (ioc p)  where
 437     ioc :: p (ReadWrite (Code t q)) CODE -> CODE | pin p
 438     ioc p Rd      s = unC (embed (c ("analogRead(" + toCode p + ")"))) Rd s
 439     ioc p (Wrt v) s = unC (embed (c ("pWrite(" + toCode p + ", ") +.+ v +.+ c ")")) Rd s
 440 instance analogIO Code where
 441   analogRead p = embed (c ("analogRead(" + toCode p + ")"))
 442   analogWrite p b = embed (c ("analogWrite(" + toCode p + ", ") +.+ b +.+ c ")")
 443 instance noOp Code where noOp = C \rw c.c
 444
 445 :: Code a p = C ((ReadWrite (Code a Expr)) CODE -> CODE)
 446 :: CODE =
 447   { fresh       :: Int
 448   , freshMTask :: Int
 449   , funs        :: [String]
 450   , ifuns                       :: Int
 451   , vars          :: [String]
 452   , ivars                       :: Int
 453   , setup                       :: [String]
 454   , isetup        :: Int
 455   , loop          :: [String]
 456   , iloop                       :: Int
 457   , includes  :: [String]
 458   , def           :: Def
 459   , mode          :: Mode
 460   , binds                       :: [String]
 461   }
 462
 463 unC :: (Code a p) -> ((ReadWrite (Code a Expr)) CODE -> CODE)
 464 unC (C f) = f
 465
 466 :: Def = Var | Fun | Setup | Loop
 467 :: Mode = /*MainMode |*/ NoReturn | Return String | SubExp | Assign String
 468
 469 setMode :: Mode -> Code a p
 470 setMode m = C \rw c.{c & mode = m}
 471
 472 getMode :: (Mode -> Code a p) -> Code a p
 473 getMode f = C \rw c.unC (f c.mode) rw c
 474
 475 embed :: (Code a p) -> Code a p
 476 embed e =
 477   getMode \m. case m of
 478     NoReturn  = setMode SubExp +.+ e +.+ c ";"
 479     Return "void" = setMode SubExp +.+ e +.+ c ";"
 480     Return t  = c "return " +.+ setMode SubExp +.+ e +.+ c ";"
 481     Assign s  = c (s + " = ") +.+ setMode SubExp +.+ e +.+ c ";"
 482     SubExp    = e
 483     _       = abort "\n\nembed: unknown mode.\n"
 484
 485 (+.+) infixl 5 :: (Code a p) (Code b q) -> Code c r
 486 (+.+) (C f) (C g) = C \rw c.g Rd (f Rd c)
 487
 488 fresh :: (Int -> (Code a p)) -> (Code a p)
 489 fresh f = C \rw c.unC (f c.fresh) rw {c & fresh = c.fresh + 1}
 490
 491 freshMTask :: (Int -> (Code a p)) -> (Code a p)
 492 freshMTask f = C \rw c.unC (f c.freshMTask) rw {c & freshMTask = c.freshMTask + 1}
 493
 494 setCode :: Def -> (Code a p)
 495 setCode d = C \rw c.{c & def = d}
 496
 497 getCode :: (Def -> Code a p) -> (Code a p)
 498 getCode f = C \rw c.unC (f c.def) rw c
 499
 500 brac :: (Code a p) -> Code b q
 501 brac e = c "(" +.+ e +.+ c ")"
 502
 503 funBody :: (Code a p) -> Code b q
 504 funBody e = c "{" +.+ indent +.+ nl +.+ e +.+ unindent +.+ nl +.+ c "}" +.+ nl
 505
 506 codeOp2 :: (Code a p) String (Code b q) -> Code c r
 507 codeOp2 x n y = embed (brac (x +.+ c n +.+ y))
 508
 509 include :: String -> Code a b
 510 include lib = C \rw c.{c & includes = [lib:c.includes]}
 511
 512 argList :: [a] -> String | toCode a
 513 argList [a] = toCode a
 514 argList [a:x] = toCode a + "," + argList x
 515 argList [] = ""
 516
 517 c :: a -> Code b p | toCode a
 518 c a = C \rw c.case c.def of
 519     Fun   = {c & funs = [toCode a: c.funs]}
 520     Var   = {c & vars = [toCode a: c.vars]}
 521     Setup   = {c & setup = [toCode a: c.setup]}
 522     Loop  = {c & loop = [toCode a: c.loop]}
 523
 524 indent :: Code a p
 525 indent =
 526   C \rw c.case c.def of
 527     Fun   = {c & ifuns = inc c.ifuns}
 528     Var   = {c & ivars = inc c.ivars}
 529     Setup   = {c & isetup = inc c.isetup}
 530     Loop  = {c & iloop = inc c.iloop}
 531
 532 unindent :: Code a p
 533 unindent =
 534   C \rw c.case c.def of
 535     Fun   = {c & ifuns = dec c.ifuns}
 536     Var   = {c & ivars = dec c.ivars}
 537     Setup   = {c & isetup = dec c.isetup}
 538     Loop  = {c & iloop = dec c.iloop}
 539 where
 540   dec n | n > 1
 541     = n - 1
 542     = 0
 543
 544 nl :: Code a p
 545 nl =
 546   C \rw c.case c.def of
 547     Fun   = {c & funs = [str c.ifuns: c.funs]}
 548     Var   = {c & vars = [str c.ivars: c.vars]}
 549     Setup   = {c & setup = [str c.isetup: c.setup]}
 550     Loop  = {c & loop = [str c.iloop: c.loop]}
 551 where
 552   str n = toString ['\n':repeatn (tabSize * n) ' ']
 553
 554 setBinds :: [String] -> Code a p
 555 setBinds list = C \rw c.{c & binds = list}
 556
 557 addBinds :: String -> Code a p
 558 addBinds name = C \rw c.{c & binds = [name:c.binds]}
 559
 560 getBinds :: ([String] -> Code a p) -> (Code a p)
 561 getBinds f = C \rw c.unC (f c.binds) rw c
 562
 563 // ----- driver ----- //
 564
 565 compile :: (Main (Code a p)) -> [String]
 566 compile {main=(C f)} =
 567   ["/*\n"
 568   ,"  Generated code for Arduino\n"
 569   ,"  Pieter Koopman, pieter@cs.ru.nl\n"
 570   ,"*/\n"
 571   ,"\n"
 572   ,"#define MAX_ARGS 4\n"
 573   ,"#define MAX_TASKS 20\n"
 574   ,"#define MAX_TASK_NO MAX_TASKS - 1\n"
 575   ,"#define NEXT_TASK(n) ((n) == MAX_TASK_NO ? 0 : (n) + 1)\n"
 576   ,"\n"
 577   ,"typedef union Arg {\n"
 578   ,"  int i;\n"
 579   ,"  bool b;\n"
 580   ,"  char c;\n"
 581 //  ,"  float f;\n" // requires 4 bytes
 582   ,"  word w;\n"
 583   ,"} ARG;\n"
 584   ,"\n"
 585   ,"typedef struct Task {\n"
 586   ,"  byte id;\n"
 587   ,"  long wait;\n"
 588   ,"  ARG a[MAX_ARGS];\n"
 589   ,"} TASK;\n"
 590   ,"\n"
 591   ] ++
 592   foldr (\lib c.["#include <":lib:".h>\n":c]) [] (mkset c.includes) ++
 593   ["\n// --- variables ---\n"
 594   ,"TASK tasks[MAX_TASKS];\n"
 595   ,"byte t0 = 0, tc = 0, tn = 0;\n"
 596   ,"long delta;\n"
 597   ,"\n"
 598   ,"int vInt;\n"
 599   ,"bool vBool;\n"
 600   ,"char vChar;\n"
 601   ,"float vFloat;\n"
 602   ,"unsigned long time = 0;\n"
 603   :reverse c.vars
 604   ] ++
 605   ["\n// --- functions ---\n"
 606   ,"byte newTask(byte id, long wait, word a0 = 0, word a1 = 0, word a2 = 0, word a3 = 0) {\n"
 607   ,"  TASK *tnp = &tasks[tn];\n"
 608   ,"  tnp->id = id;\n"
 609   ,"  tnp->wait = wait;\n"
 610   ,"  tnp->a[0].w = a0;\n"
 611   ,"  tnp->a[1].w = a1;\n"
 612   ,"  tnp->a[2].w = a2;\n"
 613   ,"  tnp->a[3].w = a3;\n"
 614   ,"  byte r = tn;\n"
 615   ,"  tn = NEXT_TASK(tn);\n"
 616   ,"  return r;\n"
 617   ,"}\n"
 618   ,"\n"
 619   ,"byte setDelay(byte t, long d) {\n"
 620   ,"  tasks[t].wait = d;\n"
 621   ,"  return t;\n"
 622   ,"}\n"
 623   ,"boolean pressed(int b) {\n"
 624   ,"  pinMode(A0, INPUT);\n"
 625   ,"  int a0 = analogRead(A0);\n"
 626   ,"  switch (b) {\n"
 627   ,"  case 0: return a0 < ",toString RightBound,";       // right\n"
 628   ,"  case 1: return ",toString RightBound," < a0 && a0 < ",toString UpBound,"; // up\n"
 629   ,"  case 2: return ",toString UpBound," < a0 && a0 < ",toString DownBound,";// down\n"
 630   ,"  case 3: return ",toString DownBound," < a0 && a0 < ",toString LeftBound,";//left\n"
 631   ,"  case 4: return ",toString LeftBound," < a0 && a0 < ",toString SelectBound,";//select\n"
 632   ,"  default: return ",toString SelectBound," < a0;       //no button\n"
 633   ,"  }\n"
 634   ,"}\n"
 635   ,"boolean pWrite (int pin, boolean b) {\n"
 636   ,"  pinMode(pin, OUTPUT);\n"
 637   ,"  digitalWrite(pin, b);\n"
 638   ,"  return b;\n"
 639   ,"}\n"
 640   ,"int pWrite (int pin, int i) {\n"
 641   ,"  pinMode(pin, OUTPUT);\n"
 642   ,"  analogWrite(pin, i);\n"
 643   ,"  return i;\n"
 644   ,"}\n"
 645   :reverse c.funs
 646   ] ++
 647   ["\n// --- setup --- \n"
 648   ,"void setup () {\n"
 649   ,"  Serial.begin(9600);\n"
 650   ,"  "
 651   :reverse c.setup
 652   ] ++
 653   ["\n}\n"
 654   ,"\n// --- loop --- \n"
 655   ,"void loop () {\n"
 656   ,"  if (t0 != tn) {\n"
 657   ,"  if (t0 == tc) {\n"
 658   ,"    unsigned long time2 = millis();\n"
 659   ,"    delta = time2 - time;\n"
 660   ,"    time = time2;\n"
 661   ,"    tc = tn;\n"
 662   ,"  };\n"
 663   ,"  TASK* t0p = &tasks[t0];\n"
 664   ,"  t0p->wait -= delta;\n"
 665   ,"  if (t0p->wait > 0L) {\n"
 666   ,"    newTask(t0p->id, t0p->wait, t0p->a[0].w, t0p->a[1].w, t0p->a[2].w, t0p->a[3].w);\n"
 667   ,"  } else {\n"
 668   ,"    switch (t0p->id) {"
 669   :reverse c.loop
 670   ] ++
 671   ["\n"
 672   ,"    default:\n"
 673   ,"    Serial.println(\"stopped\");\n"
 674   ,"    t0 = tn; // no known task: force termination of tasks\n"
 675   ,"    return;\n"
 676   ,"    };\n"
 677   ,"  }\n"
 678   ,"  t0 = NEXT_TASK(t0);\n"
 679   ,"  }\n"
 680   ,"}\n"
 681   ]
 682 where c = f Rd newCode
 683
 684 mkset :: [a] -> [a] | Eq a
 685 mkset [a:x] = [a:mkset (filter ((<>) a) x)]
 686 mkset [] = []
 687
 688 newCode :: CODE
 689 newCode =
 690   { fresh   = 0
 691   , freshMTask = 0
 692   , funs    = []
 693   , ifuns   = 0
 694   , vars    = []
 695   , ivars   = 0
 696   , setup   = []
 697   , isetup  = 1
 698   , loop    = []
 699   , iloop   = 4
 700   , includes  = []
 701   , def     = Setup
 702   , mode    = NoReturn
 703   , binds               = []
 704   }
 705
 706 // ----- simulation ----- //
 707
 708 eval :: (Main (Eval t p)) -> [String] | toString t
 709 eval {main=(E f)} = [toString (fst (f Rd state0))]
 710
 711 :: State =
 712   { tasks :: [(Int, State->State)]
 713   , store :: [Dyn]
 714   , dpins :: [(DigitalPin, Bool)]
 715   , apins :: [(AnalogPin, Int)]
 716   , serial:: [String]
 717   , millis:: Int
 718   }
 719
 720 state0 :: State
 721 state0 = {store = [], tasks = [], serial = [], millis = 0, dpins = [] , apins = []}
 722
 723 //:: TaskSim :== (Int, State->State)
 724 :: Eval t p = E ((ReadWrite t) State -> (t, State))
 725 toS2S :: (Eval t p) -> (State->State)
 726 toS2S (E f) = \state.snd (f Rd state)
 727
 728 unEval :: (Eval t p) -> ((ReadWrite t) State -> (t, State))
 729 unEval (E f) = f
 730
 731 :: ReadWrite t = Rd | Wrt t | Updt (t->t)
 732
 733 (>>==) infixl 1 :: (Eval a p) (a -> Eval b q) -> Eval b r
 734 //(>>== ) (E f) g = E \r s. let (a, s2) = f Rd s; (E h) = g a in h Rd s2
 735 (>>==) (E f) g = E\r s.let (a,t) = f Rd s in unEval (g a) Rd t
 736
 737 rtrn :: t -> Eval t p
 738 rtrn a = E \r s -> (a, s)
 739
 740 yield :: t (Eval s p) -> Eval t Expr
 741 //yield a (E f) = E (\r s.(\(_,t).(a,t)) (f r s))
 742 yield a (E f) = E \r s.(a,snd (f Rd s))
 743
 744 instance arith Eval where
 745   lit a = rtrn a
 746   (+.) x y = x >>==  \a. y >>==  \b. rtrn (a + b)
 747   (-.) x y = x >>==  \a. y >>==  \b. rtrn (a - b)
 748   (*.) x y = x >>==  \a. y >>==  \b. rtrn (a * b)
 749   (/.) x y = x >>==  \a. y >>==  \b. rtrn (a / b)
 750 instance boolExpr Eval where
 751   (&.) x y = x >>==  \a. if a y (rtrn False) // lazy AND
 752   (|.) x y = x >>==  \a. if a (rtrn True) (y >>==  rtrn)
 753   Not x   = x >>==  \a. rtrn (not a)
 754   (==.) x y = x >>==  \a. y >>==  \b. rtrn (a == b)
 755   (!=.) x y = x >>==  \a. y >>==  \b. rtrn (a <> b)
 756   (<.)  x y = x >>==  \a. y >>==  \b. rtrn (a < b)
 757   (>.)  x y = x >>==  \a. y >>==  \b. rtrn (a > b)
 758   (<=.)  x y = x >>==  \a. y >>==  \b. rtrn (a <= b)
 759   (>=.)  x y = x >>==  \a. y >>==  \b. rtrn (a >= b)
 760 instance If Eval p q Expr where
 761   If  c t e = c >>==  \b.if b (toExpr t) (toExpr e)
 762 instance IF Eval where
 763   IF  c t e = c >>==  \b.if b (yield () t) (yield () e)
 764   (?) c t   = c >>==  \b.if b (yield () t) (rtrn ())
 765 instance var2 Eval where
 766   var2 v f = defEval2 v f
 767   con2 v f = defEval2 v f
 768
 769 defEval2 :: t ((Eval t p)->Main (Eval u q)) -> (Main (Eval u q)) | dyn t
 770 defEval2 v f =
 771   {main = E (\r s.(length s.store
 772           , {s & store = s.store ++ [toDyn v]}))
 773   >>==  \n.unMain (f (E (read` n)))}
 774 instance sds Eval where
 775   sds f = defEval f
 776   con f = defEval f
 777
 778 defEval :: ((Eval t p)->In t (Main (Eval u q))) -> (Main (Eval u q)) | dyn t
 779 defEval f =
 780   {main = E \r s.let (v In g) = f (E (read` (length s.store))) in
 781           unEval (unMain g) r {s & store = s.store ++ [toDyn v]}}
 782 instance fun Eval x | arg x where
 783   fun f = e where (g In e) = f (\a.toExpr (g a))
 784 instance mtask Eval x | arg x where
 785  task f = e where
 786   (t In e) = f (\d a.long d >>== \(L i).E\r s.(MTask (length s.tasks),{s&tasks=[(i,toS2S (t a)):s.tasks]}))
 787 instance mtasks Eval x y | arg x & arg y where
 788  tasks f = e where
 789   ((t,u) In e) =
 790    f ((\d a.long d >>== \(L i).E\r s.(MTask (length s.tasks),{s&tasks=[(i,toS2S (t a)):s.tasks]}))
 791    ,(\d b.long d >>== \(L j).E\r s.(MTask (length s.tasks),{s&tasks=[(j,toS2S (u b)):s.tasks]}))
 792    )
 793 instance setDelay Eval where
 794   setDelay d t = d >>==  \(L x). t >>==  \(MTask n).E \r s.(MTask n,{s & tasks = updateAt n (x,snd (s.tasks !! n)) s.tasks})
 795 class toExpr v where toExpr :: (v t p) -> v t Expr
 796 instance toExpr Eval where toExpr (E f) = E f
 797 instance toExpr Code where toExpr (C f) = C f
 798 instance seq Eval where
 799   (>>=.) x f = x >>==   f o rtrn
 800   (:.) x y = x >>==  \_. y
 801 instance assign Eval where
 802   (=.) (E v) e = e >>==  \a. E \r s.v (Wrt a) s
 803 instance output Eval where
 804   output x = x >>==  \a.E \r s.((),{s & serial = s.serial ++ [toCode a]})
 805 instance pinMode Eval where
 806   pinmode p m = rtrn ()
 807 instance digitalIO Eval where
 808   digitalRead  p   = E \rw s=:{dpins, apins}.(readPinD p dpins apins, s)
 809   digitalWrite p b = b >>== \a. E \rw s.(a, writePinD p a s)
 810 instance analogIO Eval where
 811   analogRead  p   = E \rw s=:{apins}. (readPinA p apins, s)
 812   analogWrite p b = b >>== \a. E \rw s.(a, writePinA p a s)
 813 instance noOp Eval where noOp = E \r s.(undef,s)
 814
 815 class arg x :: x -> Int
 816 instance arg () where arg _ = 0
 817 instance arg (Eval t p) | type t where arg _ = 1
 818 instance arg (Eval t p, Eval u q) | type t & type u where arg _ = 2
 819 instance arg (Eval t p, Eval u q, Eval v r) | type t & type u & type v where arg _ = 3
 820 instance arg (Eval t p, Eval u q, Eval v r, Eval w s) | type t & type u & type v where arg _ = 4
 821
 822 instance + String where (+) x y = x +++ y
 823
 824 readPinA :: AnalogPin [(AnalogPin, Int)] -> Int
 825 readPinA p lista
 826   = case [b \\ (q, b) <- lista | p == q] of
 827   []  = 0
 828   [a:x] = a
 829
 830 writePinA :: AnalogPin Int State -> State
 831 writePinA p x s
 832   = {s & apins = [(p, x):[(q, y) \\ (q, y) <- s.apins | p <> q]]}
 833
 834 class readPinD p :: p [(DigitalPin,Bool)] [(AnalogPin,Int)] -> Bool
 835 instance readPinD DigitalPin where
 836   readPinD p listd lista
 837   = case [b \\ (q,b) <- listd | p == q] of
 838     [] = False
 839     [a:x] = a
 840 instance readPinD AnalogPin where
 841   readPinD p listd lista
 842   = case [b \\ (q,b) <- lista | p == q] of
 843     [] = False
 844     [a:x] = a <> 0
 845 class writePinD p :: p Bool State -> State
 846 instance writePinD DigitalPin where
 847   writePinD p b s=:{dpins} = {s & dpins = [(p, b):[(q, c) \\ (q, c) <- dpins | p <> q]]}
 848 instance writePinD AnalogPin where
 849   writePinD p b s=:{apins} = {s & apins = [(p, if b 1 0):[(q, c) \\ (q, c) <- apins | p <> q]]}
 850
 851
 852 // ----- Interactive Simulation ----- //
 853
 854 derive class iTask DigitalPin, AnalogPin, Dyn, StateInterface, DisplayVar, Pin
 855
 856 simulate :: (Main (Eval a p)) -> Task ()
 857 simulate {main=(E f)} = setup state0 where
 858   setup s =
 859           updateInformation "State" [] (toView s)
 860           >>* [ OnAction ActionFinish (always shutDown)
 861             , OnAction (Action "setup" []) (hasValue
 862               (\si.simloop (snd (f Rd (mergeView s si)))))
 863             ]
 864   simloop s =
 865           updateInformation "State" [] (toView s)
 866           >>* [ OnAction ActionFinish (always shutDown)
 867             , OnAction (Action "clear serial" []) (always (simloop {s & serial = []}))
 868             , OnAction ActionNew (always (setup state0))
 869             : if (isEmpty s.tasks)
 870                 []
 871                 [OnAction (Action "loop" []) (hasValue
 872               \si.simloop (step` (mergeView s si)))
 873               ]
 874             ]
 875
 876 toView :: State -> StateInterface
 877 toView s =
 878   { serialOut = Display s.serial
 879   , analogPins = s.apins
 880   , digitalPins = s.dpins
 881   , var2iables = map toDisplayVar s.store
 882   , timer = s.millis
 883   , taskCount = Display (length s.tasks)
 884   }
 885
 886 mergeView :: State StateInterface -> State
 887 mergeView s si =
 888   { s
 889   & store = [fromDisplayVar new old \\ new <- si.var2iables & old <- s.store]
 890   , dpins = si.digitalPins
 891   , apins = si.analogPins
 892 //  , serial = si.serialOut
 893   , millis = si.timer
 894   }
 895
 896 :: StateInterface =
 897   { serialOut   :: Display [String]
 898   , analogPins  :: [(AnalogPin, Int)]
 899   , digitalPins :: [(DigitalPin, Bool)]
 900   , var2iables   :: [DisplayVar]
 901   , timer     :: Int
 902   , taskCount   :: Display Int
 903   }
 904
 905 toDisplayVar :: Dyn -> DisplayVar
 906 toDisplayVar (Dyn [v])
 907     # i = toInt v
 908     | toString i == v
 909         = INT i
 910         = Variable v
 911 toDisplayVar (Dyn ["L",v]) = LONG (toInt v)
 912 toDisplayVar (Dyn ["Servo",pinKind,pin,pos]) = Servo (fromJust (fromDyn (Dyn [pinKind,pin]))) (toInt pos)
 913 toDisplayVar (Dyn ["LCD",_,_,_,_,_,l1,_,l2,_]) = LCD16x2 l1 l2
 914 toDisplayVar (Dyn l) = DisplayVar l
 915
 916 fromDisplayVar :: DisplayVar Dyn -> Dyn
 917 fromDisplayVar (Variable v)  dyn = Dyn [v]
 918 fromDisplayVar (INT v)     dyn = Dyn [toString v]
 919 fromDisplayVar (LONG v)    dyn = Dyn ["L",toString v]
 920 fromDisplayVar (Servo pin pos) dyn = Dyn (["Servo":let (Dyn p) = toDyn pin in p] ++ [toString pos])
 921 fromDisplayVar (LCD16x2 l1 l2) (Dyn list) = Dyn (updateAt 6 l1 (updateAt 8 l2 list))
 922 fromDisplayVar (DisplayVar l)  dyn = Dyn l
 923
 924 :: DisplayVar
 925     = Variable String
 926     | INT Int
 927     | LONG Int
 928     | Servo Pin Int
 929     | LCD16x2 String String
 930     | DisplayVar [String]
 931
 932
 933 step` :: State -> State
 934 step` s =
 935   foldr appTask {s & millis = s.millis + delta, tasks = []}
 936     [(w - delta, f) \\ (w, f) <- s.tasks]
 937 where delta = foldl1 min (map fst s.tasks) // smallest wait
 938
 939 appTask t=:(w,f) s | w <= 0
 940   = f s
 941   = {s & tasks = [t:s.tasks]}
 942
 943 foldl1 op [a:x] = foldl op a x
 944 foldr1 op l :== foldr l
 945   where
 946     foldr [a]     = a
 947     foldr [a:x] = op a (foldr x)
 948
 949 class stringQuotes t | type t :: (Code t p) -> Code t p
 950 instance stringQuotes String where stringQuotes x = c "\"" +.+ x +.+ c "\""
 951 instance stringQuotes t    where stringQuotes x = x
 952
 953
 954 derive   toGenDynamic (), MTask, DigitalPin, AnalogPin, Pin, [], Long//, Servo
 955 derive fromGenDynamic (), MTask, DigitalPin, AnalogPin, Pin, [], Long//, Servo
 956 instance toCode () where toCode _ = ""
 957 instance ==   () where (==) _ _ = True
 958
 959 // ----- long ----- //
 960
 961 :: Long = L Int // 32 bit on Arduino
 962 instance toCode Long where toCode (L i) = toCode i + "L"
 963 instance + Long where (+) (L x) (L y) = L (x + y)
 964 instance - Long where (-) (L x) (L y) = L (x + y)
 965 instance * Long where (*) (L x) (L y) = L (x + y)
 966 instance / Long where (/) (L x) (L y) = L (x + y)
 967 instance == Long where (==) (L x) (L y) = x == y
 968 instance one Long where one = L one
 969 instance zero Long where zero = L zero
 970 now = lit (L 0)
 971
 972 class long v t :: (v t p) -> v Long Expr | isExpr p
 973 instance long Code Int where
 974   long x = embed (c "long" +.+ brac x)
 975 instance long Code Long where
 976   long x = embed (c "long" +.+ brac x)
 977 instance long Eval Int where
 978   long x = x >>== rtrn o L
 979 instance long Eval Long where
 980   long (E x) = E x
 981
 982 // ----- tools ----- //
 983
 984 class toCode a :: a -> String
 985 instance toCode Bool where toCode b = if b "true" "false"
 986 instance toCode Int where toCode a = toString a
 987 instance toCode Real where toCode a = toString a
 988 instance toCode Char where
 989   toCode '\0' = "'\\0'"
 990   toCode '\n' = "'\\n'"
 991   toCode '\\' = "\\"
 992   toCode a = "'" + toString a + "'"
 993 instance toCode String where toCode s = s
 994 instance toCode DigitalPin where toCode x = s%(1, size s - 1) where s = consName{|*|} x
 995 instance toCode AnalogPin  where toCode x = consName{|*|} x
 996 derive consName DigitalPin, AnalogPin, PinMode
 997
 998 instance == DigitalPin where (==) x y = x === y
 999 instance == AnalogPin   where (==) x y = x === y
1000
1001 derive consIndex DigitalPin, AnalogPin
1002
1003 tab =: toString (repeatn tabSize ' ')
1004 tabSize :== 2
1005
1006 instance toString () where toString _ = "()"