import SrcLoc
import qualified Maybes
import UniqSet
-import FiniteMap
import Constants
import FastString
-import Config ( cProjectVersion )
+import Config
-- Standard libraries
import Control.Monad
import Data.Char
import Data.IORef
import Data.List
+import qualified Data.Map as Map
import Foreign
import Control.Concurrent.MVar
where
(modWords, occWord) = ASSERT (length rest1 > 0) (parseModOcc [] (tail rest1))
parseModOcc :: [[Word8]] -> [Word8] -> ([[Word8]], [Word8])
- parseModOcc acc str
+ -- We only look for dots if str could start with a module name,
+ -- i.e. if it starts with an upper case character.
+ -- Otherwise we might think that "X.:->" is the module name in
+ -- "X.:->.+", whereas actually "X" is the module name and
+ -- ":->.+" is a constructor name.
+ parseModOcc acc str@(c : _)
+ | isUpper $ chr $ fromIntegral c
= case break (== dot) str of
(top, []) -> (acc, top)
- (top, _:bot) -> parseModOcc (top : acc) bot
-
+ (top, _ : bot) -> parseModOcc (top : acc) bot
+ parseModOcc acc str = (acc, str)
+
-- | Get the 'HValue' associated with the given name.
--
-- May cause loading the module that contains the name.
Object static_ish
-> do b <- preload_static lib_paths static_ish
maybePutStrLn dflags (if b then "done"
- else "not found")
-
+ else "not found")
+
+ Archive static_ish
+ -> do b <- preload_static_archive lib_paths static_ish
+ maybePutStrLn dflags (if b then "done"
+ else "not found")
+
DLL dll_unadorned
-> do maybe_errstr <- loadDynamic lib_paths dll_unadorned
case maybe_errstr of
= do b <- doesFileExist name
if not b then return False
else loadObj name >> return True
+ preload_static_archive _paths name
+ = do b <- doesFileExist name
+ if not b then return False
+ else loadArchive name >> return True
\end{code}
text "module" <+> ppr mod <+>
text "cannot be linked; it is only available as a boot module")))
+ no_obj :: Outputable a => a -> IO b
no_obj mod = dieWith span $
ptext (sLit "cannot find object file for module ") <>
quotes (ppr mod) $$
-- ...and then find the linkable for it
mb_lnk <- findObjectLinkableMaybe mod loc ;
case mb_lnk of {
- Nothing -> no_obj mod ;
+ Nothing -> no_obj mod ;
Just lnk -> adjust_linkable lnk
}}
-- file in all the directories specified in
-- v_Library_paths before giving up.
+ | Archive FilePath -- Full path name of a .a file, including trailing .a
+
| DLL String -- "Unadorned" name of a .DLL/.so
-- e.g. On unix "qt" denotes "libqt.so"
-- On WinDoze "burble" denotes "burble.DLL"
partOfGHCi
| isWindowsTarget || isDarwinTarget = []
| otherwise = map PackageName
- ["base", "haskell98", "template-haskell", "editline"]
+ ["base", "template-haskell", "editline"]
showLS :: LibrarySpec -> String
showLS (Object nm) = "(static) " ++ nm
+showLS (Archive nm) = "(static archive) " ++ nm
showLS (DLL nm) = "(dynamic) " ++ nm
showLS (DLLPath nm) = "(dynamic) " ++ nm
showLS (Framework nm) = "(framework) " ++ nm
| Just pkg_cfg <- lookupPackage pkg_map new_pkg
= do { -- Link dependents first
pkgs' <- link pkgs [ Maybes.expectJust "link_one" $
- lookupFM ipid_map ipid
+ Map.lookup ipid ipid_map
| ipid <- depends pkg_cfg ]
-- Now link the package itself
; linkPackage dflags pkg_cfg
let dirs = Packages.libraryDirs pkg
let libs = Packages.hsLibraries pkg
+ -- The FFI GHCi import lib isn't needed as
+ -- compiler/ghci/Linker.lhs + rts/Linker.c link the
+ -- interpreted references to FFI to the compiled FFI.
+ -- We therefore filter it out so that we don't get
+ -- duplicate symbol errors.
+ libs' = filter ("HSffi" /=) libs
-- Because of slight differences between the GHC dynamic linker and
-- the native system linker some packages have to link with a
-- different list of libraries when using GHCi. Examples include: libs
then Packages.extraLibraries pkg
else Packages.extraGHCiLibraries pkg)
++ [ lib | '-':'l':lib <- Packages.ldOptions pkg ]
- classifieds <- mapM (locateOneObj dirs) libs
+ classifieds <- mapM (locateOneObj dirs) libs'
-- Complication: all the .so's must be loaded before any of the .o's.
let dlls = [ dll | DLL dll <- classifieds ]
objs = [ obj | Object obj <- classifieds ]
+ archs = [ arch | Archive arch <- classifieds ]
maybePutStr dflags ("Loading package " ++ display (sourcePackageId pkg) ++ " ... ")
-- Ordering isn't important here, because we do one final link
-- step to resolve everything.
mapM_ loadObj objs
+ mapM_ loadArchive archs
maybePutStr dflags "linking ... "
ok <- resolveObjs
-- If it isn't present, we assume it's a dynamic library.
locateOneObj :: [FilePath] -> String -> IO LibrarySpec
locateOneObj dirs lib
+ | not ("HS" `isPrefixOf` lib)
+ -- For non-Haskell libraries (e.g. gmp, iconv) we assume dynamic library
+ = assumeDll
| not isDynamicGhcLib
- -- When the GHC package was not compiled as dynamic library
- -- (=DYNAMIC not set), we search for .o libraries.
- = do { mb_obj_path <- findFile mk_obj_path dirs
- ; case mb_obj_path of
- Just obj_path -> return (Object obj_path)
- Nothing -> return (DLL lib) }
-
+ -- When the GHC package was not compiled as dynamic library
+ -- (=DYNAMIC not set), we search for .o libraries or, if they
+ -- don't exist, .a libraries.
+ = findObject `orElse` findArchive `orElse` assumeDll
| otherwise
-- When the GHC package was compiled as dynamic library (=DYNAMIC set),
-- we search for .so libraries first.
- = do { mb_lib_path <- findFile mk_dyn_lib_path dirs
- ; case mb_lib_path of
- Just _ -> return (DLL dyn_lib_name)
- Nothing ->
- do { mb_obj_path <- findFile mk_obj_path dirs
- ; case mb_obj_path of
- Just obj_path -> return (Object obj_path)
- Nothing -> return (DLL lib) }} -- We assume
+ = findDll `orElse` findObject `orElse` findArchive `orElse` assumeDll
where
mk_obj_path dir = dir </> (lib <.> "o")
+ mk_arch_path dir = dir </> ("lib" ++ lib <.> "a")
dyn_lib_name = lib ++ "-ghc" ++ cProjectVersion
mk_dyn_lib_path dir = dir </> mkSOName dyn_lib_name
+ findObject = liftM (fmap Object) $ findFile mk_obj_path dirs
+ findArchive = liftM (fmap Archive) $ findFile mk_arch_path dirs
+ findDll = liftM (fmap DLL) $ findFile mk_dyn_lib_path dirs
+ assumeDll = return (DLL lib)
+ infixr `orElse`
+ f `orElse` g = do m <- f
+ case m of
+ Just x -> return x
+ Nothing -> g
-- ----------------------------------------------------------------------------
-- Loading a dyanmic library (dlopen()-ish on Unix, LoadLibrary-ish on Win32)
projects / ghc-hetmet.git / blobdiff