clean up share code and only show published tasks

diff --git a/Devices/mTaskDevice.dcl b/Devices/mTaskDevice.dcl
index 6a717f0..213fccb 100644 (file)
--- a/Devices/mTaskDevice.dcl
+++ b/Devices/mTaskDevice.dcl
@@ -9,7 +9,7 @@ import mTaskInterpret
 import Generics.gCons
 import iTasksTTY
 
-derive class iTask MTaskDevice, MTaskResource, MTaskMSGRecv, MTaskMSGSend
+derive class iTask MTaskDevice, MTaskResource, MTaskMSGRecv, MTaskMSGSend, BCShare
 derive conses MTaskResource, TCPSettings
 derive consName MTaskResource, TCPSettings
 

diff --git a/Devices/mTaskDevice.icl b/Devices/mTaskDevice.icl
index bb5b353..6a8c369 100644 (file)
--- a/Devices/mTaskDevice.icl
+++ b/Devices/mTaskDevice.icl
@@ -16,7 +16,7 @@ import iTasks._Framework.Store
 
 from Data.Func import $
 
-derive class iTask MTaskDevice, MTaskResource, MTaskMSGRecv, MTaskMSGSend
+derive class iTask MTaskDevice, MTaskResource, MTaskMSGRecv, MTaskMSGSend, BCShare
 derive conses MTaskResource, TTYSettings, BaudRate, Parity, ByteSize, TCPSettings
 derive consName MTaskResource, TTYSettings, BaudRate, Parity, ByteSize, TCPSettings
 
@@ -85,7 +85,7 @@ deleteDevice d = upd (\(r,s,ss)->(r,s,True)) (channels d)
 sendToDevice :: String (Main (ByteCode () Stmt)) (MTaskDevice, MTaskInterval) -> Task ()
 sendToDevice wta mTask (device, timeout) =
                get bcStateStore @ toMessages timeout o toRealByteCode (unMain mTask)
-       >>= \(msgs, st1)->set st1 bcStateStore @ toSDSRecords
+       >>= \(msgs, st1)->set st1 bcStateStore @ toSDSRecords 
        >>= \sdss->set sdss sdsStore//MTaskShareaddToSDSShare
        >>| makeShares sdss
        >>| sendMessage device msgs
@@ -95,11 +95,12 @@ sendToDevice wta mTask (device, timeout) =
        where
                sharename i = device.deviceChannels +++ "-" +++ toString i
                toSDSRecords st = [{MTaskShare |
-                       initValue=toInt d1*265 + toInt d2,
+                       initValue=toInt (sdsval!!0)*265 + toInt (sdsval!!1),
                        withTask=wta,
-                       identifier=i,
-                       realShare="mTaskSDS-" +++ toString i}
-                               \\(i,[d1,d2])<-st.sdss]
+                       identifier=sdsi,
+                       //We skip the only/local shares
+                       realShare="mTaskSDS-" +++ toString sdsi}
+                               \\{sdsi,sdspub,sdsval}<-st.sdss | sdspub]
                makeShares = foldr (\sh t->set sh.initValue (getSDSStore sh) >>| t) (treturn ())
 
                addTask :: MTaskTask MTaskDevice -> MTaskDevice

diff --git a/Tasks/Examples.icl b/Tasks/Examples.icl
index 7d872ef..b2a79de 100644 (file)
--- a/Tasks/Examples.icl
+++ b/Tasks/Examples.icl
@@ -3,9 +3,10 @@ implementation module Tasks.Examples
 import qualified Data.Map as DM
 import mTask
 
+import Devices.mTaskDevice
 import iTasks._Framework.Serialization
 
-derive class iTask UserLED, Main, ByteCode, Stmt, BC, BCState
+derive class iTask UserLED
 
 countAndLed :: Main (ByteCode () Stmt)
 countAndLed = sds \x=1 In sds \pinnetje=1 In {main =

diff --git a/Tasks/mTaskTask.dcl b/Tasks/mTaskTask.dcl
index ef46243..94bcc8a 100644 (file)
--- a/Tasks/mTaskTask.dcl
+++ b/Tasks/mTaskTask.dcl
@@ -1,5 +1,6 @@
 definition module Tasks.mTaskTask
 
+import Devices.mTaskDevice
 import mTask
 import iTasks
 

diff --git a/mTaskInterpret.dcl b/mTaskInterpret.dcl
index 2701fcf..17034be 100644 (file)
--- a/mTaskInterpret.dcl
+++ b/mTaskInterpret.dcl
@@ -80,10 +80,16 @@ decode :: String -> MTaskMSGRecv
 instance Semigroup (ByteCode a p)
 instance Monoid (ByteCode a p)
 
+:: BCShare = {
+               sdsi :: Int,
+               sdspub :: Bool,
+               sdsval :: [Char]
+       }
+
 :: BCState = {
                freshl :: [Int],
                freshs :: [Int],
-               sdss :: [(Int, [Char])]
+               sdss :: [BCShare]
        }
 instance zero BCState
 

diff --git a/mTaskInterpret.icl b/mTaskInterpret.icl
index 3f57e7d..acbff39 100644 (file)
--- a/mTaskInterpret.icl
+++ b/mTaskInterpret.icl
@@ -180,9 +180,9 @@ instance digitalIO ByteCode where
        digitalRead p = retrn [BCDigitalRead $ pin p]
        digitalWrite p b = b <+-> [BCDigitalWrite $ 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
 instance If ByteCode x y Stmt where If b t e = BCIfStmt b t e
 instance IF ByteCode where
        IF b t e = BCIfStmt b t e
@@ -203,7 +203,8 @@ withSDS f = BC \s->let [fresh:fs] = s.freshs
        in runBC (f fresh) {s & freshs=fs}
 
 setSDS :: Int v -> ByteCode b q | toByteCode v
-setSDS ident val = BC \s->([], {s & sdss = [(ident, toByteCode val):s.sdss]})
+setSDS ident val = BC \s->([], {s & sdss=[
+       {BCShare|sdsi=ident,sdspub=False,sdsval=toByteCode val}:s.sdss]})
 
 instance sds ByteCode where
        sds f = {main = withSDS \sds->
@@ -211,20 +212,15 @@ instance sds ByteCode where
                        in setSDS sds v <++> unMain body
                }
        con f = undef
-       pub x = fmp makePub x
+       pub x = BC \s-> let ((i, bc), s`) = appFst makePub $ runBC x s 
+                       in  (bc, {s` & sdss=map (publish i) s`.sdss})
+               where
+                       publish i s = if (i == s.sdsi) {s & sdspub=True} s
+                       makePub [BCSdsFetch i:xs] = (i, [BCSdsPublish i:xs])
 
 instance assign ByteCode where
        (=.) v e = e <++> fmp makeStore v
-
-makePub [] = []
-makePub [x:xs] = case x of
-       BCSdsFetch i = [BCSdsPublish i:xs]
-       y = [y:xs]
-
-makeStore [] = []
-makeStore [x:xs] = case x of
-       BCSdsFetch i = [BCSdsStore i:xs]
-       y = [y:xs]
+               where makeStore [BCSdsFetch i:xs] = [BCSdsStore i:xs]
 
 instance seq ByteCode where
        (>>=.) _ _ = abort "undef on >>=."
@@ -275,7 +271,9 @@ toReadableByteCode x
 = (join "\n" $ map readable (map (implGotos gtmap) bc), st)
 
 toMessages :: MTaskInterval (String, BCState) -> ([MTaskMSGSend], BCState)
-toMessages interval (bytes, st=:{sdss}) = ([MTSds i (toString b)\\(i,b)<-sdss] ++ [MTTask interval bytes], st)
+toMessages interval (bytes, st=:{sdss}) = (
+       [MTSds s.sdsi (toString s.sdsval)\\s<-sdss] ++
+       [MTTask interval bytes], st)
 
 toSDSUpdate :: Int Int -> [MTaskMSGSend]
 toSDSUpdate i v = [MTUpd i (to16bit v)]