X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;f=mTaskInterpret.icl;h=6c9fd52461a2d1e5c04ad990d36622d3d6b7f92a;hb=ff56601fe3bbca4a5d507de43f31de10a11dfdb5;hp=eaded85f03b0bfc7a531eb64592072994bd475f9;hpb=48dfd7ad2f104321657a3ea44d33340761c95c2e;p=mTask.git diff --git a/mTaskInterpret.icl b/mTaskInterpret.icl index eaded85..6c9fd52 100644 --- a/mTaskInterpret.icl +++ b/mTaskInterpret.icl @@ -1,7 +1,7 @@ implementation module mTaskInterpret //import iTasks -import gdynamic, gCons, GenEq, StdMisc, StdArray +import gdynamic, gCons, GenEq, StdMisc, StdArray, GenBimap import GenPrint import mTask @@ -9,19 +9,19 @@ import StdFile import StdString from StdFunc import o +import StdBool import StdTuple import Data.Tuple import StdList from Data.Func import $ -from Text import class Text(join), instance Text String - - - +from Text import class Text(join,toUpperCase), instance Text String toByteVal :: BC -> String toByteVal a = undef -derive gPrint BC +derive gPrint BC, AnalogPin +derive consIndex BC +derive consName BC toReadableByteVal :: BC -> String toReadableByteVal a = printToString a @@ -44,17 +44,32 @@ instance boolExpr ByteCode where (<=.) x y = x <++> y <+-> [BCLeq] (>=.) x y = x <++> y <+-> [BCGeq] +instance analogIO ByteCode where + analogRead p = BC [BCAnalogRead $ toCode p] + analogWrite p b = b <+-> [BCAnalogWrite $ toCode p] + +instance digitalIO ByteCode where + digitalRead p = BC [BCDigitalRead $ toCode p] + digitalWrite p b = b <+-> [BCDigitalWrite $ toCode p] + instance If ByteCode Stmt Stmt Stmt where If b t e = BCIfStmt b t e instance If ByteCode Stmt e Stmt where If b t e = BCIfStmt b t e -//instance If ByteCode Stmt Stmt e where If b t e = BCIfStmt b t e -//instance If ByteCode Stmt x y where If b t e = BCIfStmt b t e -instance IF ByteCode where +instance If ByteCode Stmt Stmt e where If b t e = BCIfStmt b t e +instance If ByteCode x y Expr where If b t e = BCIfStmt b t e +instance IF ByteCode where IF b t e = BCIfStmt b t e (?) b t = BCIfStmt b t $ BC [] -BCIfStmt b t e = b <+-> [BCJmpF $ length <$> t + 1] <++> t <+-> [BCJmp $ length <$> e] <++> e +BCIfStmt b t e = b <+-> [BCJmpF $ length <$> t + 1] <++> t + <+-> [BCJmp $ length <$> e] <++> e instance noOp ByteCode where noOp = BC [] +instance serial ByteCode where + serialAvailable = BC [BCSerialAvail] + serialPrint s = BC [BCSerialPrint] + serialPrintln s = BC [BCSerialPrintln] + serialRead = BC [BCSerialRead] + serialParseInt = BC [BCSerialParseInt] (<++>) infixl 7 (<++>) (BC x) (BC y) = BC $ x ++ y @@ -66,30 +81,25 @@ instance noOp ByteCode where noOp = BC [] (<$>) infixl 9 (<$>) f (BC x) = f x -instance serial ByteCode where - serialAvailable = undef - serialPrint _ = undef - serialPrintln _ = undef - serialRead = undef - serialParseInt = undef - instance zero BCState where zero = {a=()} //Start :: ByteCode Int Expr //Start = (lit 36 +. lit 42) +. lit 84 -// -derive consIndex BC -derive consName BC -Start w -# (io, w) = stdio w -# io = io <<< "#ifndef MTASK_H\n#define MTASK_H\n" -# io = io <<< join "\n" ["#define " +++ consName{|*|} x +++ " " +++ toString (consIndex{|*|} x)\\x<-allBC] -# (ok, w) = fclose (io <<< "\n#endif\n") w -| not ok = abort "Couldn't close stdio" -= w - where - allBC = [BCNop, BCPush "", BCPop, BCNeg, BCNot, BCAdd, BCSub, BCMul, - BCDiv, BCAnd, BCOr, BCEq, BCNeq, BCLes, BCGre, BCLeq, BCGeq, - BCJmp 0, BCJmpT 0, BCJmpF 0] +//Run test programma en pretty print +Start :: ByteCode Int Expr +Start = If (lit True) (analogRead A1) (analogRead A0) +//Start = If ((lit 36) ==. (lit 42)) (noOp) (noOp) + +//Generate header file +//Start w +//# (io, w) = stdio w +//# io = io <<< "#ifndef MTASK_H\n#define MTASK_H\n" +//# io = io <<< join "\n" ["#define " <+ toUpperCase (consName{|*|} x) <+ " " <+ consIndex{|*|} x\\x<-allBC] +// with +// allBC :: [BC] +// allBC = conses{|*|} +//# (ok, w) = fclose (io <<< "\n#endif\n") w +//| not ok = abort "Couldn't close stdio" +//= w