Code for unloadAll.

src/plugins/System/Plugins/Env.hs

@@ -20,9 +20,11 @@
 
 module System.Plugins.Env (
         withModEnv,
+        withDepEnv,
         withPkgEnvs,
         withMerged,
         modifyModEnv,
+        modifyDepEnv,
         modifyPkgEnv,
         modifyMerged,
         addModule,
@@ -30,6 +32,9 @@ module System.Plugins.Env (
         addModules,
         isLoaded,
         loaded,
+        addModuleDeps,
+        getModuleDeps,
+        rmModuleDeps,
         isMerged,
         lookupMerged,
         addMerge,
@@ -43,6 +48,7 @@ module System.Plugins.Env (
 
 #include "../../../../config.h"
 
+import System.Plugins.LoadTypes
 import System.Plugins.PackageAPI  {- everything -}
 #if CABAL == 1 || __GLASGOW_HASKELL__ >= 604
 import System.Plugins.ParsePkgConfCabal( parsePkgConf )
@@ -52,7 +58,7 @@ import System.Plugins.ParsePkgConfLite ( parsePkgConf )
 import System.Plugins.Consts           ( ghcLibraryPath, sysPkgConf, sysPkgSuffix, dllSuf )
 
 import Data.IORef               ( writeIORef, readIORef, newIORef, IORef() )
-import Data.Maybe               ( isJust )
+import Data.Maybe               ( isJust, isNothing )
 import Data.List                ( isPrefixOf, nub )
 
 import System.IO.Unsafe         ( unsafePerformIO )
@@ -118,7 +124,9 @@ lookupFM  = flip M.lookup
 -- unlike in hram's loader.
 --
 
-type ModEnv = FiniteMap String Bool
+type ModEnv = FiniteMap String (Module,Int)
+
+type DepEnv = FiniteMap Module [Module]
 
 -- represents a package.conf file
 type PkgEnv  = FiniteMap PackageName PackageConfig
@@ -130,7 +138,8 @@ type MergeEnv = FiniteMap (FilePath,FilePath) FilePath
 type PkgEnvs = [PkgEnv]
 
 type Env = (MVar (), 
-            IORef ModEnv,  
+            IORef ModEnv,
+            IORef DepEnv,  
             IORef PkgEnvs,
             IORef MergeEnv)
 
@@ -142,10 +151,11 @@ type Env = (MVar (),
 env = unsafePerformIO $ do 
                 mvar  <- newMVar ()
                 ref1  <- newIORef emptyFM         -- loaded objects
+                ref2  <- newIORef emptyFM
                 p     <- grabDefaultPkgConf
-                ref2  <- newIORef p               -- package.conf info
+                ref3  <- newIORef p               -- package.conf info
-                ref3  <- newIORef emptyFM         -- merged files
+                ref4  <- newIORef emptyFM         -- merged files
-                return (mvar, ref1, ref2, ref3)
+                return (mvar, ref1, ref2, ref3, ref4)
 {-# NOINLINE env #-}
 
 -- -----------------------------------------------------------
@@ -156,12 +166,14 @@ env = unsafePerformIO $ do
 -- with*Env function. Nice and threadsafe
 --
 withModEnv  :: Env -> (ModEnv   -> IO a) -> IO a
+withDepEnv  :: Env -> (DepEnv   -> IO a) -> IO a
 withPkgEnvs :: Env -> (PkgEnvs  -> IO a) -> IO a
 withMerged  :: Env -> (MergeEnv -> IO a) -> IO a
 
-withModEnv  (mvar,ref,_,_) f = withMVar mvar (\_ -> readIORef ref >>= f)
+withModEnv  (mvar,ref,_,_,_) f = withMVar mvar (\_ -> readIORef ref >>= f)
-withPkgEnvs (mvar,_,ref,_) f = withMVar mvar (\_ -> readIORef ref >>= f)
+withDepEnv  (mvar,_,ref,_,_) f = withMVar mvar (\_ -> readIORef ref >>= f)
-withMerged  (mvar,_,_,ref) f = withMVar mvar (\_ -> readIORef ref >>= f)
+withPkgEnvs (mvar,_,_,ref,_) f = withMVar mvar (\_ -> readIORef ref >>= f)
+withMerged  (mvar,_,_,_,ref) f = withMVar mvar (\_ -> readIORef ref >>= f)
 
 -- -----------------------------------------------------------
 --
@@ -169,12 +181,14 @@ withMerged  (mvar,_,_,ref) f = withMVar mvar (\_ -> readIORef ref >>= f)
 -- write a new PackageConfig
 --
 modifyModEnv :: Env -> (ModEnv   -> IO ModEnv)  -> IO ()
+modifyDepEnv :: Env -> (DepEnv   -> IO DepEnv)  -> IO ()
 modifyPkgEnv :: Env -> (PkgEnvs  -> IO PkgEnvs) -> IO ()
 modifyMerged :: Env -> (MergeEnv -> IO MergeEnv)-> IO ()
 
-modifyModEnv (mvar,ref,_,_) f = lockAndWrite mvar ref f 
+modifyModEnv (mvar,ref,_,_,_) f = lockAndWrite mvar ref f 
-modifyPkgEnv (mvar,_,ref,_) f = lockAndWrite mvar ref f 
+modifyDepEnv (mvar,_,ref,_,_) f = lockAndWrite mvar ref f 
-modifyMerged (mvar,_,_,ref) f = lockAndWrite mvar ref f
+modifyPkgEnv (mvar,_,_,ref,_) f = lockAndWrite mvar ref f 
+modifyMerged (mvar,_,_,_,ref) f = lockAndWrite mvar ref f
 
 -- private
 lockAndWrite mvar ref f = withMVar mvar (\_->readIORef ref>>=f>>=writeIORef ref)
@@ -183,23 +197,29 @@ lockAndWrite mvar ref f = withMVar mvar (\_->readIORef ref>>=f>>=writeIORef ref)
 --
 -- insert a loaded module name into the environment
 --
-addModule :: String -> IO ()
+addModule :: String -> Module -> IO ()
-addModule s = modifyModEnv env $ \fm -> return $ addToFM fm s True
+addModule s m = modifyModEnv env $ \fm -> let c = maybe 0 snd (lookupFM fm s)
+                                          in return $ addToFM fm s (m,c+1)
+
+--getModule :: String -> IO (Maybe Module)
+--getModule s = withModEnv env $ \fm -> return (lookupFM fm s)
 
 --
--- remove a module name from the environment
+-- remove a module name from the environment. Returns True if the module was actually removed.
 --
-rmModule :: String -> IO ()
+rmModule :: String -> IO Bool
-rmModule s = modifyModEnv env $ \fm -> return $ delFromFM fm s
+rmModule s = do modifyModEnv env $ \fm -> let c = maybe 1 snd (lookupFM fm s)
+                                              fm' = delFromFM fm s
+                                          in if c-1 <= 0
+                                                then return fm'
+                                                else return fm
+                withModEnv env $ \fm -> return (isNothing  (lookupFM fm s))
 
 --
 -- insert a list of module names all in one go
 --
-addModules :: [String] -> IO ()
+addModules :: [(String,Module)] -> IO ()
-addModules ns = modifyModEnv env $ \fm -> return $ unionL fm ns 
+addModules ns = mapM_ (uncurry addModule) ns
-    where
-        unionL :: ModEnv -> [String] -> ModEnv 
-        unionL fm ss = foldr (\s fm' -> addToFM fm' s True) fm ss
 
 --
 -- is a module/package already loaded?
@@ -213,6 +233,30 @@ isLoaded s = withModEnv env $ \fm -> return $ isJust (lookupFM fm s)
 loaded :: String -> IO Bool
 loaded m = do t <- isLoaded m ; return (not t)
 
+-- -----------------------------------------------------------
+--
+-- module dependency stuff
+--
+
+--
+-- set the dependencies of a Module.
+--
+addModuleDeps :: Module -> [Module] -> IO ()
+addModuleDeps m deps = modifyDepEnv env $ \fm -> return $ addToFM fm m deps
+
+--
+-- Get module dependencies. Nothing if none have been recored.
+--
+getModuleDeps :: Module -> IO (Maybe [Module])
+getModuleDeps m = withDepEnv env $ \fm -> return $ lookupFM fm m
+
+
+--
+-- Unrecord a module from the environment.
+--
+rmModuleDeps :: Module -> IO ()
+rmModuleDeps m = modifyDepEnv env $ \fm -> return $ delFromFM fm m
+
 -- -----------------------------------------------------------
 -- Package management stuff
 --

src/plugins/System/Plugins/Load.hs

@@ -26,6 +26,7 @@ module System.Plugins.Load (
       , dynload
       , pdynload , pdynload_
       , unload
+      , unloadAll
       , reload
       , Module(..)
 
@@ -58,6 +59,7 @@ import AltData.Dynamic          ( fromDynamic, Dynamic )
 import AltData.Typeable         ( Typeable )
 
 import Data.List                ( isSuffixOf, nub, nubBy )
+import Data.Maybe               ( fromMaybe )
 import Control.Monad            ( when, filterM, liftM )
 import System.Directory         ( doesFileExist, removeFile )
 import Foreign.C.String         ( CString, withCString, peekCString )
@@ -75,19 +77,7 @@ import System.IO                ( hClose )
 
 -- ---------------------------------------------------------------------
 
-type Symbol      = String
+import System.Plugins.LoadTypes
-type Type        = String
-type Errors      = [String]
-type PackageConf = FilePath
-
-data Module = Module { path  :: !FilePath 
-                     , mname :: !String 
-                     , kind  :: !ObjType 
-                     , iface :: Iface    -- cache the iface
-                     , key   :: Key
-                     }          
-
-data ObjType = Vanilla | Shared deriving Eq
 
 -- ---------------------------------------------------------------------
 -- return status of all *load functions:
@@ -114,7 +104,7 @@ load obj incpaths pkgconfs sym = do
 
     -- load extra package information
     mapM_ addPkgConf pkgconfs
-    hif <- loadDepends obj incpaths
+    (hif,moduleDeps) <- loadDepends obj incpaths
 
     -- why is this the package name?
 #if DEBUG
@@ -128,7 +118,7 @@ load obj incpaths pkgconfs sym = do
 #if DEBUG
     putStrLn " ... done" >> hFlush stdout
 #endif
-
+    addModuleDeps m' moduleDeps
     v <- loadFunction m sym
     return $ case v of 
         Nothing -> LoadFailure ["load: couldn't find symbol <<"++sym++">>"]
@@ -309,7 +299,13 @@ dynload2 obj incpath pkgconfs sym = do
 -- it. Cause we don't unload all the dependencies
 --
 unload  :: Module -> IO ()
-unload = unloadObj
+unload m = rmModuleDeps m >> unloadObj m
+
+unloadAll :: Module -> IO ()
+unloadAll m = do moduleDeps <- fmap (fromMaybe []) (getModuleDeps m)
+                 rmModuleDeps m
+                 mapM_ unloadAll moduleDeps
+                 unload m
 
 --
 -- | this will be nice for panTHeon, needs thinking about the interface
@@ -409,7 +405,7 @@ loadFunction (Module { iface = i }) valsym
 -- Z-encoded modid from the .hi file. For archives/packages, we can
 -- probably get away with the package name
 --
-data Key = Object String | Package String
+
 
 loadObject :: FilePath -> Key -> IO Module
 loadObject p ky@(Object k)  = loadObject' p ky k 
@@ -424,7 +420,7 @@ loadObject' p ky k
          when (not alreadyLoaded) $ do
               r <- withCString p c_loadObj
               when (not r) (panic $ "Could not load module `"++p++"'")
-              addModule k   -- needs to Z-encode module name
+         addModule k (emptyMod p)   -- needs to Z-encode module name
          return (emptyMod p)
 
     where emptyMod q = Module q (mkModid q) Vanilla emptyIface ky
@@ -466,12 +462,11 @@ resolveObjs = do
 unloadObj :: Module -> IO () 
 unloadObj (Module { path = p, kind = k, key = ky }) = case k of
         Vanilla -> withCString p $ \c_p -> do
-                r <- c_unloadObj c_p 
+                removed <- rmModule name
-                when (not r) (panic "unloadObj: failed")
+                when (removed) $ do r <- c_unloadObj c_p 
-                rmModule $ case ky of Object s -> s ; Package pk -> pk
+                                    when (not r) (panic "unloadObj: failed")
-
         Shared  -> return () -- can't unload .so?
-
+    where name = case ky of Object s -> s ; Package pk -> pk
 --
 -- | from ghci/ObjLinker.c
 --
@@ -559,7 +554,7 @@ loadPackageWith p pkgconfs = do
 -- the modenv fm. We need a canonical form for the keys -- is basename
 -- good enough?
 --
-loadDepends :: FilePath -> [FilePath] -> IO Iface
+loadDepends :: FilePath -> [FilePath] -> IO (Iface,[Module])
 loadDepends obj incpaths = do
     let hifile = replaceSuffix obj hiSuf
     exists <- doesFileExist hifile
@@ -568,11 +563,11 @@ loadDepends obj incpaths = do
 #if DEBUG
                 putStrLn "No .hi file found." >> hFlush stdout
 #endif
-                return emptyIface   -- could be considered fatal
+                return (emptyIface,[])   -- could be considered fatal
 
         else do hiface <- readIface hifile
                 let ds = mi_deps hiface
-    
+
                 -- remove ones that we've already loaded
                 ds' <- filterM loaded (dep_mods ds)
 
@@ -611,8 +606,8 @@ loadDepends obj incpaths = do
                 putStr "Loading object" 
                 mapM_ (\(m,_) -> putStr (" "++(decode m)) >> hFlush stdout) mods''
 #endif
-                mapM_ (\(hi,m) -> loadObject m (Object hi)) mods''
+                moduleDeps <- mapM (\(hi,m) -> loadObject m (Object hi)) mods''
-                return hiface
+                return (hiface,moduleDeps)
 
 -- ---------------------------------------------------------------------
 -- C interface

src/plugins/System/Plugins/LoadTypes.hs

@@ -0,0 +1,31 @@
+module System.Plugins.LoadTypes
+    ( Key (..)
+    , Symbol
+    , Type
+    , Errors
+    , PackageConf
+    , Module (..)
+    , ObjType (..)
+    ) where
+
+import Language.Hi.Parser
+
+data Key = Object String | Package String
+type Symbol      = String
+type Type        = String
+type Errors      = [String]
+type PackageConf = FilePath
+
+data Module = Module { path  :: !FilePath 
+                     , mname :: !String 
+                     , kind  :: !ObjType 
+                     , iface :: Iface    -- cache the iface
+                     , key   :: Key
+                     }
+instance Ord Module where
+    compare m1 m2 = mname m1 `compare` mname m2
+
+instance Eq Module where
+    m1 == m2 = mname m1 == mname m2
+
+data ObjType = Vanilla | Shared deriving Eq

src/plugins/plugins.conf.in.cpp

@@ -29,6 +29,7 @@ maintainer:	dons@cse.unsw.edu.au
 exposed:	True
 exposed-modules:
 	System.Plugins.Load,
+	System.Plugins.LoadTypes,
 	System.Plugins.Make,
 	System.Plugins,
 	System.MkTemp,