mTaskInterpret.icl

   1 implementation module mTaskInterpret
   2
   3 //import iTasks
   4 import gdynamic, gCons, GenEq, StdMisc, StdArray, GenBimap
   5 import GenPrint
   6 import mTask
   7
   8 import StdFile
   9 import StdString
  10
  11 from StdFunc import o
  12 import StdBool
  13 import StdTuple
  14 import Data.Tuple
  15 import StdList
  16 from Data.Func import $
  17 from Text import class Text(join,toUpperCase), instance Text String
  18
  19 toByteVal :: BC -> String
  20 toByteVal a = undef
  21
  22 derive gPrint BC, AnalogPin
  23 derive consIndex BC
  24 derive consName BC
  25
  26 toReadableByteVal :: BC -> String
  27 toReadableByteVal a = printToString a
  28
  29 instance arith ByteCode where
  30         lit x = BC [BCPush $ toCode x]
  31         (+.) x y = x <++> y <+-> [BCAdd]
  32         (-.) x y = x <++> y <+-> [BCSub]
  33         (*.) x y = x <++> y <+-> [BCMul]
  34         (/.) x y = x <++> y <+-> [BCDiv]
  35
  36 instance boolExpr ByteCode where
  37         (&.) x y = x <++> y <+-> [BCAnd]
  38         (|.) x y = x <++> y <+-> [BCOr]
  39         Not x = x <+-> [BCNot]
  40         (==.) x y = x <++> y <+-> [BCEq]
  41         (!=.) x y = x <++> y <+-> [BCNeq]
  42         (<.) x y = x <++> y <+-> [ BCLes]
  43         (>.)  x y = x <++> y <+-> [BCGre]
  44         (<=.) x y = x <++> y <+-> [BCLeq]
  45         (>=.) x y = x <++> y <+-> [BCGeq]
  46
  47 instance analogIO ByteCode where
  48         analogRead p = BC [BCAnalogRead $ toCode p]
  49         analogWrite p b = b <+-> [BCAnalogWrite $ toCode p]
  50
  51 instance digitalIO ByteCode where
  52         digitalRead p = BC [BCDigitalRead $ toCode p]
  53         digitalWrite p b = b <+-> [BCDigitalWrite $ toCode p]
  54
  55 instance If ByteCode Stmt Stmt Stmt where If b t e = BCIfStmt b t e
  56 instance If ByteCode Stmt e Stmt where If b t e = BCIfStmt b t e
  57 instance If ByteCode Stmt Stmt e where If b t e = BCIfStmt b t e
  58 instance If ByteCode x y Expr where If b t e = BCIfStmt b t e
  59 instance IF ByteCode where
  60         IF b t e = BCIfStmt b t e
  61         (?) b t = BCIfStmt b t $ BC []
  62 BCIfStmt b t e = b <+-> [BCJmpF $ length <$> t + 1] <++> t
  63         <+-> [BCJmp $ length <$> e] <++> e
  64
  65 instance noOp ByteCode where noOp = BC []
  66
  67 instance serial ByteCode where
  68         serialAvailable = BC [BCSerialAvail]
  69         serialPrint s = BC [BCSerialPrint]
  70         serialPrintln s = BC [BCSerialPrintln]
  71         serialRead = BC [BCSerialRead]
  72         serialParseInt = BC [BCSerialParseInt]
  73
  74 (<++>) infixl 7
  75 (<++>) (BC x) (BC y) = BC $ x ++ y
  76 (<+->) infixl 7
  77 (<+->) (BC x) y = BC $ x ++ y
  78 (<-+>) infixl 7
  79 (<-+>) x (BC y) = BC $ x ++ y
  80
  81 (<$>) infixl 9
  82 (<$>) f (BC x) = f x
  83
  84 instance zero BCState where
  85         zero = {a=()}
  86
  87 //Start :: ByteCode Int Expr
  88 //Start = (lit 36 +. lit 42) +. lit 84
  89
  90 //Run test programma en pretty print
  91 Start :: ByteCode Int Expr
  92 Start = If (lit True) (analogRead A1) (analogRead A0)
  93 //Start = If ((lit 36) ==. (lit 42)) (noOp) (noOp)
  94
  95 //Generate header file
  96 //Start w
  97 //# (io, w) = stdio w
  98 //# io = io <<< "#ifndef MTASK_H\n#define MTASK_H\n"
  99 //# io = io <<< join "\n" ["#define " <+ toUpperCase (consName{|*|} x) <+ " " <+ consIndex{|*|} x\\x<-allBC]
 100 //      with
 101 //              allBC :: [BC]
 102 //              allBC = conses{|*|}
 103 //# (ok, w) = fclose (io <<< "\n#endif\n") w
 104 //| not ok = abort "Couldn't close stdio"
 105 //= w