Remove commented-out pseudocode

This commit is contained in:
Tony Garnock-Jones 2012-02-15 10:53:09 -05:00
parent 02a37e4ce2
commit c028d852d0
1 changed files with 0 additions and 45 deletions

45
os.hs
View File

@ -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