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 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         | BCEq
  71         | BCNeq
  72         | BCLes
  73         | BCGre
  74         | BCLeq
  75         | BCGeq
  76         //Conditionals and jumping
  77         | BCJmp Int
  78         | BCJmpT Int
  79         | BCJmpF Int
  80         //UserLED
  81         | BCLedOn
  82         | BCLedOff
  83         //Serial
  84         | BCSerialAvail
  85         | BCSerialPrint
  86         | BCSerialPrintln
  87         | BCSerialRead
  88         | BCSerialParseInt
  89         //Pins
  90         | BCAnalogRead Pin
  91         | BCAnalogWrite Pin
  92         | BCDigitalRead Pin
  93         | BCDigitalWrite Pin
  94         //Return
  95         | BCReturn
  96
  97 derive gPrint BCValue, MTaskDeviceSpec
  98 derive consIndex BCValue
  99 derive consName BCValue
 100 derive conses BCValue
 101 derive consNum BCValue
 102
 103 derive class gCons Long, UserLED, Button, AnalogPin, DigitalPin, PinMode, Pin
 104 derive class iTask UserLED, Long, Pin, Button, AnalogPin, DigitalPin, PinMode, MTaskDeviceSpec
 105 derive gEditor BCValue
 106 derive gText BCValue
 107 derive JSONEncode BCValue
 108 derive JSONDecode BCValue
 109 derive gDefault BCValue
 110 derive gEq BCValue
 111
 112 :: ByteCode a p = BC (RWS () [BC] BCState ())
 113
 114 :: BCShare = {
 115                 sdsi :: Int,
 116                 sdspub :: Bool,
 117                 sdsval :: BCValue
 118         }
 119
 120 :: BCState = {
 121                 freshl :: [Int],
 122                 freshs :: [Int],
 123                 sdss :: [BCShare]
 124         }
 125 instance zero BCState
 126
 127 class toByteCode a :: a -> String
 128 class fromByteCode a :: String -> a
 129 class mTaskType a | toByteCode, fromByteCode, iTask, TC a
 130
 131 instance toByteCode Int, Bool, Char, Long, String, Button, UserLED, BCValue
 132 instance fromByteCode Int, Bool, Char, Long, String, Button, UserLED, BCValue
 133 instance toByteCode MTaskInterval
 134 instance fromByteCode MTaskInterval, MTaskDeviceSpec
 135
 136 instance arith ByteCode
 137 instance boolExpr ByteCode
 138 instance analogIO ByteCode
 139 instance digitalIO ByteCode
 140 instance userLed ByteCode
 141 instance If ByteCode Stmt Stmt Stmt
 142 instance If ByteCode e Stmt Stmt
 143 instance If ByteCode Stmt e Stmt
 144 instance If ByteCode x y Stmt
 145 instance IF ByteCode
 146 instance noOp ByteCode
 147 instance retrn ByteCode
 148
 149 instance sds ByteCode
 150 instance assign ByteCode
 151 instance seq ByteCode
 152 instance serial ByteCode
 153
 154 toMessages :: MTaskInterval (Main (ByteCode a b)) BCState -> ([MTaskMSGSend], BCState)
 155
 156 toByteVal :: BC -> String
 157 toReadableByteCode :: (ByteCode a b) BCState -> (String, BCState)
 158 toRealByteCode :: (ByteCode a b) BCState -> (String, BCState)