X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;f=mTaskInterpret.dcl;h=99a3533cd2fa0ea32b7c1ccfe0cdbf56e9f7bd67;hb=a81623aa9629a3c5c8f8bf920e494a596b30c4b7;hp=17034beb04f6e8e0d1f78cf4776b65cddb0d694c;hpb=5019b4f7dbeda8679421ec482f40b85eec9ebd72;p=mTask.git diff --git a/mTaskInterpret.dcl b/mTaskInterpret.dcl index 17034be..99a3533 100644 --- a/mTaskInterpret.dcl +++ b/mTaskInterpret.dcl @@ -1,30 +1,47 @@ definition module mTaskInterpret +import mTask + from Data.Functor.Identity import :: Identity from Control.Monad.State import :: State, :: StateT -from Data.Monoid import class Semigroup, class Monoid -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 + = MTTaskAck Int Int | MTTaskDelAck Int | MTSDSAck Int | MTSDSDelAck Int - | MTPub Int String + | MTPub Int BCValue | MTMessage String + | MTDevSpec MTaskDeviceSpec | MTEmpty :: MTaskMSGSend = MTTask MTaskInterval String | MTTaskDel Int - | MTSds Int String - | MTUpd Int String + | MTShutdown + | 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 @@ -34,12 +51,13 @@ decode :: String -> MTaskMSGRecv :: BC = BCNop | BCLab Int - | BCPush [Char] + | BCPush BCValue +// | BCPush String | BCPop //SDS functions - | BCSdsStore Int - | BCSdsFetch Int - | BCSdsPublish Int + | BCSdsStore BCShare + | BCSdsFetch BCShare + | BCSdsPublish BCShare //Unary ops | BCNot //Binary Int ops @@ -50,6 +68,7 @@ decode :: String -> MTaskMSGRecv //Binary Bool ops | BCAnd | BCOr + //Binary ops | BCEq | BCNeq | BCLes @@ -61,8 +80,8 @@ decode :: String -> MTaskMSGRecv | BCJmpT Int | BCJmpF Int //UserLED - | BCLedOn [Char] - | BCLedOff [Char] + | BCLedOn + | BCLedOff //Serial | BCSerialAvail | BCSerialPrint @@ -74,16 +93,29 @@ decode :: String -> MTaskMSGRecv | BCAnalogWrite Pin | BCDigitalRead Pin | BCDigitalWrite Pin - | BCTest AnalogPin + //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 (BCState -> ([BC], BCState)) -instance Semigroup (ByteCode a p) -instance Monoid (ByteCode a p) +:: ByteCode a p = BC (RWS () [BC] BCState ()) :: BCShare = { sdsi :: Int, - sdspub :: Bool, - sdsval :: [Char] + sdsval :: BCValue } :: BCState = { @@ -93,37 +125,37 @@ instance Monoid (ByteCode a p) } instance zero BCState -class toByteCode a :: a -> [Char] -instance toByteCode Int -instance toByteCode Bool -instance toByteCode Char -instance toByteCode String -instance toByteCode Long -instance toByteCode Button -instance toByteCode UserLED -//instance toByteCode MTaskInterval - -instance toChar Pin +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, MTaskDeviceSpec + instance arith ByteCode instance boolExpr ByteCode instance analogIO ByteCode instance digitalIO ByteCode +instance aIO ByteCode +instance dIO 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 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 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 -> [Char] -toReadableByteCode :: (ByteCode a b) -> (String, BCState) +toByteVal :: BC -> String +toReadableByteCode :: (ByteCode a b) BCState -> (String, BCState) toRealByteCode :: (ByteCode a b) BCState -> (String, BCState)