migrate to new version

diff --git a/Devices/mTaskDevice.icl b/Devices/mTaskDevice.icl
index 2a0f17e..a91a0b3 100644 (file)
--- a/Devices/mTaskDevice.icl
+++ b/Devices/mTaskDevice.icl
@@ -81,27 +81,29 @@ addDevice processFun
 //     @! ()
 //     where
 //             errorHandle e = withDevices d (\d->{d&deviceTask=Nothing,deviceError=Just e}) @! ()
+import StdDebug
 connectDevice :: (MTaskDevice (Shared Channels) -> Task ()) MTaskDevice -> Task Channels
 connectDevice procFun device = let ch = channels device
        in traceValue "connectDevice" >>| appendTopLevelTask 'DM'.newMap True
-               (       procFun device ch 
-               -||- catchAll (getSynFun device.deviceData ch) errHdl)
+               (       procFun device ch -||- catchAll (getSynFun device.deviceData ch) errHdl)
                >>= \tid->withDevices device (\d->{d&deviceTask=Just tid,deviceError=Nothing})
                >>| upd (\(r,s,ss)->(r,s++[MTSpec],ss)) ch
        where
-               errHdl e = withDevices device (\d->{d & deviceTask=Nothing, deviceError=Just e}) @! ()
+               errHdl e
+               | not (trace_tn "error") = undef
+               = withDevices device (\d->{d & deviceTask=Nothing, deviceError=Just e}) @! ()
 
 manageDevices :: (MTaskDevice (Shared Channels) -> Task ()) -> Task ()
 manageDevices processFun = get deviceStoreNP >>= \ds->anyTask [
-               addDevice processFun <<@ Title "Add new device" @! ():
-                       [viewDevice processFun d <<@ Title d.deviceName\\d<-ds]]
+               addDevice processFun <<@ Title "Add new device" @! ()]//:
+//                     [viewDevice processFun d <<@ Title d.deviceName\\d<-ds]]
        <<@ ArrangeWithTabs
        @! ()
 
 viewDevice :: (MTaskDevice (Shared Channels) -> Task ()) MTaskDevice -> Task ()
 viewDevice pf d = forever $ traceValue "viewDevice" >>| anyTask 
                [viewInformation "Device settings" [] d @! ()
-               ,viewSharedInformation "Channels" [ViewAs dropEmpty] (channels d) @! ()
+               /*,viewSharedInformation "Channels" [ViewAs dropEmpty] (channels d) @! ()*/
                ,forever $ 
                        enterChoice "Delete task on device" [ChooseFromGrid id] d.deviceTasks
                        >>* [OnAction (Action "Delete") $ ifValue (\t->t.ident <> -1) (deviceTaskDelete d)]

diff --git a/Devices/mTaskTCP.icl b/Devices/mTaskTCP.icl
index 48dc193..dc57231 100644 (file)
--- a/Devices/mTaskTCP.icl
+++ b/Devices/mTaskTCP.icl
@@ -29,7 +29,8 @@ instance MTaskDuplex TCPSettings where
                        onConnect :: String ChD -> (MaybeErrorString String, Maybe ChD, [String], Bool)
                        onConnect acc (msgs,send,sendStopped)
                        | not (trace_tn "onConnect") = undef
-                       = (Ok "", Just (msgs,[],sendStopped), map encode send, False)
+                       | isEmpty send = (Ok "", Nothing, [], False)
+                       = (Ok "", Just (msgs, [], sendStopped), map encode send, False)
 
                        onData :: String String ChD -> (MaybeErrorString String, Maybe ChD, [String], Bool)
                        onData newdata acc (msgs,send,True)
@@ -38,7 +39,7 @@ instance MTaskDuplex TCPSettings where
                        onData newdata acc (msgs,send,sendStopped)
                        | not (trace_tn "onData: notstop") = undef
                        # split = indexOf "\n" newdata
-                       | split == -1 = (Ok acc, Just (msgs, send, True), [], False)
+                       | split == -1 = (Ok acc, Just (msgs, send, False), [], False)
                        # newMsg = decode (newdata % (0, split-1))
                        // Recurse with smaller data, empty accumulator and new message
                        = onData (newdata % (split+1, size newdata - split))
@@ -50,9 +51,7 @@ instance MTaskDuplex TCPSettings where
                        | not (trace_tn "onSC: stop") = undef
                        = (Ok acc, Nothing, [], True)
                        // Nothing to send
-                       onShareChange acc (msgs,[], _)
-                       | not (trace_tn "onSC: nothing") = undef
-                       = (Ok acc, Nothing, [], False)
+                       onShareChange acc (msgs,[], _) = (Ok acc, Nothing, [], False)
                        // Something to send
                        onShareChange acc (msgs,send, ss)
                        | not (trace_tn "onSC: send") = undef

diff --git a/Tasks/mTaskTask.icl b/Tasks/mTaskTask.icl
index dcd0b8a..c36d0d2 100644 (file)
--- a/Tasks/mTaskTask.icl
+++ b/Tasks/mTaskTask.icl
@@ -12,9 +12,13 @@ makeTask :: String Int -> Task MTaskTask
 makeTask name ident = get currentDateTime 
        @ \dt->{MTaskTask | name=name,ident=ident,dateAdded=dt}
 
+import StdDebug
+import StdMisc
 sendTaskToDevice :: String (Main (ByteCode a Stmt)) (MTaskDevice, MTaskInterval) -> Task [MTaskDevice]
 sendTaskToDevice wta mTask (device, timeout)
+| not (trace_tn "compiling task") = undef
 # (msgs, newState) = toMessages timeout mTask device.deviceState
+| not (trace_tn "Done compiling task") = undef
 # shares = [makeShare wta sdsi sdsval\\{sdsi,sdsval}<-newState.sdss, (MTSds sdsi` _)<-msgs | sdsi == sdsi`] 
 = updateShares device ((++) shares)
        >>| sendMessages msgs device

diff --git a/Utils/SDS.icl b/Utils/SDS.icl
index afd1c6c..f7a6cc7 100644 (file)
--- a/Utils/SDS.icl
+++ b/Utils/SDS.icl
@@ -25,7 +25,7 @@ gPrint{|Dynamic|} _ st = gPrint{|*|} "**Dynamic**" st
 deviceStore :: RWShared (Maybe (MTaskDevice, Int)) [MTaskDevice] [MTaskDevice]
 deviceStore = SDSSource {SDSSource 
        | name = "deviceStore"
-       , read = \_->read realDeviceStore
+       , read = realRead
        , write= realWrite
        }
 where

diff --git a/mTaskInterpret.dcl b/mTaskInterpret.dcl
index 67a6857..fe68463 100644 (file)
--- a/mTaskInterpret.dcl
+++ b/mTaskInterpret.dcl
@@ -121,8 +121,8 @@ derive gEq BCValue
        }
 
 :: BCState = {
-               freshl :: [Int],
-               freshs :: [Int],
+               freshl :: Int,
+               freshs :: Int,
                sdss :: [BCShare]
        }
 instance zero BCState

diff --git a/mTaskInterpret.icl b/mTaskInterpret.icl
index 697ce50..f55c70d 100644 (file)
--- a/mTaskInterpret.icl
+++ b/mTaskInterpret.icl
@@ -252,8 +252,8 @@ BCIfStmt (BC b) (BC t) (BC e) = BC $
        t >>| tell [BCJmp endif, BCLab else] >>|
        e >>| tell [BCLab endif]
 
-freshl = get >>= \st=:{freshl=[fr:frs]}->put {st & freshl=frs} >>| pure fr
-freshs = get >>= \st=:{freshs=[fr:frs]}->put {st & freshs=frs} >>| pure fr
+freshl = get >>= \st=:{freshl}->put ({st & freshl=freshl+1}) >>| pure freshl
+freshs = get >>= \st=:{freshs}->put ({st & freshs=freshs+1}) >>| pure freshs
 
 instance noOp ByteCode where noOp = tell` [BCNop]
 
@@ -301,7 +301,7 @@ instance retrn ByteCode where
   retrn = tell` [BCReturn]
 
 instance zero BCState where
-       zero = {freshl=[1..], freshs=[1..], sdss=[]}
+       zero = {freshl=1, freshs=1, sdss=[]}
 
 toRealByteCode :: (ByteCode a b) BCState -> (String, BCState)
 toRealByteCode x s

diff --git a/miTask.icl b/miTask.icl
index 233e072..8c17f09 100644 (file)
--- a/miTask.icl
+++ b/miTask.icl
@@ -55,28 +55,28 @@ demo = viewSharedInformation "Devices" [] deviceStoreNP
 
 mTaskManager :: Task ()
 mTaskManager = (>>|) startupDevices $ 
-               viewmTasks ||-
+               forever viewmTasks ||-
                ((manageShares ||- forever (manageDevices process)) <<@ ArrangeSplit Vertical True)
                <<@ ArrangeWithSideBar 0 LeftSide 260 True
        where
-               viewmTasks :: Task String
+               viewmTasks :: Task [MTaskDevice]
                viewmTasks = enterChoiceWithShared "Available mTasks" [ChooseFromList id] mTaskTaskStore
-                       >&^ \sh->whileUnchanged sh $ \mi->forever (case mi of
-                               Nothing = viewInformation "No task selected" [] ()
-                               Just mTaskTask = get deviceStoreNP
-                                       >>= \devices->case devices of
-                                               [] = viewInformation "No devices yet" [] ()
-                                               ds = fromJust ('DM'.get mTaskTask allmTasks)
-                                                       >>= \bc->(enterChoice "Choose Device" [ChooseFromDropdown \t->t.deviceName] ds
-                                                               -&&- enterInformation "Timeout" []
-                                                       ) >>* [OnAction (Action "Send") (withValue $ Just o sendTaskToDevice mTaskTask bc)]
-                                                       @! ()
-                               )
+                       >>= \task->get deviceStoreNP
+                       >>* [OnValue $ (ifValue isEmpty)         $ \_->
+                                       viewInformation "No devices yet" [] [] >>= treturn
+                               ,OnValue $ (ifValue $ not o isEmpty) $ \d->
+                                       fromJust ('DM'.get task allmTasks)
+                                       >>= \bc->(enterChoice "Choose Device" [ChooseFromDropdown \t->t.deviceName] d
+                                               -&&- enterInformation "Timeout" []
+                                       ) >>* [OnAction (Action "Send") (withValue $ Just o sendTaskToDevice task bc)]
+                               ]
 
                process :: MTaskDevice (Shared Channels) -> Task ()
-               process device ch = forever (watch ch >>* [OnValue (
-                               ifValue (not o isEmpty o fst3)
-                               (\t->upd (appFst3 (const [])) ch >>| proc (fst3 t)))])
+               process device ch = forever
+                         $ traceValue "Waiting for channel change"
+                       >>| wait "process" (not o isEmpty o fst3) ch
+                       >>= \(r,s,ss)->upd (appFst3 (const [])) ch
+                       >>| proc r
                        where
                                proc :: [MTaskMSGRecv] -> Task ()
                                proc [] = treturn ()