plugins 1.5.2.3 → 1.5.3.0

raw patch · 3 files changed

+56/−55 lines, 3 filesdep ~Cabaldep ~basedep ~directoryPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: Cabal, base, directory, ghc

API changes (from Hackage documentation)

Files

• plugins.cabal +2/−2
• src/System/Plugins/Load.hs +53/−52
• src/System/Plugins/Utils.hs +1/−1

@@ -1,6 +1,6 @@ name:               plugins-version:            1.5.2.3-homepage:           http://patch-tag.com/r/stepcut/plugins+version:            1.5.3.0+homepage:           http://hub.darcs.net/stepcut/plugins synopsis:           Dynamic linking for Haskell and C objects description:        Dynamic linking and runtime evaluation of Haskell,                     and C, including dependency chasing and package resolution.

@@ -3,23 +3,23 @@ {-# LANGUAGE UnboxedTuples              #-} {-# LANGUAGE ForeignFunctionInterface   #-} ----- Copyright (C) 2004-5 Don Stewart - http://www.cse.unsw.edu.au/~dons--- +-- Copyright (C) 2004-5 Don Stewart+-- -- This library is free software; you can redistribute it and/or -- modify it under the terms of the GNU Lesser General Public -- License as published by the Free Software Foundation; either -- version 2.1 of the License, or (at your option) any later version.--- +-- -- This library is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU -- Lesser General Public License for more details.--- +-- -- You should have received a copy of the GNU Lesser General Public -- License along with this library; if not, write to the Free Software -- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307 -- USA--- +--  -- | An interface to the GHC runtime's dynamic linker, providing runtime -- loading and linking of Haskell object files, commonly known as@@ -34,7 +34,7 @@       , load       , load_       , dynload-      , pdynload +      , pdynload       , pdynload_       , unload       , unloadAll@@ -149,7 +149,7 @@ -- provided with appropriate type constraints such that Haskell compiler -- can determine the expected type returned by 'load', as the return -- type is notionally polymorphic.--- +-- -- Example: -- -- > do mv <- load "Plugin.o" ["api"] [] "resource"@@ -184,18 +184,21 @@ #endif     addModuleDeps m' moduleDeps     v <- loadFunction m sym-    return $ case v of +    return $ case v of         Nothing -> LoadFailure ["load: couldn't find symbol <<"++sym++">>"]         Just a  -> LoadSuccess m a  -- -- | Like load, but doesn't want a package.conf arg (they are rarely used) ---load_ :: FilePath -> [FilePath] -> Symbol -> IO (LoadStatus a)+load_ :: FilePath    -- ^ object file+      -> [FilePath]  -- ^ any include paths+      -> Symbol      -- ^ symbol to find+      -> IO (LoadStatus a) load_ o i s = load o i [] s ------ A work-around for Dynamics. The keys used to compare two TypeReps are++-- | A work-around for Dynamics. The keys used to compare two TypeReps are -- somehow not equal for the same type in hs-plugin's loaded objects. -- Solution: implement our own dynamics... --@@ -204,8 +207,8 @@ -- is not the case, we core dump. Use pdynload if you don't trust the -- user to supply you with a Dynamic ---dynload :: Typeable a    -        => FilePath  +dynload :: Typeable a+        => FilePath         -> [FilePath]         -> [PackageConf]         -> Symbol@@ -220,7 +223,8 @@                         Nothing -> LoadFailure ["Mismatched types in interface"]  ---------------------------------------------------------------------------++-- | -- The super-replacement for dynload -- -- Use GHC at runtime so we get staged type inference, providing full@@ -229,7 +233,6 @@ -- -- TODO where does the .hc file go in the call to build() ? --- pdynload :: FilePath                    -- ^ object to load          -> [FilePath]                  -- ^ include paths          -> [PackageConf]               -- ^ package confs@@ -237,7 +240,7 @@          -> Symbol                      -- ^ symbol          -> IO (LoadStatus a) -pdynload object incpaths pkgconfs ty sym = do +pdynload object incpaths pkgconfs ty sym = do #if DEBUG         putStr "Checking types ... " >> hFlush stdout #endif@@ -245,7 +248,7 @@ #if DEBUG         putStrLn "done" #endif-        if null errors +        if null errors                 then load object incpaths pkgconfs sym                 else return $ LoadFailure errors @@ -269,12 +272,12 @@ #if DEBUG         putStrLn "done" #endif-        if null errors +        if null errors                 then load object incpaths pkgconfs sym                 else return $ LoadFailure errors  --------------------------------------------------------------------------- run the typechecker over the constraint file+-- | run the typechecker over the constraint file -- -- Problem: if the user depends on a non-auto package to build the -- module, then that package will not be in scope when we try to build@@ -290,7 +293,7 @@         (tmpf1,hdl1) <- mkTemp  -- and send .hi file here.         hClose hdl1 -        let nm  = mkModid (basename tmpf) +        let nm  = mkModid (basename tmpf)             src = mkTest nm (hierize' . mkModid . hierize $ obj)                                 (fst $ break (=='.') ty) ty sym             is  = map ("-i"++) incs             -- api@@ -312,7 +315,7 @@             hierize' ('\\':cs) = '.' : hierize' cs             hierize' (c:cs)   = c    : hierize' cs -mkTest modnm plugin api ty sym = +mkTest modnm plugin api ty sym =        "module "++ modnm ++" where" ++        "\nimport qualified " ++ plugin  ++        "\nimport qualified " ++ api     ++@@ -327,11 +330,11 @@ pdynload obj incpaths pkgconfs sym ty = do         (m, v) <- load obj incpaths pkgconfs sym         ty'    <- mungeIface sym obj-        if ty == ty' +        if ty == ty'                 then return $ Just (m, v)                 else return Nothing             -- mismatched types -   where +   where         -- grab the iface output from GHC. find the line relevant to our         -- symbol. grab the string rep of the type.         mungeIface sym o = do@@ -348,11 +351,11 @@ -- -- a version of load the also unwraps and types a Dynamic object ---dynload2 :: Typeable a => -           FilePath -> -           FilePath -> +dynload2 :: Typeable a =>+           FilePath ->+           FilePath ->            Maybe [PackageConf] ->-           Symbol ->  +           Symbol ->            IO (Module, a)  dynload2 obj incpath pkgconfs sym = do@@ -402,13 +405,13 @@ #endif         m_ <- loadObject p . Object . ifaceModuleName $ hi   -- load object at path p         let m' = m_ { iface = hi }-    +         resolveObjs (unloadAll m) #if DEBUG         putStrLn "done" >> hFlush stdout #endif         v <- loadFunction m' sym-        return $ case v of +        return $ case v of                 Nothing -> LoadFailure ["load: couldn't find symbol <<"++sym++">>"]                 Just a  -> LoadSuccess m' a @@ -493,31 +496,29 @@ -- NB the environment stores the *full path* to an object. So if you -- want to know if a module is already loaded, you need to supply the -- *path* to that object, not the name.--- +-- -- NB -- let's try just the module name. -- -- loadObject loads normal .o objs, and packages too. .o objs come with -- a nice canonical Z-encoded modid. packages just have a simple name. -- Do we want to ensure they won't clash? Probably. --- --+-- -- the second argument to loadObject is a string to use as the unique -- identifier for this object. For normal .o objects, it should be the -- Z-encoded modid from the .hi file. For archives\/packages, we can -- probably get away with the package name ---- loadObject :: FilePath -> Key -> IO Module-loadObject p ky@(Object k)  = loadObject' p ky k -loadObject p ky@(Package k) = loadObject' p ky k +loadObject p ky@(Object k)  = loadObject' p ky k+loadObject p ky@(Package k) = loadObject' p ky k  loadObject' :: FilePath -> Key -> String -> IO Module loadObject' p ky k     | ("HSrts"++sysPkgSuffix) `isSuffixOf` p = return (emptyMod p) -    | otherwise +    | otherwise     = do alreadyLoaded <- isLoaded k          when (not alreadyLoaded) $ do               r <- withCString p c_loadObj@@ -527,7 +528,7 @@      where emptyMod q = Module q (mkModid q) Vanilla undefined ky ---+-- | -- load a single object. no dependencies. You should know what you're -- doing. --@@ -560,11 +561,11 @@   -- | Unload a module-unloadObj :: Module -> IO () +unloadObj :: Module -> IO () unloadObj (Module { path = p, kind = k, key = ky }) = case k of         Vanilla -> withCString p $ \c_p -> do                 removed <- rmModule name-                when (removed) $ do r <- c_unloadObj c_p +                when (removed) $ do r <- c_unloadObj c_p                                     when (not r) (panic "unloadObj: failed")         Shared  -> return () -- can't unload .so?     where name = case ky of Object s -> s ; Package pk -> pk@@ -579,14 +580,14 @@     putStrLn $ " shared: " ++ str #endif     maybe_errmsg <- withCString str $ \dll -> c_addDLL dll-    if maybe_errmsg == nullPtr +    if maybe_errmsg == nullPtr         then return (Module str (mkModid str) Shared undefined (Package (mkModid str)))         else do e <- peekCString maybe_errmsg                 panic $ "loadShared: couldn't load `"++str++"\' because "++e   ----- Load a -package that we might need, implicitly loading the cbits too+-- | Load a -package that we might need, implicitly loading the cbits too -- The argument is the name of package (e.g.  \"concurrent\") -- -- How to find a package is determined by the package.conf info we store@@ -610,7 +611,7 @@   ----- Unload a -package, that has already been loaded. Unload the cbits+-- | Unload a -package, that has already been loaded. Unload the cbits -- too. The argument is the name of the package. -- -- May need to check if it exists.@@ -625,12 +626,12 @@     let pkg' = takeWhile (/= '-') pkg   -- in case of *-0.1     libs <- liftM (\(a,_) -> (filter (isSublistOf pkg') ) a) (lookupPkg pkg)     flip mapM_ libs $ \p -> withCString p $ \c_p -> do-                        r <- c_unloadObj c_p +                        r <- c_unloadObj c_p                         when (not r) (panic "unloadObj: failed")-                        rmModule (mkModid p)      -- unrecord this module +                        rmModule (mkModid p)      -- unrecord this module  ----- load a package using the given package.conf to help+-- | load a package using the given package.conf to help -- TODO should report if it doesn't actually load the package, instead -- of mapM_ doing nothing like above. --@@ -644,10 +645,10 @@ #if DEBUG         putStrLn " done" #endif-         + -- ------------------------------------------------------------------------ module dependency loading+-- | module dependency loading -- -- given an Foo.o vanilla object file, supposed to be a plugin compiled -- by our library, find the associated .hi file. If this is found, load@@ -684,11 +685,11 @@                  -- now, try to generate a path to the actual .o file                 -- fix up hierachical names-                let mods_ = map (\s -> (s, map (\c -> +                let mods_ = map (\s -> (s, map (\c ->                         if c == '.' then '/' else c) $ s)) ds'                  -- construct a list of possible dependent modules to load-                let mods = concatMap (\p -> +                let mods = concatMap (\p ->                             map (\(hi,m) -> (hi,p </> m++".o")) mods_) incpaths                  -- remove modules that don't exist@@ -717,15 +718,15 @@ #endif                 resolveObjs (mapM_ unloadPackage ps') #if DEBUG-                when (not (null ps')) $ putStrLn "done" -                putStr "Loading object" +                when (not (null ps')) $ putStrLn "done"+                putStr "Loading object"                 mapM_ (\(m,_) -> putStr (" "++ m) >> hFlush stdout) mods'' #endif                 moduleDeps <- mapM (\(hi,m) -> loadObject m (Object hi)) mods''                 return (hiface,moduleDeps)  -- ------------------------------------------------------------------------ Nice interface to .hi parser+-- | Nice interface to .hi parser -- getImports :: String -> IO [String] getImports m = do

@@ -70,7 +70,7 @@  import System.IO import System.Environment           ( getEnv )-import System.Directory+import System.Directory             ( doesFileExist, getModificationTime, removeFile )  -- --------------------------------------------------------------------- -- some misc types we use