Merge branch 'master' of gitlab.science:mlubbers/mTask

diff --git a/Devices/mTaskDevice.dcl b/Devices/mTaskDevice.dcl
index dc097f5..bae443e 100644 (file)
--- a/Devices/mTaskDevice.dcl
+++ b/Devices/mTaskDevice.dcl
@@ -25,6 +25,7 @@ derive consName MTaskResource, TCPSettings
                , deviceError :: Maybe String
                , deviceChannels :: String
                , deviceName :: String
+               , deviceState :: BCState
                , deviceTasks :: [MTaskTask]
                , deviceData :: MTaskResource
                , deviceSpec :: Maybe MTaskDeviceSpec

diff --git a/Devices/mTaskDevice.icl b/Devices/mTaskDevice.icl
index 0a6ab0f..f4789cc 100644 (file)
--- a/Devices/mTaskDevice.icl
+++ b/Devices/mTaskDevice.icl
@@ -44,6 +44,7 @@ makeDevice name res = get randomInt @ \rand->{MTaskDevice
                ,deviceTasks=[]
                ,deviceTask=Nothing
                ,deviceError=Nothing
+               ,deviceState=zero
                ,deviceData=res
                ,deviceSpec=Nothing
                ,deviceShares=[]}

diff --git a/Shares/mTaskShare.dcl b/Shares/mTaskShare.dcl
index 57855c1..2ba97cb 100644 (file)
--- a/Shares/mTaskShare.dcl
+++ b/Shares/mTaskShare.dcl
@@ -6,6 +6,7 @@ import mTask
 import Devices.mTaskDevice
 
 derive class iTask MTaskShare
+derive gPrint BCState
 
 :: MTaskShare =
                {withTask :: [String]

diff --git a/Shares/mTaskShare.icl b/Shares/mTaskShare.icl
index 81ebb8b..43350e1 100644 (file)
--- a/Shares/mTaskShare.icl
+++ b/Shares/mTaskShare.icl
@@ -68,6 +68,9 @@ makeShare withTask identifier value = {MTaskShare
                }
 
 import GenPrint, StdMisc, StdDebug, TTY
+
+gPrint{|BCState|} x st = gPrint{|*|} "BCState..." st
+
 derive gPrint MTaskDevice, MTaskShare, Maybe, MTaskResource, MTaskTask, TaskId, TTYSettings, TCPSettings, DateTime
 derive gPrint Parity, BaudRate, ByteSize
 

diff --git a/Tasks/mTaskTask.dcl b/Tasks/mTaskTask.dcl
index 0beddf2..f5976d3 100644 (file)
--- a/Tasks/mTaskTask.dcl
+++ b/Tasks/mTaskTask.dcl
@@ -13,4 +13,4 @@ derive class iTask MTaskTask, MTaskInterval, Main, ByteCode, Stmt, Expr, BC, BCS
        }
 
 makeTask :: String Int -> Task MTaskTask
-sendTaskToDevice :: String (Main (ByteCode a Stmt)) (MTaskDevice, MTaskInterval) -> Task ()
+sendTaskToDevice :: String (Main (ByteCode a Stmt)) (MTaskDevice, MTaskInterval) -> Task [MTaskDevice]

diff --git a/Tasks/mTaskTask.icl b/Tasks/mTaskTask.icl
index 27edc82..dcd0b8a 100644 (file)
--- a/Tasks/mTaskTask.icl
+++ b/Tasks/mTaskTask.icl
@@ -12,23 +12,15 @@ makeTask :: String Int -> Task MTaskTask
 makeTask name ident = get currentDateTime 
        @ \dt->{MTaskTask | name=name,ident=ident,dateAdded=dt}
 
-sendTaskToDevice :: String (Main (ByteCode a Stmt)) (MTaskDevice, MTaskInterval) -> Task ()
-sendTaskToDevice wta mTask (device, timeout) =
-               get bcStateStore @ toMessages timeout mTask
-       >>= \(msgs, st1)->set st1 bcStateStore
-       >>| toSDSRecords msgs st1 device
-       >>= \sdss->updateShares device ((++) sdss)
+sendTaskToDevice :: String (Main (ByteCode a Stmt)) (MTaskDevice, MTaskInterval) -> Task [MTaskDevice]
+sendTaskToDevice wta mTask (device, timeout)
+# (msgs, newState) = toMessages timeout mTask device.deviceState
+# shares = [makeShare wta sdsi sdsval\\{sdsi,sdsval}<-newState.sdss, (MTSds sdsi` _)<-msgs | sdsi == sdsi`] 
+= updateShares device ((++) shares)
        >>| sendMessages msgs device
        >>| makeTask wta -1
-       >>= withDevices device o addTask
-       @! ()
+       >>= withDevices device o addTaskUpState newState
        where
-               sharename i = device.deviceChannels +++ "-" +++ toString i
-
-               toSDSRecords :: [MTaskMSGSend] BCState MTaskDevice -> Task [MTaskShare]
-               toSDSRecords s st device = treturn 
-                       [makeShare wta sdsi sdsval
-                       \\{sdsi,sdsval}<-st.sdss, (MTSds sdsi` _)<-s | sdsi == sdsi`]
-
-               addTask :: MTaskTask MTaskDevice -> MTaskDevice
-               addTask task device = {device & deviceTasks=[task:device.deviceTasks]}
+               addTaskUpState :: BCState MTaskTask MTaskDevice -> MTaskDevice
+               addTaskUpState st task device = { MTaskDevice | device &
+                       deviceState=st, deviceTasks=[task:device.deviceTasks]}

diff --git a/Utils/SDS.icl b/Utils/SDS.icl
index 3cd2566..9975d27 100644 (file)
--- a/Utils/SDS.icl
+++ b/Utils/SDS.icl
@@ -10,6 +10,8 @@ import qualified Data.Map as DM
 from Data.Func import $
 import Data.Tuple
 
+import StdDebug
+
 memoryShare :: String a -> Shared a | iTask a
 memoryShare s d = sdsFocus s $ memoryStore s $ Just d
 
@@ -30,9 +32,11 @@ where
        | ident == -1 = (merr $> const True, iw)
        = case find ((==)dev) w of
                Nothing = (Error $ exception "Device doesn't exist anymore", iw)
-               Just {deviceShares} = case find (\{identifier}->identifier == ident) deviceShares of
+               Just {deviceShares} = case find (\d->d.identifier == ident) deviceShares of
                        Nothing = (Error $ exception $ "deviceStore: Share doesn't exist: " +++ toString ident, iw)
-                       Just s = case sendMessagesIW [MTUpd ident s.MTaskShare.value] dev iw of
+                       Just s
+                       | not $ trace_tn "Really sending a message from a share update" = undef
+                       = case sendMessagesIW [MTUpd ident s.MTaskShare.value] dev iw of
                                (Error e, iw) = (Error e, iw)
                                (Ok _, iw) = (Ok $ lens mi, iw)