mTaskInterpret.dcl

   1 definition module mTaskInterpret
   2
   3 import mTask
   4
   5 from Data.Functor.Identity import :: Identity
   6 from Control.Monad.State import :: State, :: StateT
   7 from Control.Monad.RWST import :: RWST, :: RWS
   8 from Data.Either import :: Either
   9 from iTasks._Framework.Generic.Defaults import generic gDefault
  10 from GenPrint import generic gPrint
  11 from Generics.gCons import class gCons, generic conses, generic consName, generic consIndex, generic consNum
  12
  13 :: MTaskMSGRecv
  14         = MTTaskAck Int Int
  15         | MTTaskDelAck Int
  16         | MTSDSAck Int
  17         | MTSDSDelAck Int
  18         | MTPub Int BCValue
  19         | MTMessage String
  20         | MTDevSpec MTaskDeviceSpec
  21         | MTEmpty
  22
  23 :: MTaskMSGSend
  24         = MTTask MTaskInterval Char String
  25         | MTTaskDel Int
  26         | MTSds Int BCValue
  27         | MTUpd Int BCValue
  28         | MTSpec
  29
  30 :: MTaskInterval
  31         = OneShot
  32         | OnInterval Int
  33         | OnInterrupt Int
  34
  35 :: MTaskDeviceSpec =
  36                 {haveLed :: Bool
  37                 ,haveAio :: Bool
  38                 ,haveDio :: Bool
  39                 ,bytesMemory :: Int
  40         }
  41
  42 :: BCValue = E.e: BCValue e & mTaskType e
  43
  44 instance toString MTaskInterval
  45 instance toString MTaskMSGRecv
  46 instance toString MTaskMSGSend
  47 encode :: MTaskMSGSend -> String
  48 decode :: String -> MTaskMSGRecv
  49
  50 :: BC
  51         = BCNop
  52         | BCLab Int
  53         | BCPush BCValue
  54 //      | BCPush String
  55         | BCPop
  56         //SDS functions
  57         | BCSdsStore Int
  58         | BCSdsFetch Int
  59         | BCSdsPublish Int
  60         //Unary ops
  61         | BCNot
  62         //Binary Int ops
  63         | BCAdd
  64         | BCSub
  65         | BCMul
  66         | BCDiv
  67         //Binary Bool ops
  68         | BCAnd
  69         | BCOr
  70         //Binary ops
  71         | BCEq
  72         | BCNeq
  73         | BCLes
  74         | BCGre
  75         | BCLeq
  76         | BCGeq
  77         //Conditionals and jumping
  78         | BCJmp Int
  79         | BCJmpT Int
  80         | BCJmpF Int
  81         //UserLED
  82         | BCLedOn
  83         | BCLedOff
  84         //Serial
  85         | BCSerialAvail
  86         | BCSerialPrint
  87         | BCSerialPrintln
  88         | BCSerialRead
  89         | BCSerialParseInt
  90         //Pins
  91         | BCAnalogRead Pin
  92         | BCAnalogWrite Pin
  93         | BCDigitalRead Pin
  94         | BCDigitalWrite Pin
  95         //Return
  96         | BCReturn
  97
  98 derive gPrint BCValue, MTaskDeviceSpec
  99 derive consIndex BCValue
 100 derive consName BCValue
 101 derive conses BCValue
 102 derive consNum BCValue
 103
 104 derive class gCons Long, UserLED, Button, AnalogPin, DigitalPin, PinMode, Pin
 105 derive class iTask UserLED, Long, Pin, Button, AnalogPin, DigitalPin, PinMode, MTaskDeviceSpec
 106 derive gEditor BCValue
 107 derive gText BCValue
 108 derive JSONEncode BCValue
 109 derive JSONDecode BCValue
 110 derive gDefault BCValue
 111 derive gEq BCValue
 112
 113 :: ByteCode a p = BC (RWS () [BC] BCState ())
 114
 115 :: BCShare = {
 116                 sdsi :: Int,
 117                 sdspub :: Bool,
 118                 sdsval :: BCValue
 119         }
 120
 121 :: BCState = {
 122                 freshl :: [Int],
 123                 freshs :: [Int],
 124                 sdss :: [BCShare]
 125         }
 126 instance zero BCState
 127
 128 class toByteCode a :: a -> String
 129 class fromByteCode a :: String -> a
 130 class mTaskType a | toByteCode, fromByteCode, iTask, TC a
 131
 132 instance toByteCode Int, Bool, Char, Long, String, Button, UserLED, BCValue
 133 instance fromByteCode Int, Bool, Char, Long, String, Button, UserLED, BCValue
 134 instance toByteCode MTaskInterval
 135 instance fromByteCode MTaskInterval, MTaskDeviceSpec
 136
 137 instance arith ByteCode
 138 instance boolExpr ByteCode
 139 instance analogIO ByteCode
 140 instance digitalIO ByteCode
 141 instance userLed ByteCode
 142 instance If ByteCode Stmt Stmt Stmt
 143 instance If ByteCode e Stmt Stmt
 144 instance If ByteCode Stmt e Stmt
 145 instance If ByteCode x y Stmt
 146 instance IF ByteCode
 147 instance noOp ByteCode
 148 instance retrn ByteCode
 149
 150 instance sds ByteCode
 151 instance assign ByteCode
 152 instance seq ByteCode
 153 instance serial ByteCode
 154
 155 toMessages :: MTaskInterval (Main (ByteCode a b)) BCState -> ([MTaskMSGSend], BCState)
 156
 157 toByteVal :: BC -> String
 158 toReadableByteCode :: (ByteCode a b) BCState -> (String, BCState)
 159 toRealByteCode :: (ByteCode a b) BCState -> (String, BCState)