X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;f=mTaskInterpret.icl;h=d689b5fbd3690d5049a686b76afaf5e0f0b96851;hb=8316870cacd21b19badf032f3b8189bdd54eb1e3;hp=80286f2b41a4f5d8d088eef79ef87b3bd7654eca;hpb=aa90c851099c0f6e5993b8cf83ef6605b3835346;p=mTask.git diff --git a/mTaskInterpret.icl b/mTaskInterpret.icl index 80286f2..d689b5f 100644 --- a/mTaskInterpret.icl +++ b/mTaskInterpret.icl @@ -1,27 +1,28 @@ implementation module mTaskInterpret //import iTasks -import gdynamic, gCons, GenEq, StdMisc, StdArray +import gdynamic, gCons, GenEq, StdMisc, StdArray, GenBimap import GenPrint import mTask +import StdFile +import StdString + from StdFunc import o +import StdBool import StdTuple import Data.Tuple -import Data.Functor import StdList -import Control.Applicative -import Control.Monad -import Data.Monoid -import Control.Monad.State -import Control.Monad.Identity from Data.Func import $ - +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 +derive conses BC, AnalogPin toReadableByteVal :: BC -> String toReadableByteVal a = printToString a @@ -44,15 +45,28 @@ instance boolExpr ByteCode where (<=.) x y = x <++> y <+-> [BCLeq] (>=.) x y = x <++> y <+-> [BCGeq] +instance analogIO ByteCode where + analogRead p = BC [BCAnalogRead p] + analogWrite p b = b <+-> [BCAnalogWrite 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 @@ -64,21 +78,28 @@ BCIfStmt b t e = b <+-> [BCJmpF $ length <$> t + 1] <++> t <+-> [BCJmp $ length (<$>) 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=()} -//runByteCode :: (ByteCode Int Expr) BCState -> [BC] -//runByteCode (BC f) s = evalState f s -//runByteCode (BC f) s = fst (f Rd s) +//Start :: ByteCode Int Expr +//Start = (lit 36 +. lit 42) +. lit 84 + +(<+) infixr 5 :: a b -> String | toString a & toString b +(<+) a b = toString a +++ toString b -//Start :: Main (ByteCode Int Expr) -//Start :: [BC] +//Run test programma en pretty print Start :: ByteCode Int Expr -Start = (lit 36 +. lit 42) +. lit 84 +Start = 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