separate share publishing from share class

[mTask.git] / mTaskInterpret.icl

diff --git a/mTaskInterpret.icl b/mTaskInterpret.icl
index ef75b9a..697ce50 100644 (file)
--- a/mTaskInterpret.icl
+++ b/mTaskInterpret.icl
@@ -40,12 +40,15 @@ import Text.Encodings.Base64
 
 import Tasks.Examples
 
 
 import Tasks.Examples
 

+instance == BCValue where (==) a b = toByteCode a == toByteCode b
+

 encode :: MTaskMSGSend -> String
 encode (MTTask to data) = "t" +++ toByteCode to +++ to16bit (size data) +++ data +++ "\n"
 encode (MTTaskDel i) = "d" +++ to16bit i +++ "\n"
 encode (MTSds i v) = "s" +++ to16bit i +++ toByteCode v +++ "\n"
 encode (MTUpd i v) = "u" +++ to16bit i +++ toByteCode v +++ "\n"
 encode (MTSpec) = "c\n"
 encode :: MTaskMSGSend -> String
 encode (MTTask to data) = "t" +++ toByteCode to +++ to16bit (size data) +++ data +++ "\n"
 encode (MTTaskDel i) = "d" +++ to16bit i +++ "\n"
 encode (MTSds i v) = "s" +++ to16bit i +++ toByteCode v +++ "\n"
 encode (MTUpd i v) = "u" +++ to16bit i +++ toByteCode v +++ "\n"
 encode (MTSpec) = "c\n"

+encode (MTShutdown) = "h\n"

 
 import StdDebug
 decode :: String -> MTaskMSGRecv
 
 import StdDebug
 decode :: String -> MTaskMSGRecv


@@ -53,7 +56,7 @@ decode x
 | not (trace_tn ("decoding: " +++ toString (toJSON x))) = undef
 | size x == 0 = MTEmpty
 = case x.[0] of
 | not (trace_tn ("decoding: " +++ toString (toJSON x))) = undef
 | size x == 0 = MTEmpty
 = case x.[0] of

-       't' = MTTaskAck $ fromByteCode x
+       't' = MTTaskAck (fromByteCode x) (fromByteCode (x % (2, size x)))

        'd' = MTTaskDelAck $ fromByteCode x
        'm' = MTMessage x
        's' = MTSDSAck $ fromByteCode x
        'd' = MTTaskDelAck $ fromByteCode x
        'm' = MTMessage x
        's' = MTSDSAck $ fromByteCode x


@@ -79,9 +82,12 @@ instance toString MTaskMSGSend where
        toString (MTTaskDel i) = "Task delete request: " +++ toString i
        toString (MTUpd i v) = "Update id: " +++ toString i
                +++ " value " +++ safePrint v
        toString (MTTaskDel i) = "Task delete request: " +++ toString i
        toString (MTUpd i v) = "Update id: " +++ toString i
                +++ " value " +++ safePrint v

+       toString (MTSpec) = "Spec request"
+       toString (MTShutdown) = "Shutdown request"

 
 instance toString MTaskMSGRecv where
 
 instance toString MTaskMSGRecv where

-       toString (MTTaskAck i) = "Task added with id: " +++ toString i
+       toString (MTTaskAck i mem) = "Task added with id: " +++ toString i
+               +++ " free memory: " +++ toString mem

        toString (MTTaskDelAck i) = "Task deleted with id: " +++ toString i
        toString (MTSDSAck i) = "SDS added with id: " +++ toString i
        toString (MTSDSDelAck i) = "SDS deleted with id: " +++ toString i
        toString (MTTaskDelAck i) = "Task deleted with id: " +++ toString i
        toString (MTSDSAck i) = "SDS added with id: " +++ toString i
        toString (MTSDSDelAck i) = "SDS deleted with id: " +++ toString i


@@ -96,9 +102,9 @@ toByteVal b = {toChar $ consIndex{|*|} b} +++
        case b of
                (BCPush (BCValue i)) = toByteCode i
                (BCLab i) = {toChar i}
        case b of
                (BCPush (BCValue i)) = toByteCode i
                (BCLab i) = {toChar i}

-               (BCSdsStore i) = to16bit i
-               (BCSdsFetch i) = to16bit i
-               (BCSdsPublish i) = to16bit i
+               (BCSdsStore i) = to16bit i.sdsi
+               (BCSdsFetch i) = to16bit i.sdsi
+               (BCSdsPublish i) = to16bit i.sdsi

                (BCAnalogRead i) = {toChar $ consIndex{|*|} i}
                (BCAnalogWrite i) = {toChar $ consIndex{|*|} i}
                (BCDigitalRead i) = {toChar $ consIndex{|*|} i}
                (BCAnalogRead i) = {toChar $ consIndex{|*|} i}
                (BCAnalogWrite i) = {toChar $ consIndex{|*|} i}
                (BCDigitalRead i) = {toChar $ consIndex{|*|} i}


@@ -120,7 +126,7 @@ parseBCValue c s = case c of
 castfbc :: a -> (String -> a) | mTaskType a
 castfbc _ = fromByteCode
 
 castfbc :: a -> (String -> a) | mTaskType a
 castfbc _ = fromByteCode
 

-instance toByteCode Bool where toByteCode b = {#'b',if b '\x01' '\0'}
+instance toByteCode Bool where toByteCode b = {'b',if b '\x01' '\0'}

 instance toByteCode Int where toByteCode n = {'i',toChar $ n/256,toChar $ n rem 256}
 instance toByteCode Long where toByteCode (L n) = {'l',toChar $ n/256,toChar $ n rem 256}
 instance toByteCode Char where toByteCode c = {'c',c}
 instance toByteCode Int where toByteCode n = {'i',toChar $ n/256,toChar $ n rem 256}
 instance toByteCode Long where toByteCode (L n) = {'l',toChar $ n/256,toChar $ n rem 256}
 instance toByteCode Char where toByteCode c = {'c',c}


@@ -158,12 +164,11 @@ instance fromByteCode MTaskDeviceSpec where
                |haveLed=(c bitand 1) > 0
                ,haveAio=(c bitand 2) > 0
                ,haveDio=(c bitand 4) > 0
                |haveLed=(c bitand 1) > 0
                ,haveAio=(c bitand 2) > 0
                ,haveDio=(c bitand 4) > 0

-               ,maxTask=from16bit $ s % (1,3)
-               ,maxSDS=from16bit $ s % (3,5)
+               ,bytesMemory=from16bit $ s % (1,3)

                }
 
 derive gPrint Long, UserLED, Button, AnalogPin, DigitalPin, PinMode, Pin, BC, MTaskDeviceSpec
                }
 
 derive gPrint Long, UserLED, Button, AnalogPin, DigitalPin, PinMode, Pin, BC, MTaskDeviceSpec

-derive class gCons BC
+derive class gCons BC, BCShare

 
 consIndex{|BCValue|} _ = 0
 consName{|BCValue|} _ = "BCValue"
 
 consIndex{|BCValue|} _ = 0
 consName{|BCValue|} _ = "BCValue"


@@ -193,12 +198,13 @@ gEq{|BCValue|} (BCValue e) (BCValue f) = toByteCode e == toByteCode f
 derive class gCons Long, UserLED, Button, AnalogPin, DigitalPin, PinMode, Pin
 derive class iTask UserLED, Long, Pin, Button, AnalogPin, DigitalPin, PinMode, MTaskDeviceSpec
 
 derive class gCons Long, UserLED, Button, AnalogPin, DigitalPin, PinMode, Pin
 derive class iTask UserLED, Long, Pin, Button, AnalogPin, DigitalPin, PinMode, MTaskDeviceSpec
 

-op2 :: (ByteCode a p1) (ByteCode a p2) BC -> ByteCode b Expr
+op2 :: (ByteCode a p1) (ByteCode a p2) BC -> ByteCode b p3

 op2 (BC x) (BC y) bc = BC $ x >>| y >>| tell [bc]
 
 op2 (BC x) (BC y) bc = BC $ x >>| y >>| tell [bc]
 

-op :: (ByteCode a p) BC -> ByteCode a Expr
+op :: (ByteCode a p) BC -> ByteCode b c

 op (BC x) bc = BC $ x >>| tell [bc]
 
 op (BC x) bc = BC $ x >>| tell [bc]
 

+tell` :: [BC] -> (ByteCode a p)

 tell` x = BC $ tell x
 
 instance arith ByteCode where
 tell` x = BC $ tell x
 
 instance arith ByteCode where


@@ -227,6 +233,12 @@ instance digitalIO ByteCode where
        digitalRead p = tell` [BCDigitalRead $ pin p]
        digitalWrite p b = op b (BCDigitalWrite $ pin p)
 
        digitalRead p = tell` [BCDigitalRead $ pin p]
        digitalWrite p b = op b (BCDigitalWrite $ pin p)
 

+instance aIO ByteCode where
+       aIO p = tell` [BCAnalogRead $ pin p]
+
+instance dIO ByteCode where
+       dIO p = tell` [BCDigitalRead $ pin p]
+

 instance If ByteCode Stmt Stmt Stmt where If b t e = BCIfStmt b t e
 instance If ByteCode e Stmt Stmt where If b t e = BCIfStmt b t e
 instance If ByteCode Stmt e Stmt where If b t e = BCIfStmt b t e
 instance If ByteCode Stmt Stmt Stmt where If b t e = BCIfStmt b t e
 instance If ByteCode e Stmt Stmt where If b t e = BCIfStmt b t e
 instance If ByteCode Stmt e Stmt where If b t e = BCIfStmt b t e


@@ -245,27 +257,30 @@ freshs = get >>= \st=:{freshs=[fr:frs]}->put {st & freshs=frs} >>| pure fr
 
 instance noOp ByteCode where noOp = tell` [BCNop]
 
 
 instance noOp ByteCode where noOp = tell` [BCNop]
 

+unBC :: (ByteCode a p) -> RWS () [BC] BCState ()

 unBC (BC x) = x
 
 instance sds ByteCode where
 unBC (BC x) = x
 
 instance sds ByteCode where

-       sds f = {main = BC $ freshs 
+       sds f = {main = BC $ freshs
+                               >>= \sdsi->pure {BCShare | sdsi=sdsi,sdsval=BCValue 0}

                                >>= \sds->pure (f (tell` [BCSdsFetch sds]))
                                >>= \sds->pure (f (tell` [BCSdsFetch sds]))

-                               >>= \(v In bdy)->modify (addSDS sds v) >>| unBC (unMain bdy)}
-//                             >>= \(v In bdy)->modify (addSDS sds (toByteCode v)) >>| unBC (unMain bdy)}
+                               >>= \(v In bdy)->modify (addSDS sds v)
+                               >>| unBC (unMain bdy)}

                where
                where

-                       addSDS i v s = {s & sdss=[{sdsi=i,sdspub=False,sdsval=(BCValue v)}:s.sdss]}
+                       addSDS sds v s = {s & sdss=[{sds & sdsval=BCValue v}:s.sdss]}

 
        con f = undef
 
        con f = undef

-       pub (BC x) = BC $ censor (\[BCSdsFetch s]->[BCSdsPublish s])
-                       (listen x >>= \(_, [BCSdsFetch s])->modify (publish s)) >>| tell mempty
-               where
-                       publish i st = {st & sdss=[if (i == s.sdsi) {s & sdspub=True} s \\s<-st.sdss]}
+
+instance sdspub ByteCode where
+       pub (BC x) = BC $ censor (\[BCSdsFetch s]->[BCSdsPublish s]) x

 
 instance assign ByteCode where
        (=.) (BC v) (BC e) = BC $ e >>| censor makeStore v
                where 
                        //This is going to include pins as well, as variables
                        makeStore [BCSdsFetch i] = [BCSdsStore i]
 
 instance assign ByteCode where
        (=.) (BC v) (BC e) = BC $ e >>| censor makeStore v
                where 
                        //This is going to include pins as well, as variables
                        makeStore [BCSdsFetch i] = [BCSdsStore i]

+                       makeStore [BCDigitalRead i] = [BCDigitalWrite i]
+                       makeStore [BCAnalogRead i] = [BCAnalogWrite i]

 
 instance seq ByteCode where
        (>>=.) _ _ = abort "undef on >>=."
 
 instance seq ByteCode where
        (>>=.) _ _ = abort "undef on >>=."


@@ -279,8 +294,11 @@ instance serial ByteCode where
        serialParseInt = tell` [BCSerialParseInt]
 
 instance userLed ByteCode where
        serialParseInt = tell` [BCSerialParseInt]
 
 instance userLed ByteCode where

-       ledOn  (BC l) = BC $ l >>| tell [BCLedOn]
-       ledOff (BC l) = BC $ l >>| tell [BCLedOff]
+       ledOn  l = op l BCLedOn
+       ledOff l = op l BCLedOff
+
+instance retrn ByteCode where
+  retrn = tell` [BCReturn]

 
 instance zero BCState where
        zero = {freshl=[1..], freshs=[1..], sdss=[]}
 
 instance zero BCState where
        zero = {freshl=[1..], freshs=[1..], sdss=[]}


@@ -344,15 +362,21 @@ toMessages interval x s
 instance == BCShare where (==) a b = a.sdsi == b.sdsi
 
 //Start = toMessages (OnInterval 500) $ toRealByteCode (unMain bc) zero
 instance == BCShare where (==) a b = a.sdsi == b.sdsi
 
 //Start = toMessages (OnInterval 500) $ toRealByteCode (unMain bc) zero

-Start = fst $ toReadableByteCode (unMain $ countAndLed) zero
+Start = fst $ toReadableByteCode (unMain $ bc) zero

 //Start = fst $ toReadableByteCode (unMain $ blink LED1) zero
 //Start = let (bcs, st) = toReadableByteCode (unMain bc) zero
 //             in (bcs, st.sdss)
        where
 //             bc = {main = ledOn (lit LED1)}
 //Start = fst $ toReadableByteCode (unMain $ blink LED1) zero
 //Start = let (bcs, st) = toReadableByteCode (unMain bc) zero
 //             in (bcs, st.sdss)
        where
 //             bc = {main = ledOn (lit LED1)}

-               bc = sds \x=5 In 
-                       sds \y=4 In
-                       {main = If (y ==. lit 0) (pub x) (x =. x *. y :. y =. y -. lit 1)}
+//             bc = sds \x=5 In 
+//                     sds \y=4 In
+//                     {main = If (y ==. lit 0) (pub x) (x =. x *. y :. y =. y -. lit 1)}
+               bc  = {main =
+                       IF (analogRead A0 >. lit 50)
+                         ( digitalWrite D0 (lit True)  )
+                         ( digitalWrite D0 (lit False) )
+                       }
+

 
 to16bit :: Int -> String
 to16bit i = toString (toChar (i/256)) +++ toString (toChar (i rem 256))
 
 to16bit :: Int -> String
 to16bit i = toString (toChar (i/256)) +++ toString (toChar (i rem 256))