diff -rN -u old-base/System/Event/Manager.hs new-base/System/Event/Manager.hs
--- old-base/System/Event/Manager.hs	2010-11-26 19:50:03.992078878 -0800
+++ new-base/System/Event/Manager.hs	2010-11-26 19:50:04.059080177 -0800
@@ -41,6 +41,10 @@
 ------------------------------------------------------------------------
 -- Imports
 
+import Foreign.C.String
+import Foreign.Ptr
+import System.Posix.Internals
+
 import Control.Concurrent.MVar (MVar, modifyMVar, modifyMVar_, newMVar,
                                 readMVar)
 import Control.Exception (finally)
@@ -60,6 +64,7 @@
 import System.Event.Internal (Backend, Event, evtClose, evtRead, evtWrite,
                               Timeout(..))
 import System.Event.Unique (Unique, UniqueSource, newSource, newUnique)
+import System.Mem.Weak
 import System.Posix.Types (Fd)
 
 import qualified System.Event.IntMap as IM
@@ -82,8 +87,11 @@
 data FdData = FdData {
       fdKey       :: {-# UNPACK #-} !FdKey
     , fdEvents    :: {-# UNPACK #-} !Event
-    , _fdCallback :: !IOCallback
-    } deriving (Show)
+    , _fdCallback :: Weak (Fd,IOCallback)
+    }
+
+instance Show FdData where
+    show (FdData k e _cb) = "FdData " ++ show k ++ " " ++ show e
 
 -- | A file descriptor registration cookie.
 data FdKey = FdKey {
@@ -272,9 +280,11 @@
 registerFd_ EventManager{..} cb fd evs = do
   u <- newUnique emUniqueSource
   modifyMVar emFds $ \oldMap -> do
+    debug $ "creating for " ++ show fd
+    wcb <- mkWeakPair fd cb $ Just (debug $ "dropping " ++ show fd)
     let fd'  = fromIntegral fd
         reg  = FdKey fd u
-        !fdd = FdData reg evs cb
+        !fdd = FdData reg evs wcb
         (!newMap, (oldEvs, newEvs)) =
             case IM.insertWith (++) fd' [fdd] oldMap of
               (Nothing,   n) -> (n, (mempty, evs))
@@ -314,6 +324,7 @@
 unregisterFd_ :: EventManager -> FdKey -> IO Bool
 unregisterFd_ EventManager{..} (FdKey fd u) =
   modifyMVar emFds $ \oldMap -> do
+    debug $ "unregister " ++ show fd
     let dropReg cbs = case filter ((/= u) . keyUnique . fdKey) cbs of
                           []   -> Nothing
                           cbs' -> Just cbs'
@@ -342,7 +353,13 @@
       (Just fds, !newMap) -> do
         when (eventsOf fds /= mempty) $ wakeManager mgr
         return (newMap, fds)
-  forM_ fds $ \(FdData reg ev cb) -> cb reg (ev `mappend` evtClose)
+  forM_ fds $ \(FdData reg ev wcb) -> do
+    mcb <- deRefWeak wcb
+    case mcb of
+      Just (_,cb) -> do
+        let !evt = ev `mappend` evtClose
+        cb reg evt
+      _ -> debug $ "nothing for " ++ show (keyFd reg)
 
 ------------------------------------------------------------------------
 -- Registering interest in timeout events
@@ -389,6 +406,16 @@
 onFdEvent mgr fd evs = do
   fds <- readMVar (emFds mgr)
   case IM.lookup (fromIntegral fd) fds of
-      Just cbs -> forM_ cbs $ \(FdData reg ev cb) ->
-                    when (evs `I.eventIs` ev) $ cb reg evs
+      Just cbs -> forM_ cbs $ \(FdData reg ev wcb) ->
+                    when (evs `I.eventIs` ev) $ do
+                      mcb <- deRefWeak wcb
+                      case mcb of
+                        Just (_,cb) -> cb reg evs
+                        _           -> debug $ "nothing for " ++ show (keyFd reg)
       Nothing  -> return ()
+
+debug :: String -> IO ()
+debug s = do
+  withCStringLen (s++"\n") $ \(ptr,len) ->
+    c_safe_write 2 (castPtr ptr) (fromIntegral len)
+  return ()
diff -rN -u old-base/System/Mem/Weak.hs new-base/System/Mem/Weak.hs
--- old-base/System/Mem/Weak.hs	2010-11-26 19:50:04.000079033 -0800
+++ new-base/System/Mem/Weak.hs	2010-11-26 19:50:04.060080197 -0800
@@ -67,13 +67,15 @@
 	-- $precise
    ) where
 
-import Prelude
+import Data.Maybe (Maybe(..))
 
 #ifdef __HUGS__
 import Hugs.Weak
 #endif
 
 #ifdef __GLASGOW_HASKELL__
+import GHC.Base (return)
+import GHC.Types (IO)
 import GHC.Weak
 #endif