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 derive conses BC, AnalogPin
  26
  27 toReadableByteVal :: BC -> String
  28 toReadableByteVal a = printToString a
  29
  30 instance arith ByteCode where
  31         lit x = BC [BCPush $ toCode x]
  32         (+.) x y = x <++> y <+-> [BCAdd]
  33         (-.) x y = x <++> y <+-> [BCSub]
  34         (*.) x y = x <++> y <+-> [BCMul]
  35         (/.) x y = x <++> y <+-> [BCDiv]
  36
  37 instance boolExpr ByteCode where
  38         (&.) x y = x <++> y <+-> [BCAnd]
  39         (|.) x y = x <++> y <+-> [BCOr]
  40         Not x = x <+-> [BCNot]
  41         (==.) x y = x <++> y <+-> [BCEq]
  42         (!=.) x y = x <++> y <+-> [BCNeq]
  43         (<.) x y = x <++> y <+-> [ BCLes]
  44         (>.)  x y = x <++> y <+-> [BCGre]
  45         (<=.) x y = x <++> y <+-> [BCLeq]
  46         (>=.) x y = x <++> y <+-> [BCGeq]
  47
  48 instance analogIO ByteCode where
  49         analogRead p = BC [BCAnalogRead $ toCode p]
  50         analogWrite p b = b <+-> [BCAnalogWrite $ toCode p]
  51
  52 instance digitalIO ByteCode where
  53         digitalRead p = BC [BCDigitalRead $ toCode p]
  54         digitalWrite p b = b <+-> [BCDigitalWrite $ toCode p]
  55
  56 instance If ByteCode Stmt Stmt Stmt where If b t e = BCIfStmt b t e
  57 instance If ByteCode Stmt e Stmt where If b t e = BCIfStmt b t e
  58 instance If ByteCode Stmt Stmt e where If b t e = BCIfStmt b t e
  59 instance If ByteCode x y Expr where If b t e = BCIfStmt b t e
  60 instance IF ByteCode where
  61         IF b t e = BCIfStmt b t e
  62         (?) b t = BCIfStmt b t $ BC []
  63 BCIfStmt b t e = b <+-> [BCJmpF $ length <$> t + 1] <++> t
  64         <+-> [BCJmp $ length <$> e] <++> e
  65
  66 instance noOp ByteCode where noOp = BC []
  67
  68 instance serial ByteCode where
  69         serialAvailable = BC [BCSerialAvail]
  70         serialPrint s = BC [BCSerialPrint]
  71         serialPrintln s = BC [BCSerialPrintln]
  72         serialRead = BC [BCSerialRead]
  73         serialParseInt = BC [BCSerialParseInt]
  74
  75 (<++>) infixl 7
  76 (<++>) (BC x) (BC y) = BC $ x ++ y
  77 (<+->) infixl 7
  78 (<+->) (BC x) y = BC $ x ++ y
  79 (<-+>) infixl 7
  80 (<-+>) x (BC y) = BC $ x ++ y
  81
  82 (<$>) infixl 9
  83 (<$>) f (BC x) = f x
  84
  85 instance zero BCState where
  86         zero = {a=()}
  87
  88 //Start :: ByteCode Int Expr
  89 //Start = (lit 36 +. lit 42) +. lit 84
  90
  91 //Run test programma en pretty print
  92 Start :: ByteCode Int Expr
  93 Start = If (lit True) (analogRead A1) (analogRead A0)
  94 //Start = If ((lit 36) ==. (lit 42)) (noOp) (noOp)
  95
  96 //Generate header file
  97 //Start w
  98 //# (io, w) = stdio w
  99 //# io = io <<< "#ifndef MTASK_H\n#define MTASK_H\n"
 100 //# io = io <<< join "\n" ["#define " <+ toUpperCase (consName{|*|} x) <+ " " <+ consIndex{|*|} x\\x<-allBC]
 101 //      with
 102 //              allBC :: [BC]
 103 //              allBC = conses{|*|}
 104 //# (ok, w) = fclose (io <<< "\n#endif\n") w
 105 //| not ok = abort "Couldn't close stdio"
 106 //= w