fix-topdir-and-windll-loading
This commit is contained in:
parent
2de3b1180b
commit
ab72dff6c4
@ -284,22 +284,23 @@ readPackageConf f = do
|
||||
-- We return all the package paths that possibly exist, and the leave it
|
||||
-- up to loadObject not to load the same ones twice...
|
||||
--
|
||||
lookupPkg :: PackageName -> IO [FilePath]
|
||||
lookupPkg :: PackageName -> IO ([FilePath],[FilePath])
|
||||
lookupPkg p = do
|
||||
t <- lookupPkg' p
|
||||
case t of ([],f) -> return f
|
||||
(ps,f) -> do gss <- mapM lookupPkg ps
|
||||
return $ nub $ (concat gss) ++ f
|
||||
case t of ([],(f,g)) -> return (f,g)
|
||||
(ps,(f,g)) -> do gss <- mapM lookupPkg ps
|
||||
let (f',g') = unzip gss
|
||||
return $ (nub $ (concat f') ++ f,nub $ (concat g') ++ g)
|
||||
|
||||
--
|
||||
-- return any stuff to load for this package, plus the list of packages
|
||||
-- this package depends on. which includes stuff we have to then load
|
||||
-- too.
|
||||
--
|
||||
lookupPkg' :: PackageName -> IO ([PackageName],[FilePath])
|
||||
lookupPkg' :: PackageName -> IO ([PackageName],([FilePath],[FilePath]))
|
||||
lookupPkg' p = withPkgEnvs env $ \fms -> go fms p
|
||||
where
|
||||
go [] _ = return ([],[])
|
||||
go [] _ = return ([],([],[]))
|
||||
go (fm:fms) q = case lookupFM fm q of
|
||||
Nothing -> go fms q -- look in other pkgs
|
||||
|
||||
@ -313,7 +314,17 @@ lookupPkg' p = withPkgEnvs env $ \fms -> go fms p
|
||||
-- don't care if there are 'Nothings', that usually
|
||||
-- means that they refer to system libraries. Can't do
|
||||
-- anything about that.
|
||||
return (deppkgs, filterJust libs )
|
||||
return (deppkgs, (filterJust libs,filterJust libs') )
|
||||
|
||||
-- replace $topdir
|
||||
fix_topdir [] = []
|
||||
fix_topdir (x:xs) = replace_topdir x : fix_topdir xs
|
||||
|
||||
replace_topdir [] = []
|
||||
replace_topdir ('$':xs)
|
||||
| take 6 xs == "topdir" = ghcLibraryPath ++ (drop 6 xs)
|
||||
| otherwise = '$' : replace_topdir xs
|
||||
replace_topdir (x:xs) = x : replace_topdir xs
|
||||
|
||||
-- a list elimination form for the Maybe type
|
||||
filterJust :: [Maybe a] -> [a]
|
||||
@ -334,6 +345,13 @@ lookupPkg' p = withPkgEnvs env $ \fms -> go fms p
|
||||
if b then return $ Just l -- found it!
|
||||
else findHSlib dirs lib
|
||||
|
||||
findDLL :: FilePath -> String -> IO (Maybe FilePath)
|
||||
findDLL dir lib = do
|
||||
let l = dir ++ "/" ++ lib ++ ".dll"
|
||||
b <- doesFileExist l
|
||||
if b then return $ Just l
|
||||
else return $ Nothing
|
||||
|
||||
------------------------------------------------------------------------
|
||||
-- do we have a Module name for this merge?
|
||||
--
|
||||
|
@ -453,7 +453,7 @@ loadRawObject obj = loadObject obj (Object k)
|
||||
-- | Resolve (link) the modules loaded by the 'loadObject' function.
|
||||
--
|
||||
resolveObjs :: IO ()
|
||||
resolveObjs = do
|
||||
resolveObjs = do
|
||||
r <- c_resolveObjs
|
||||
when (not r) $
|
||||
panic $ "resolveObjs failed with <<" ++ show r ++ ">>"
|
||||
@ -480,7 +480,7 @@ loadShared str = do
|
||||
if maybe_errmsg == nullPtr
|
||||
then return (Module str (mkModid str) Shared emptyIface (Package (mkModid str)))
|
||||
else do e <- peekCString maybe_errmsg
|
||||
panic $ "loadShared: couldn't load `"++str++"\' because "++e
|
||||
panic $ "loadShared: couldn't load `"++str'++"\' because "++e
|
||||
|
||||
--
|
||||
-- Load a -package that we might need, implicitly loading the cbits too
|
||||
@ -498,7 +498,7 @@ loadPackage p = do
|
||||
#endif
|
||||
libs <- lookupPkg p
|
||||
mapM_ (\l -> loadObject l (Package (mkModid l))) libs
|
||||
|
||||
mapM_ loadShared dlls
|
||||
--
|
||||
-- Unload a -package, that has already been loaded. Unload the cbits
|
||||
-- too. The argument is the name of the package.
|
||||
@ -513,7 +513,7 @@ loadPackage p = do
|
||||
unloadPackage :: String -> IO ()
|
||||
unloadPackage pkg = do
|
||||
let pkg' = takeWhile (/= '-') pkg -- in case of *-0.1
|
||||
libs <- liftM (filter (isSublistOf pkg')) (lookupPkg pkg)
|
||||
libs <- liftM (\(a,_) -> (filter (isSublistOf pkg') ) a) (lookupPkg pkg)
|
||||
flip mapM_ libs $ \p -> withCString p $ \c_p -> do
|
||||
r <- c_unloadObj c_p
|
||||
when (not r) (panic "unloadObj: failed")
|
||||
@ -568,7 +568,7 @@ loadDepends obj incpaths = do
|
||||
|
||||
else do hiface <- readIface hifile
|
||||
let ds = mi_deps hiface
|
||||
|
||||
|
||||
-- remove ones that we've already loaded
|
||||
ds' <- filterM loaded (dep_mods ds)
|
||||
|
||||
|
Loading…
x
Reference in New Issue
Block a user