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 p]
  50         analogWrite p b = b <+-> [BCAnalogWrite p]
  51
  52 instance If ByteCode Stmt Stmt Stmt where If b t e = BCIfStmt b t e
  53 instance If ByteCode Stmt e Stmt where If b t e = BCIfStmt b t e
  54 //instance If ByteCode Stmt Stmt e where If b t e = BCIfStmt b t e
  55 instance If ByteCode x y Expr where If b t e = BCIfStmt b t e
  56 instance IF ByteCode where
  57         IF b t e = BCIfStmt b t e
  58         (?) b t = BCIfStmt b t $ BC []
  59 BCIfStmt b t e = b <+-> [BCJmpF $ length <$> t + 1] <++> t
  60         <+-> [BCJmp $ length <$> e] <++> e
  61
  62 instance noOp ByteCode where noOp = BC []
  63
  64 instance serial ByteCode where
  65         serialAvailable = BC [BCSerialAvail]
  66         serialPrint s = BC [BCSerialPrint]
  67         serialPrintln s = BC [BCSerialPrintln]
  68         serialRead = BC [BCSerialRead]
  69         serialParseInt = BC [BCSerialParseInt]
  70
  71 (<++>) infixl 7
  72 (<++>) (BC x) (BC y) = BC $ x ++ y
  73 (<+->) infixl 7
  74 (<+->) (BC x) y = BC $ x ++ y
  75 (<-+>) infixl 7
  76 (<-+>) x (BC y) = BC $ x ++ y
  77
  78 (<$>) infixl 9
  79 (<$>) f (BC x) = f x
  80
  81 instance zero BCState where
  82         zero = {a=()}
  83
  84 //Start :: ByteCode Int Expr
  85 //Start = (lit 36 +. lit 42) +. lit 84
  86
  87 (<+) infixr 5 :: a b -> String | toString a & toString b
  88 (<+) a b = toString a +++ toString b
  89
  90 //Run test programma en pretty print
  91 Start :: ByteCode Int Expr
  92 Start = 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