merge

diff --git a/CleanSerial b/CleanSerial
index bfa6a41..ef64133 160000 (submodule)
--- a/CleanSerial
+++ b/CleanSerial
@@ -1 +1 @@
-Subproject commit bfa6a41e5ecfb2e11e9e389b6bb6720fda7f1ebb
+Subproject commit ef6413393c66231637cc89c252c28e866a46f14b

diff --git a/Devices/mTaskDevice.dcl b/Devices/mTaskDevice.dcl
index f254a22..c489d01 100644 (file)
--- a/Devices/mTaskDevice.dcl
+++ b/Devices/mTaskDevice.dcl
@@ -10,12 +10,10 @@ 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
 
-
-channels :: MTaskDevice -> Shared Channels
 :: Channels :== ([MTaskMSGRecv], [MTaskMSGSend], Bool)
 
 :: MTaskResource 
@@ -40,6 +38,7 @@ startupDevices :: Task [MTaskDevice]
 connectDevice :: (MTaskDevice (Shared Channels) -> Task ()) MTaskDevice -> Task ()
 manageDevices :: (MTaskDevice (Shared Channels) -> Task ()) [MTaskDevice] -> Task ()
 sendToDevice :: String (Main (ByteCode () Stmt)) (MTaskDevice, MTaskInterval) -> Task ()
+sendMessages :: [MTaskMSGSend] -> (MTaskDevice -> Task Channels)
 
 deviceTaskDelete :: MTaskDevice MTaskTask -> Task ()
 deviceTaskAcked :: MTaskDevice Int -> Task ()

diff --git a/Devices/mTaskDevice.icl b/Devices/mTaskDevice.icl
index 58dd5ed..b3f3e85 100644 (file)
--- a/Devices/mTaskDevice.icl
+++ b/Devices/mTaskDevice.icl
@@ -8,6 +8,7 @@ import iTasksTTY
 import TTY
 import qualified Data.Map as DM
 import Utils.SDS
+import Utils.Devices
 
 import GenBimap
 import Devices.mTaskSerial
@@ -17,16 +18,13 @@ import iTasks.UI.Definition, iTasks.UI.Editor, iTasks.UI.Editor.Builtin, iTasks.
 
 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
 
 instance == MTaskDevice where
        (==) a b = a.deviceChannels == b.deviceChannels
 
-channels :: MTaskDevice -> Shared Channels
-channels d = memoryShare d.deviceChannels ([], [], False)
-
 startupDevices :: Task [MTaskDevice]
 startupDevices = upd (map reset) deviceStore
        where reset d = {d & deviceTask=Nothing, deviceTasks=[], deviceError=Nothing}
@@ -99,28 +97,29 @@ 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
+       >>| sendMessages msgs device
        >>| makeTask wta -1
        >>= withDevices device o addTask
        @! ()
        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
                addTask task device = {device & deviceTasks=[task:device.deviceTasks]}
 
-sendMessage :: MTaskDevice [MTaskMSGSend] -> Task ()
-sendMessage dev msgs = upd (\(r,s,ss)->(r,msgs++s,ss)) (channels dev) @! ()
+sendMessages :: [MTaskMSGSend] -> (MTaskDevice -> Task Channels)
+sendMessages msgs = upd (\(r,s,ss)->(r,msgs++s,ss)) o channels
 
 withDevices :: MTaskDevice (MTaskDevice -> MTaskDevice) -> Task ()
 withDevices a trans = upd (map \b->if (b == a) (trans b) b) deviceStore @! ()
@@ -135,7 +134,7 @@ deviceTaskAcked dev i
                        [{t & ident=i}:ts] [t:ackFirst ts]
 
 deviceTaskDelete :: MTaskDevice MTaskTask -> Task ()
-deviceTaskDelete dev task = sendMessage dev [MTTaskDel task.ident]
+deviceTaskDelete dev task = sendMessages [MTTaskDel task.ident] dev @! ()
 
 deviceTaskDeleteAcked :: MTaskDevice Int -> Task ()
 deviceTaskDeleteAcked d i = withDevices d $ deleteTask

diff --git a/Shares/mTaskShare.icl b/Shares/mTaskShare.icl
index 0bb6265..1e9294c 100644 (file)
--- a/Shares/mTaskShare.icl
+++ b/Shares/mTaskShare.icl
@@ -1,17 +1,29 @@
 implementation module Shares.mTaskShare
 
 import Utils.SDS
+import Utils.Devices
 import iTasks
+import mTask
 from Data.Func import $
 
 manageShares :: [MTaskShare] -> Task ()
 manageShares shares = forever (enterChoice "Choose share to update" [ChooseFromGrid id] shares
        >&^ \st->whileUnchanged st $ \msh->case msh of
                Nothing = viewShares shares @! zero
-               Just sh = viewSharedInformation "View value" [] (getSDSStore sh)
-                       >>= \_->return sh
+               Just sh = forever (
+                               viewSharedInformation "View value" [] (getSDSStore sh)
+                       >>* [OnAction (Action "Update") (withValue (Just o updateInformation "New value" []))]
+                       >>= updateShare sh
+                       )
+                       
        ) @! ()
 
+updateShare :: MTaskShare a -> Task MTaskShare | toByteCode a
+updateShare sh=:{withTask,identifier} a = getDeviceByName withTask
+       >>= sendMessages [MTUpd identifier $ toString $ toByteCode a]
+       >>| treturn sh
+
+
 viewShares :: [MTaskShare] -> Task ()
 viewShares sh = anyTask (map viewShare sh) <<@ ArrangeHorizontal @! ()
 

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/Utils/Devices.dcl b/Utils/Devices.dcl
new file mode 100644 (file)
index 0000000..d816d3f
--- /dev/null
+++ b/Utils/Devices.dcl
@@ -0,0 +1,7 @@
+definition module Utils.Devices
+
+import iTasks
+import Devices.mTaskDevice
+
+getDeviceByName :: String -> Task MTaskDevice
+channels :: MTaskDevice -> Shared Channels

diff --git a/Utils/Devices.icl b/Utils/Devices.icl
new file mode 100644 (file)
index 0000000..6a8052e
--- /dev/null
+++ b/Utils/Devices.icl
@@ -0,0 +1,14 @@
+implementation module Utils.Devices
+
+import iTasks
+import mTask
+import Utils.SDS
+import Data.List
+
+getDeviceByName :: String -> Task MTaskDevice
+getDeviceByName nm = get deviceStore @ find (\d->d.deviceChannels == nm)
+       >>= maybe (throw "Help, device not found") treturn
+
+channels :: MTaskDevice -> Shared Channels
+channels d = memoryShare d.deviceChannels ([], [], False)
+

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)]