Remove commented-out pseudocode
This commit is contained in:
parent
02a37e4ce2
commit
c028d852d0
45
os.hs
45
os.hs
|
@ -90,48 +90,3 @@ performTransition (KernelModeTransition susp ms mms cbs) vm =
|
|||
messages = reverse ms ++ (messages vm),
|
||||
metaMessages = reverse mms ++ (metaMessages vm),
|
||||
runnables = reverse cbs ++ (runnables vm) }
|
||||
|
||||
---------------------------------------------------------------------------
|
||||
{-
|
||||
type LabelledMessage a b = (a, b)
|
||||
|
||||
groundVM :: Callback m (IO ()) () -> IO ()
|
||||
groundVM boot = do inboundChannel <- newChan
|
||||
mainloop inboundChannel (runVM (makeVM boot))
|
||||
where mainloop ch (KernelModeTransition (Subscription newState pollingK mhs []) ms [] []) = do
|
||||
runActions ch ms
|
||||
case (newState, pollingK, mhs) of
|
||||
(VM { messages = [], metaMessages = [], runnables = [] }, Nothing, []) ->
|
||||
-- inert.
|
||||
return ()
|
||||
_ ->
|
||||
|
||||
|
||||
(when (not (nested-vm-inert? (kernel-mode-transition-subscription transition)))
|
||||
(match transition
|
||||
[(kernel-mode-transition (subscription new-state
|
||||
polling-k
|
||||
message-handlers
|
||||
'())
|
||||
_
|
||||
'()
|
||||
'())
|
||||
(define inbound-messages
|
||||
(map (match-lambda [(message-handler e k) (wrap-evt e (lambda (v) (cons v k)))])
|
||||
message-handlers))
|
||||
(match-define (cons inbound-value inbound-continuation)
|
||||
(apply sync
|
||||
(wrap-evt (if polling-k always-evt never-evt)
|
||||
(lambda (v) (cons (void)
|
||||
(lambda (dummy) polling-k))))
|
||||
inbound-messages))
|
||||
(loop ((inbound-continuation inbound-value) new-state))]
|
||||
[_
|
||||
(error 'ground-vm
|
||||
"Outermost VM may not spawn new siblings or send or receive metamessages")]))))
|
||||
-}
|
||||
|
||||
-- -- Values of type v are matchable by values of type p, yielding
|
||||
-- -- residuals of type a.
|
||||
-- class Matchable v p a | v -> p where
|
||||
-- match :: p -> v -> Maybe a
|
||||
|
|
Loading…
Reference in New Issue