X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;f=mTaskInterpret.dcl;h=63778bd54c8bffbd84b02e4f5e6cdf14523f310f;hb=4bb252b0423c73d134a541db44b8b08eab507a39;hp=999d734e139465ff72a5cb4fb104b52fc4dfb2bf;hpb=4f7354793be250c86dd0d2fda737312d33d54231;p=mTask.git diff --git a/mTaskInterpret.dcl b/mTaskInterpret.dcl index 999d734..63778bd 100644 --- a/mTaskInterpret.dcl +++ b/mTaskInterpret.dcl @@ -1,31 +1,46 @@ definition module mTaskInterpret +import mTask + from Data.Functor.Identity import :: Identity from Control.Monad.State import :: State, :: StateT from Control.Monad.RWST import :: RWST, :: RWS from Data.Either import :: Either -import mTask +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 + = MTTaskAck Int Int | MTTaskDelAck Int | MTSDSAck Int | MTSDSDelAck Int - | MTPub Int String + | MTPub Int BCValue | MTMessage String + | MTDevSpec MTaskDeviceSpec | MTEmpty :: MTaskMSGSend - = MTTask MTaskInterval String + = MTTask MTaskInterval Char String | MTTaskDel Int - | MTSds Int String - | MTUpd Int String + | MTSds Int BCValue + | MTUpd Int BCValue + | MTSpec :: MTaskInterval = OneShot | OnInterval Int | OnInterrupt Int +:: MTaskDeviceSpec = + {haveLed :: Bool + ,haveAio :: Bool + ,haveDio :: Bool + ,bytesMemory :: Int + } + +:: BCValue = E.e: BCValue e & mTaskType e + instance toString MTaskInterval instance toString MTaskMSGRecv instance toString MTaskMSGSend @@ -35,8 +50,8 @@ decode :: String -> MTaskMSGRecv :: BC = BCNop | BCLab Int -// | E.e: BCPush e & toByteCode e - | BCPush String + | BCPush BCValue +// | BCPush String | BCPop //SDS functions | BCSdsStore Int @@ -52,6 +67,7 @@ decode :: String -> MTaskMSGRecv //Binary Bool ops | BCAnd | BCOr + //Binary ops | BCEq | BCNeq | BCLes @@ -76,17 +92,30 @@ decode :: String -> MTaskMSGRecv | BCAnalogWrite Pin | BCDigitalRead Pin | BCDigitalWrite Pin - | BCTest AnalogPin - -derive class gCons BC + //Return + | BCReturn + +derive gPrint BCValue, MTaskDeviceSpec +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, MTaskDeviceSpec +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 :: Dynamic, - sdsbc :: String + sdsval :: BCValue } :: BCState = { @@ -98,14 +127,13 @@ instance zero BCState class toByteCode a :: a -> String class fromByteCode a :: String -> a -class mTaskType a | toByteCode, fromByteCode, TC a +class mTaskType a | toByteCode, fromByteCode, iTask, TC a -instance toByteCode Int, Bool, Char, Long, String, Button, UserLED -instance fromByteCode Int, Bool, Char, Long, String, Button, UserLED +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 fromByteCode MTaskInterval, MTaskDeviceSpec -instance toChar Pin instance arith ByteCode instance boolExpr ByteCode instance analogIO ByteCode @@ -117,14 +145,14 @@ instance If ByteCode Stmt e Stmt instance If ByteCode x y Stmt instance IF ByteCode instance noOp ByteCode +instance retrn ByteCode instance sds ByteCode instance assign ByteCode instance seq ByteCode instance serial ByteCode -toMessages :: MTaskInterval (String, BCState) -> ([MTaskMSGSend], BCState) -toSDSUpdate :: Int Int -> [MTaskMSGSend] +toMessages :: MTaskInterval (Main (ByteCode a b)) BCState -> ([MTaskMSGSend], BCState) toByteVal :: BC -> String toReadableByteCode :: (ByteCode a b) BCState -> (String, BCState)