refactoors
[mTask.git] / mTaskInterpret.dcl
index a7b463d..3e7513f 100644 (file)
@@ -1,14 +1,68 @@
 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 Int
+       | MTTaskDelAck Int
+       | MTSDSAck Int
+       | MTSDSDelAck Int
+       | MTPub Int BCValue
+       | MTMessage String
+       | MTDevSpec MTaskDeviceSpec
+       | MTEmpty
+
+:: MTaskMSGSend
+       = MTTask MTaskInterval String
+       | MTTaskDel Int
+       | MTShutdown
+       | MTSds Int BCValue
+       | MTUpd Int BCValue
+       | MTSpec
+
+:: MTaskInterval
+       = OneShot
+       | OnInterval Int
+       | OnInterrupt Int
+
+:: MTaskDeviceSpec =
+               {haveLed     :: Bool
+               ,haveAio     :: Bool
+               ,haveDio     :: Bool
+               ,aPins       :: Int
+               ,dPins       :: Int
+               ,stackSize   :: Int
+               ,bytesMemory :: Int
+       }
+
+:: BCValue = E.e: BCValue e & mTaskType, TC e
+
+instance == BCValue
+
+instance toString MTaskInterval
+instance toString MTaskMSGRecv
+instance toString MTaskMSGSend
+encode :: MTaskMSGSend -> String
+decode :: String -> MTaskMSGRecv
 
 :: BC
        = BCNop
-       | BCPush Int
+       | BCLab Int
+       | BCPush BCValue
+//     | BCPush String
        | BCPop
-       | BCSds Int
+       //SDS functions
+       | BCSdsStore BCShare
+       | BCSdsFetch BCShare
+       | BCSdsPublish BCShare
        //Unary ops
        | BCNot
        //Binary Int ops
@@ -19,6 +73,7 @@ import mTask
        //Binary Bool ops
        | BCAnd
        | BCOr
+       //Binary ops
        | BCEq
        | BCNeq
        | BCLes
@@ -29,6 +84,9 @@ import mTask
        | BCJmp Int
        | BCJmpT Int
        | BCJmpF Int
+       //UserLED
+       | BCLedOn
+       | BCLedOff
        //Serial
        | BCSerialAvail
        | BCSerialPrint
@@ -40,155 +98,71 @@ import mTask
        | 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 (RWS () [BC] BCState ())
+
+:: BCShare =
+       { sdsi :: Int
+       , sdsval :: BCValue
+       , sdsname :: String
+       }
 
-//:: ByteCode a p = BC (BCState -> ([BC], BCState))
-:: ByteCode a p = BC [BC]
-//:: ByteCode a p = BC ((ReadWrite (ByteCode a Expr)) BCState -> ([BC], BCState))
 :: BCState = {
-               a::()
+               freshl :: 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, 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 x y Stmt
+instance IF ByteCode
+instance noOp ByteCode
+instance retrn ByteCode
+
+instance sds ByteCode
+instance sdspub ByteCode
+instance assign ByteCode
+instance seq ByteCode
+instance serial ByteCode
+
+toMessages :: MTaskInterval (Main (ByteCode a b)) BCState -> ([MTaskMSGSend], BCState)
 
-class toByteCode a :: a -> [Char]
-instance toByteCode Int
-instance toByteCode Bool
-instance toByteCode Char
-instance toByteCode String
-instance toByteCode Long
-instance toByteCode Button
-
-toByteVal :: BC -> [Char]
-toReadableByteVal :: BC -> String
-
-//instance toCode Pin
-//instance toCode MTask
-//instance toCode ()
-//instance toCode Long
-//
-//class toCode a :: a -> String
-//instance toCode Bool
-//instance toCode Int
-//instance toCode Real
-//instance toCode Char
-//instance toCode String
-//instance toCode DigitalPin
-//instance toCode AnalogPin
-//
-//argType :: (((Code a p)->Code b q)->In ((Code a p)->Code b q) (Code c s)) -> a | type a
-//
-//class argTypes t :: ((t->Code b Expr)->In (t->Code b2 q) (Main (Code c s))) -> t
-//instance argTypes (Code a p) | showType a
-//instance argTypes (Code a p, Code b q) | showType a & showType b
-//instance argTypes (Code a p, Code b q, Code c r) | showType a & showType b & showType c
-//
-//instance toCode (SV t)
-//
-//instance arith Code
-//instance boolExpr Code
-//instance If Code Stmt Stmt Stmt
-//instance If Code e    Stmt Stmt
-//instance If Code Stmt e    Stmt
-//instance If Code x    y    Expr
-//instance IF Code
-//instance sds Code
-//
-//defCode :: ((Code t p) -> In t (Main (Code u q))) -> Main (Code u r) | type t
-//
-//var :: String (ReadWrite (Code v q)) CODE -> CODE
-//
-//instance assign Code
-//instance seq Code
-//instance step` Code
-//codeSteps :: [Step Code t] -> Code u p
-//optBreak :: Mode -> Code u p
-//
-//instance setDelay Code
-//instance mtask Code a | taskImp2 a & types a
-//instance mtasks Code a b | taskImp2 a & types a  & taskImp2 b & types b
-//
-//loopCode :: Int (Code a b) -> Code c d
-//
-//class taskImp2 a :: Int a -> ((Code Long p) a->Code MTask Expr, a) | /*long Code delay &*/ isExpr p
-//instance taskImp2 ()
-//instance taskImp2 (Code t p)
-//instance taskImp2 (Code a p, Code b q)
-//instance taskImp2 (Code a p, Code b q, Code c r)
-//instance taskImp2 (Code a p, Code b q, Code c r, Code d s)
-//
-//class taskImp a :: Int a -> (Int a->Code MTask Expr, a)
-//instance taskImp ()
-//instance taskImp (Code t p)
-//instance taskImp (Code a p, Code b q)
-//instance taskImp (Code a p, Code b q, Code c r)
-//instance taskImp (Code a p, Code b q, Code c r, Code d s)
-//
-//tasksMain :: Int Int ((a->Code MTask Expr,b->Code MTask Expr) -> In (a->Code c d,b->Code e f) (Main (Code g h))) -> Main (Code i j) | taskImp a & types a & taskImp b & types b
-//class types a :: a
-//instance types ()
-//instance types (Code a p) | typeSelector a & isExpr p
-//instance types (Code a p, Code b q) | typeSelector a & isExpr p & typeSelector b & isExpr q 
-//instance types (Code a p, Code b q, Code c r) | typeSelector a & isExpr p & typeSelector b & isExpr q & typeSelector c & isExpr r 
-//instance types (Code a p, Code b q, Code c r, Code d s) | typeSelector a & isExpr p & typeSelector b & isExpr q & typeSelector c & isExpr r & typeSelector d & isExpr s 
-//
-//codeMTaskBody :: (Code v w) (Code c d) -> Code e f
-//instance fun Code ()
-//instance fun Code (Code t p) | type, showType t & isExpr p
-//instance fun Code (Code a p, Code b q) | showType a & showType b
-//instance fun Code (Code a p, Code b q, Code c r) | showType a & showType b & showType c
-//instance output Code
-//instance pinMode Code
-//instance digitalIO Code
-//instance dIO Code
-//instance aIO Code
-//instance analogIO Code
-//instance noOp Code
-//
-//:: Code a p = C ((ReadWrite (Code a Expr)) CODE -> CODE)
-//:: CODE =
-//  { fresh    :: Int
-//  , freshMTask :: Int
-//  , funs     :: [String]
-//  , ifuns                    :: Int
-//  , vars       :: [String]
-//  , ivars                    :: Int
-//  , setup                    :: [String]
-//  , isetup     :: Int
-//  , loop       :: [String]
-//  , iloop                    :: Int
-//  , includes  :: [String]
-//  , def        :: Def
-//  , mode       :: Mode
-//  , binds                    :: [String]
-//  }
-//
-//unC :: (Code a p) -> ((ReadWrite (Code a Expr)) CODE -> CODE)
-//
-//:: Def = Var | Fun | Setup | Loop
-//:: Mode = /*MainMode |*/ NoReturn | Return String | SubExp | Assign String
-//
-//setMode :: Mode -> Code a p
-//getMode :: (Mode -> Code a p) -> Code a p
-//embed :: (Code a p) -> Code a p
-//(+.+) infixl 5 :: (Code a p) (Code b q) -> Code c r
-//fresh :: (Int -> (Code a p)) -> (Code a p)
-//freshMTask :: (Int -> (Code a p)) -> (Code a p)
-//setCode :: Def -> (Code a p)
-//getCode :: (Def -> Code a p) -> (Code a p)
-//brac :: (Code a p) -> Code b q
-//funBody :: (Code a p) -> Code b q
-//codeOp2 :: (Code a p) String (Code b q) -> Code c r
-//include :: String -> Code a b
-//argList :: [a] -> String | toCode a
-//c :: a -> Code b p | toCode a
-//indent :: Code a p
-//unindent :: Code a p
-//nl :: Code a p
-//setBinds :: [String] -> Code a p
-//addBinds :: String -> Code a p
-//getBinds :: ([String] -> Code a p) -> (Code a p)
-//
-//// ----- driver ----- //
-//
-//compile :: (Main (Code a p)) -> [String]
-//mkset :: [a] -> [a] | Eq a
-//newCode :: CODE
+toByteVal :: BC -> String
+toReadableByteCode :: (ByteCode a b) BCState -> (String, BCState)
+toRealByteCode :: (ByteCode a b) BCState -> (String, BCState)