X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;f=mTaskInterpret.dcl;h=92f668387877f9bae51ef3a36494fd379c720aec;hb=7ab8606c3d22a2bc2743eae7a398407c84d502f2;hp=667f26b99e46451fcc913fda2c6be7e845a0f7b2;hpb=884b2d1f25a3839851a7257d0eae929999f512c0;p=mTask.git diff --git a/mTaskInterpret.dcl b/mTaskInterpret.dcl index 667f26b..92f6683 100644 --- a/mTaskInterpret.dcl +++ b/mTaskInterpret.dcl @@ -1,13 +1,48 @@ definition module mTaskInterpret +import mTask + from Data.Functor.Identity import :: Identity from Control.Monad.State import :: State, :: StateT -import mTask +from Control.Monad.RWST import :: RWST, :: RWS +from Data.Either import :: Either +from iTasks._Framework.Generic.Defaults import generic gDefault +from GenPrint import generic gPrint +from Generics.gCons import class gCons, generic conses, generic consName, generic consIndex, generic consNum + +:: MTaskMSGRecv + = MTTaskAck Int + | MTTaskDelAck Int + | MTSDSAck Int + | MTSDSDelAck Int + | MTPub Int String + | MTMessage String + | MTEmpty + +:: MTaskMSGSend + = MTTask MTaskInterval String + | MTTaskDel Int + | MTSds Int String + | MTUpd Int String + +:: MTaskInterval + = OneShot + | OnInterval Int + | OnInterrupt Int + +:: BCValue = E.e: BCValue e & mTaskType e + +instance toString MTaskInterval +instance toString MTaskMSGRecv +instance toString MTaskMSGSend +encode :: MTaskMSGSend -> String +decode :: String -> MTaskMSGRecv :: BC = BCNop | BCLab Int - | BCPush [Char] + | BCPush BCValue +// | BCPush String | BCPop //SDS functions | BCSdsStore Int @@ -33,6 +68,9 @@ import mTask | BCJmp Int | BCJmpT Int | BCJmpF Int + //UserLED + | BCLedOn + | BCLedOff //Serial | BCSerialAvail | BCSerialPrint @@ -46,20 +84,65 @@ import mTask | BCDigitalWrite Pin | BCTest AnalogPin -:: ByteCode a p = BC (BCState -> ([BC], BCState)) -//:: ByteCode a p = BC [BC] -//:: ByteCode a p = BC ((ReadWrite (ByteCode a Expr)) BCState -> ([BC], BCState)) +derive gPrint BCValue +derive consIndex BCValue +derive consName BCValue +derive conses BCValue +derive consNum BCValue + +derive class gCons Long, UserLED, Button, AnalogPin, DigitalPin, PinMode, Pin +derive class iTask UserLED, Long, Pin, Button, AnalogPin, DigitalPin, PinMode +derive gEditor BCValue +derive gText BCValue +derive JSONEncode BCValue +derive JSONDecode BCValue +derive gDefault BCValue +derive gEq BCValue + +:: ByteCode a p = BC (RWS () [BC] BCState ()) + +:: BCShare = { + sdsi :: Int, + sdspub :: Bool, + sdsval :: BCValue + } + :: BCState = { freshl :: [Int], - freshs :: [Int] + freshs :: [Int], + sdss :: [BCShare] } +instance zero BCState + +class toByteCode a :: a -> String +class fromByteCode a :: String -> a +class mTaskType a | toByteCode, fromByteCode, iTask, TC a + +instance toByteCode Int, Bool, Char, Long, String, Button, UserLED, BCValue +instance fromByteCode Int, Bool, Char, Long, String, Button, UserLED, BCValue +instance toByteCode MTaskInterval +instance fromByteCode MTaskInterval + +instance arith ByteCode +instance boolExpr ByteCode +instance analogIO ByteCode +instance digitalIO ByteCode +instance userLed ByteCode +instance If ByteCode Stmt Stmt Stmt +instance If ByteCode e Stmt Stmt +instance If ByteCode Stmt e Stmt +instance If ByteCode x y Stmt +instance IF ByteCode +instance noOp ByteCode + +instance sds ByteCode +instance assign ByteCode +instance seq ByteCode +instance serial ByteCode -class toByteCode a :: a -> [Char] -instance toByteCode Int -instance toByteCode Bool -instance toByteCode Char -instance toByteCode String -instance toByteCode Long -instance toByteCode Button +toMessages :: MTaskInterval (String, BCState) -> ([MTaskMSGSend], BCState) +toSDSUpdate :: Int Int -> [MTaskMSGSend] -toByteVal :: BC -> [Char] +toByteVal :: BC -> String +toReadableByteCode :: (ByteCode a b) BCState -> (String, BCState) +toRealByteCode :: (ByteCode a b) BCState -> (String, BCState)