diff --git a/os.hs b/os.hs
index 047e813..36def6a 100644
--- a/os.hs
+++ b/os.hs
@@ -1,41 +1,34 @@
 {-# LANGUAGE ExistentialQuantification #-}
+-- MultiParamTypeClasses FunctionalDependencies
 module OS where
 
--- TODO try avoiding double-matching for metamessages by closing over the callback
--- TODO try using PIDs instead of HIDs to avoid the search in runMetaHandler
+-- TODO try avoiding double-matching for metamessages and the need for
+-- broadcast by introducing a facility for supporting event-pattern
+-- subtyping
 
-import Data.IntMap (IntMap)
-import qualified Data.IntMap as IntMap
 import Control.Arrow ((>>>))
 import Data.Maybe
+import Data.List
 import Control.Concurrent.Chan
 
-data VM m mm = VM { hidCounter :: Int,
-                    suspensions :: [Suspension m mm],
+data VM m mm = VM { suspensions :: [Suspension m mm],
                     messages :: [m],
                     metaMessages :: [mm],
                     runnables :: [Callback m mm ()] }
 type Callback m mm state = (state -> KernelModeTransition m mm)
-data Subscription m mm = forall state. Subscription
-                                        state
-                                        (Maybe (Callback m mm state))
-                                        [Handler m mm state]
-                                        [MetaHandler m mm state]
 data Suspension m mm = forall state. Suspension
                                         state
                                         (Maybe (Callback m mm state))
                                         [Handler m mm state]
-                                        (IntMap (MetaHandler m mm state))
-data KernelModeTransition m mm = KernelModeTransition (Subscription m mm)
+                                        [MetaHandler m mm state]
+data KernelModeTransition m mm = KernelModeTransition (Suspension m mm)
                                                       [m]
                                                       [mm]
                                                       [Callback m mm ()]
-type HID = Int
 type Handler m mm state = (m -> Maybe (Callback m mm state))
 type MetaHandler m mm state = (mm -> Maybe (Callback m mm state))
 
-newVM boot = VM { hidCounter = 0,
-                  suspensions = [],
+newVM boot = VM { suspensions = [],
                   messages = [],
                   metaMessages = [],
                   runnables = [boot] }
@@ -46,7 +39,7 @@ runVM = rebuildSuspensions enqueuePoller >>> runRunnables >>> dispatchMessages >
             mmhs = concatMap extractDown $ suspensions vm
             pollerK = if shouldPoll vm then Just runVM else Nothing
         in
-          KernelModeTransition (Subscription (vm { metaMessages = [] }) pollerK mmhs []) mms [] []
+          KernelModeTransition (Suspension (vm { metaMessages = [] }) pollerK mmhs []) mms [] []
 
 rebuildSuspensions :: (VM m mm -> Suspension m mm -> VM m mm) -> (VM m mm) -> (VM m mm)
 rebuildSuspensions f vm = foldl f (vm { suspensions = [] }) (suspensions vm)
@@ -66,21 +59,19 @@ dispatchMessages vm = foldr dispatchMessage (vm { messages = [] }) (messages vm)
 
 dispatchMessage m = rebuildSuspensions matchSuspension
     where matchSuspension vm susp@(Suspension state _ mhs _) =
-              let searchHandlers [] = vm { suspensions = susp : suspensions vm }
-                  searchHandlers (mh:mhs) =
-                      case mh m of
-                        Just h -> performTransition (h state) vm
-                        Nothing -> searchHandlers mhs
-              in searchHandlers mhs
+              searchHandlers vm susp state m mhs
 
-extractDown (Suspension _ _ _ mmhs) =
-    IntMap.foldWithKey (\ hid mmh xs -> dispatchMetaMessage hid mmh : xs) [] mmhs
+searchHandlers vm susp state m [] = vm { suspensions = susp : suspensions vm }
+searchHandlers vm susp state m (mh:mhs) =
+    case mh m of
+      Just h -> performTransition (h state) vm
+      Nothing -> searchHandlers vm susp state m mhs
 
-dispatchMetaMessage :: HID -> MetaHandler m mm state -> Handler mm mm1 (VM m mm)
-dispatchMetaMessage hid mmh mm =
-    case mmh mm of
-      Nothing -> Nothing
-      Just _ -> Just (runMetaHandler hid mm)
+extractDown (Suspension _ _ _ mmhs) = map matchMetaMessage mmhs
+    where matchMetaMessage mmh mm =
+              case mmh mm of
+                Nothing -> Nothing
+                Just _ -> Just (runMetaHandler mm)
 
 isPolling (Suspension _ pollerK _ _) = isNothing pollerK
 isBlocked = not . isPolling
@@ -88,29 +79,20 @@ isBlocked = not . isPolling
 shouldPoll vm@(VM { messages = [], runnables = []}) = not $ all isBlocked (suspensions vm)
 shouldPoll _ = True
 
-runMetaHandler :: HID -> mm -> (VM m mm) -> (KernelModeTransition mm mm1)
-runMetaHandler hid mm = runVM . rebuildSuspensions runHid
-    where runHid vm susp@(Suspension state _ _ mmhs) =
-              case IntMap.lookup hid mmhs of
-                Just h -> performTransition ((fromJust $ h mm) state) vm
-                Nothing -> vm { suspensions = susp : suspensions vm }
-
-addHids vm mmhs =
-    foldr (\ mmh (vm, acc) -> let h = hidCounter vm in
-                              (vm { hidCounter = h + 1 }, IntMap.insert h mmh acc))
-          (vm, IntMap.empty)
-          mmhs
+runMetaHandler :: mm -> (VM m mm) -> (KernelModeTransition mm mm1)
+runMetaHandler mm = runVM . rebuildSuspensions dispatchMetaMessage
+    where dispatchMetaMessage vm susp@(Suspension state _ _ mmhs) =
+              searchHandlers vm susp state mm mmhs
 
 performTransition :: KernelModeTransition m mm -> VM m mm -> VM m mm
-performTransition (KernelModeTransition (Subscription state pollerK mhs mmhs) ms mms cbs) vm =
-    let (vm, hidMap) = addHids vm mmhs in
-    vm { suspensions = (Suspension state pollerK mhs hidMap) : suspensions vm,
+performTransition (KernelModeTransition susp ms mms cbs) vm =
+    vm { suspensions = susp : suspensions 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 ()
@@ -146,4 +128,10 @@ groundVM boot = do inboundChannel <- newChan
 	 (loop ((inbound-continuation inbound-value) new-state))]
 	[_
 	 (error 'ground-vm
-		"Outermost VM may not spawn new siblings or send or receive metamessages")]))))
\ No newline at end of file
+		"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