added debug statements, dynamic allocation is working for tasks

[mTask.git] / mTaskInterpret.dcl

diff --git a/mTaskInterpret.dcl b/mTaskInterpret.dcl
index 0105944..7ddff19 100644 (file)
--- a/mTaskInterpret.dcl
+++ b/mTaskInterpret.dcl
@@ -1,21 +1,48 @@
 definition module mTaskInterpret
 
 definition module mTaskInterpret
 

+import mTask
+

 from Data.Functor.Identity import :: Identity
 from Control.Monad.State import :: State, :: StateT
 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
 
 :: MTaskMSGRecv

-       = MTPub Int String
+       = MTTaskAck Int
+       | MTTaskDelAck Int
+       | MTSDSAck Int
+       | MTSDSDelAck Int
+       | MTPub Int BCValue

        | MTMessage String
        | MTMessage String

-       | MTTaskAdded Int
+       | MTDevSpec MTaskDeviceSpec

        | MTEmpty
 
 :: MTaskMSGSend
        | MTEmpty
 
 :: MTaskMSGSend

-       = MTSds Int String
-       | MTTask Int String
-       | MTUpd Int String
+       = MTTask MTaskInterval String
+       | MTTaskDel Int
+       | MTSds Int BCValue
+       | MTUpd Int BCValue
+       | MTSpec
+
+:: MTaskInterval
+       = OneShot
+       | OnInterval Int
+       | OnInterrupt Int
+
+:: MTaskDeviceSpec =
+               {haveLed :: Bool
+               ,haveAio :: Bool
+               ,haveDio :: Bool
+               ,maxTask :: Int //Should be number of bytes reserved in total for shares, tasks and functions
+               ,maxSDS  :: Int
+       }
+
+:: BCValue = E.e: BCValue e & mTaskType e

 
 

+instance toString MTaskInterval

 instance toString MTaskMSGRecv
 instance toString MTaskMSGSend
 encode :: MTaskMSGSend -> String
 instance toString MTaskMSGRecv
 instance toString MTaskMSGSend
 encode :: MTaskMSGSend -> String


@@ -24,7 +51,8 @@ decode :: String -> MTaskMSGRecv
 :: BC
        = BCNop
        | BCLab Int
 :: BC
        = BCNop
        | BCLab Int

-       | BCPush [Char]
+       | BCPush BCValue
+//     | BCPush String

        | BCPop
        //SDS functions
        | BCSdsStore Int
        | BCPop
        //SDS functions
        | BCSdsStore Int


@@ -51,8 +79,8 @@ decode :: String -> MTaskMSGRecv
        | BCJmpT Int
        | BCJmpF Int
        //UserLED
        | BCJmpT Int
        | BCJmpF Int
        //UserLED

-       | BCLedOn [Char]
-       | BCLedOff [Char]
+       | BCLedOn
+       | BCLedOff

        //Serial
        | BCSerialAvail
        | BCSerialPrint
        //Serial
        | BCSerialAvail
        | BCSerialPrint


@@ -66,35 +94,53 @@ decode :: String -> MTaskMSGRecv
        | BCDigitalWrite Pin
        | BCTest AnalogPin
 
        | BCDigitalWrite Pin
        | BCTest AnalogPin
 

-:: ByteCode a p = BC (BCState -> ([BC], BCState))
-instance Semigroup (ByteCode a p)
-instance Monoid (ByteCode a p)
+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 :: BCValue
+       }

 
 :: BCState = {
                freshl :: [Int],
                freshs :: [Int],
 
 :: BCState = {
                freshl :: [Int],
                freshs :: [Int],

-               sdss :: [(Int, [Char])]
+               sdss :: [BCShare]

        }
 instance zero BCState
 
        }
 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
+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 toChar Pin

 instance arith ByteCode
 instance boolExpr ByteCode
 instance analogIO ByteCode
 instance digitalIO ByteCode
 instance userLed ByteCode
 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 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 If ByteCode x y Stmt
 instance IF ByteCode
 instance noOp ByteCode


@@ -104,11 +150,8 @@ instance assign ByteCode
 instance seq ByteCode
 instance serial ByteCode
 
 instance seq ByteCode
 instance serial ByteCode
 

-//pub :: (ByteCode a b) -> ByteCode a b
-
-toMessages :: Int (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)
-toRealByteCode :: (ByteCode a b) -> (String, BCState)
+toByteVal :: BC -> String
+toReadableByteCode :: (ByteCode a b) BCState -> (String, BCState)
+toRealByteCode :: (ByteCode a b) BCState -> (String, BCState)