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),
|
messages = reverse ms ++ (messages vm),
|
||||||
metaMessages = reverse mms ++ (metaMessages vm),
|
metaMessages = reverse mms ++ (metaMessages vm),
|
||||||
runnables = reverse cbs ++ (runnables 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