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         | MTShutdown
  27         | MTSds Int BCValue
  28         | MTUpd Int BCValue
  29         | MTSpec
  30
  31 :: MTaskInterval
  32         = OneShot
  33         | OnInterval Int
  34         | OnInterrupt Int
  35
  36 :: MTaskDeviceSpec =
  37                 {haveLed     :: Bool
  38                 ,haveAio     :: Bool
  39                 ,haveDio     :: Bool
  40                 ,aPins       :: Int
  41                 ,dPins       :: Int
  42                 ,stackSize   :: Int
  43                 ,bytesMemory :: Int
  44         }
  45
  46 :: BCValue = E.e: BCValue e & mTaskType, TC e
  47
  48 instance == BCValue
  49
  50 instance toString MTaskInterval
  51 instance toString MTaskMSGRecv
  52 instance toString MTaskMSGSend
  53 encode :: MTaskMSGSend -> String
  54 decode :: String -> MTaskMSGRecv
  55
  56 :: BC
  57         = BCNop
  58         | BCLab Int
  59         | BCPush BCValue
  60 //      | BCPush String
  61         | BCPop
  62         //SDS functions
  63         | BCSdsStore BCShare
  64         | BCSdsFetch BCShare
  65         | BCSdsPublish BCShare
  66         //Unary ops
  67         | BCNot
  68         //Binary Int ops
  69         | BCAdd
  70         | BCSub
  71         | BCMul
  72         | BCDiv
  73         //Binary Bool ops
  74         | BCAnd
  75         | BCOr
  76         //Binary ops
  77         | BCEq
  78         | BCNeq
  79         | BCLes
  80         | BCGre
  81         | BCLeq
  82         | BCGeq
  83         //Conditionals and jumping
  84         | BCJmp Int
  85         | BCJmpT Int
  86         | BCJmpF Int
  87         //UserLED
  88         | BCLedOn
  89         | BCLedOff
  90         //Serial
  91         | BCSerialAvail
  92         | BCSerialPrint
  93         | BCSerialPrintln
  94         | BCSerialRead
  95         | BCSerialParseInt
  96         //Pins
  97         | BCAnalogRead Pin
  98         | BCAnalogWrite Pin
  99         | BCDigitalRead Pin
 100         | BCDigitalWrite Pin
 101         //Return
 102         | BCReturn
 103
 104 derive gPrint BCValue, MTaskDeviceSpec
 105 derive consIndex BCValue
 106 derive consName BCValue
 107 derive conses BCValue
 108 derive consNum BCValue
 109
 110 derive class gCons Long, UserLED, Button, AnalogPin, DigitalPin, PinMode, Pin
 111 derive class iTask UserLED, Long, Pin, Button, AnalogPin, DigitalPin, PinMode, MTaskDeviceSpec
 112 derive gEditor BCValue
 113 derive gText BCValue
 114 derive JSONEncode BCValue
 115 derive JSONDecode BCValue
 116 derive gDefault BCValue
 117 derive gEq BCValue
 118
 119 :: ByteCode a p = BC (RWS () [BC] BCState ())
 120
 121 :: BCShare =
 122         { sdsi :: Int
 123         , sdsval :: BCValue
 124         , sdsname :: String
 125         }
 126
 127 :: BCState = {
 128                 freshl :: Int,
 129                 freshs :: Int,
 130                 sdss :: [BCShare]
 131         }
 132 instance zero BCState
 133
 134 class toByteCode a :: a -> String
 135 class fromByteCode a :: String -> a
 136 class mTaskType a | toByteCode, fromByteCode, iTask, TC a
 137
 138 instance toByteCode Int, Bool, Char, Long, String, Button, UserLED, BCValue
 139 instance fromByteCode Int, Bool, Char, Long, String, Button, UserLED, BCValue
 140 instance toByteCode MTaskInterval
 141 instance fromByteCode MTaskInterval, MTaskDeviceSpec
 142
 143 instance arith ByteCode
 144 instance boolExpr ByteCode
 145 instance analogIO ByteCode
 146 instance digitalIO ByteCode
 147 instance aIO ByteCode
 148 instance dIO ByteCode
 149 instance userLed ByteCode
 150 instance If ByteCode Stmt Stmt Stmt
 151 instance If ByteCode e Stmt Stmt
 152 instance If ByteCode Stmt e Stmt
 153 instance If ByteCode x y Stmt
 154 instance IF ByteCode
 155 instance noOp ByteCode
 156 instance retrn ByteCode
 157
 158 instance sds ByteCode
 159 instance sdspub ByteCode
 160 instance assign ByteCode
 161 instance seq ByteCode
 162 instance serial ByteCode
 163
 164 toMessages :: MTaskInterval (Main (ByteCode a b)) BCState -> ([MTaskMSGSend], BCState)
 165
 166 toByteVal :: BC -> String
 167 toReadableByteCode :: (ByteCode a b) BCState -> (String, BCState)
 168 toRealByteCode :: (ByteCode a b) BCState -> (String, BCState)