diff --git a/src/plugins/Plugins/Env.hs b/src/plugins/Plugins/Env.hs index 5d1fd0c..7b9a87f 100644 --- a/src/plugins/Plugins/Env.hs +++ b/src/plugins/Plugins/Env.hs @@ -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? -- diff --git a/src/plugins/Plugins/Load.hs b/src/plugins/Plugins/Load.hs index 03ffcde..b3811d8 100644 --- a/src/plugins/Plugins/Load.hs +++ b/src/plugins/Plugins/Load.hs @@ -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)