-makeShares :: BCState -> [(Int, Shared Int)]
-makeShares {sdss=[]} = []
-makeShares s=:{sdss=[(i,d):xs]} =
- [(i, sharedStore ("mTaskSDS-" +++ toString i) 1):makeShares {s & sdss=xs}]
-
-//makeBytecode :: Int (Main (ByteCode () Stmt)) -> ([MTaskMSGSend], [(Int, Shared Int)])
-//makeBytecode timeout bc
-//# (msgs, st) = toMessages timeout (toRealByteCode (unMain bc))
-//# shares = map (\(i,d)->(i, sharedStore (s i) (dd d))) st.sdss
-//= (msgs, shares)
-// where
-// s i = "mTaskSDS-" +++ toString i
-// dd [x,y] = (toInt x)*265+(toInt y)
-
-
-sendMsg :: [MTaskMSGSend] (Shared ([MTaskMSGRecv],Bool,[MTaskMSGSend],Bool)) -> Task ()
-sendMsg m ch = upd (\(r,rs,s,ss)->(r,rs,s ++ m,ss)) ch @! ()
-
-syncSerialChannel :: String TTYSettings (String -> m) (n -> String) (Shared ([m],Bool,[n],Bool)) -> Task () | iTask m & iTask n
-syncSerialChannel dev opts decodeFun encodeFun rw = Task eval
- where
- eval event evalOpts tree=:(TCInit taskId ts) iworld=:{IWorld|world}
- = case TTYopen dev opts world of
- (False, _, world)
- # (err, world) = TTYerror world
- = (ExceptionResult (exception err), {iworld & world=world})
- (True, tty, world)
- # iworld = {iworld & world=world, resources=Just (TTYd tty)}
- = case addBackgroundTask 42 (BackgroundTask (serialDeviceBackgroundTask rw decodeFun encodeFun)) iworld of
- (Error e, iworld) = (ExceptionResult (exception "h"), iworld)
- (Ok _, iworld) = (ValueResult NoValue {TaskEvalInfo|lastEvent=ts,removedTasks=[],refreshSensitive=True} NoRep (TCBasic taskId ts JSONNull False), iworld)
-
- eval _ _ tree=:(TCBasic _ ts _ _) iworld
- = (ValueResult NoValue {TaskEvalInfo|lastEvent=ts,removedTasks=[],refreshSensitive=False} NoRep tree, iworld)
-
- eval event evalOpts tree=:(TCDestroy _) iworld=:{IWorld|resources,world}
- # (TTYd tty) = fromJust resources
- # (ok, world) = TTYclose tty world
- # iworld = {iworld & world=world,resources=Nothing}
- = case removeBackgroundTask 42 iworld of
- (Error e, iworld) = (ExceptionResult (exception "h"), iworld)
- (Ok _, iworld) = (DestroyedResult, iworld)
-
-serialDeviceBackgroundTask :: (Shared ([m],Bool,[n],Bool)) (String -> m) (n -> String) !*IWorld -> *IWorld
-serialDeviceBackgroundTask rw de en iworld
- = case read rw iworld of
- (Error e, iworld) = abort "share couldn't be read"
- (Ok (r,rs,s,ss), iworld)
- # (Just (TTYd tty)) = iworld.resources
- # tty = writet (map en s) tty
- # (ml, tty) = case TTYavailable tty of
- (False, tty) = ([], tty)
- (_, tty)
- # (l, tty) = TTYreadline tty
- = ([de l], tty)
- # iworld = {iworld & resources=Just (TTYd tty)}
- = case write (r++ml,rs,[],ss) rw iworld of
- (Error e, iworld) = abort "share couldn't be written"
- (Ok _, iworld) = case notify rw iworld of
- (Error e, iworld) = abort "share couldn't be notified"
- (Ok _, iworld) = iworld
- where
- writet :: [String] !*TTY -> *TTY
- writet [] t = t
- writet [x:xs] t = writet xs (TTYwrite x t)
-
-
-syncNetworkChannel :: String Int String (String -> m) (n -> String) (Shared ([m],Bool,[n],Bool)) -> Task () | iTask m & iTask n
-syncNetworkChannel server port msgSeparator decodeFun encodeFun channel
- = tcpconnect server port channel {ConnectionHandlers|onConnect=onConnect,whileConnected=whileConnected,onDisconnect=onDisconnect} @! ()
- where
- onConnect _ (received,receiveStopped,send,sendStopped)
- = (Ok "",if (not (isEmpty send)) (Just (received,False,[],sendStopped)) Nothing, map encodeFun send,False)
- whileConnected Nothing acc (received,receiveStopped,send,sendStopped)
- | not (trace_tn "whilec nothing") = undef
- = (Ok acc, Nothing, [], False)
- whileConnected (Just newData) acc (received,receiveStopped,send,sendStopped)
- | not (trace_tn "whilec just") = undef
- # [acc:msgs] = reverse (split msgSeparator (concat [acc,newData]))
- # write = if (not (isEmpty msgs && isEmpty send))
- (Just (received ++ map decodeFun (reverse msgs),receiveStopped,[],sendStopped))
- Nothing
- = (Ok acc,write,map encodeFun send,False)
-
- onDisconnect l (received,receiveStopped,send,sendStopped)
- = (Ok l,Just (received,True,send,sendStopped))
-
-consumeNetworkStream :: ([m] -> Task ()) (Shared ([m],Bool,[n],Bool)) -> Task () | iTask m & iTask n
-consumeNetworkStream processTask channel
- = ((watch channel >>* [OnValue (ifValue ifProcess process)]) <! id) @! ()
- where
- ifProcess (received,receiveStopped,_,_)
- = receiveStopped || (not (isEmpty received))
-
- process (received,receiveStopped,_,_)
- = upd empty channel
- >>| if (isEmpty received) (return ()) (processTask received)
- @! receiveStopped
-
- empty :: ([m],Bool,[n],Bool) -> ([m],Bool,[n],Bool)
- empty (_,rs,s,ss) = ([],rs,s,ss)