+-- Left: full path name of a .o file, including trailing .o
+-- Right: "unadorned" name of a .DLL/.so
+-- e.g. On unix "qt" denotes "libqt.so"
+-- On WinDoze "burble" denotes "burble.DLL"
+-- addDLL is platform-specific and adds the lib/.so/.DLL
+-- suffixes platform-dependently; we don't do that here.
+--
+-- For dynamic objects only, try to find the object file in all the
+-- directories specified in v_Library_Paths before giving up.
+
+type LibrarySpec
+ = Either FilePath String
+
+showLS (Left nm) = "(static) " ++ nm
+showLS (Right nm) = "(dynamic) " ++ nm
+
+linkPackages :: DynFlags -> [LibrarySpec] -> [PackageConfig] -> IO ()
+linkPackages dflags cmdline_lib_specs pkgs
+ = do mapM_ (linkPackage dflags) (reverse pkgs)
+ lib_paths <- readIORef v_Library_paths
+ mapM_ (preloadLib dflags lib_paths) cmdline_lib_specs
+ if (null cmdline_lib_specs)
+ then return ()
+ else do maybePutStr dflags "final link ... "
+ ok <- resolveObjs
+ if ok then maybePutStrLn dflags "done."
+ else throwDyn (InstallationError
+ "linking extra libraries/objects failed")
+ where
+ preloadLib :: DynFlags -> [String] -> LibrarySpec -> IO ()
+ preloadLib dflags lib_paths lib_spec
+ = do maybePutStr dflags ("Loading object " ++ showLS lib_spec ++ " ... ")
+ case lib_spec of
+ Left static_ish
+ -> do b <- preload_static lib_paths static_ish
+ maybePutStrLn dflags (if b then "done."
+ else "not found")
+ Right dll_unadorned
+ -> -- We add "" to the set of paths to try, so that
+ -- if none of the real paths match, we force addDLL
+ -- to look in the default dynamic-link search paths.
+ do maybe_errstr <- preload_dynamic (lib_paths++[""])
+ dll_unadorned
+ case maybe_errstr of
+ Nothing -> return ()
+ Just mm -> preloadFailed mm lib_paths lib_spec
+ maybePutStrLn dflags "done"
+
+ preloadFailed :: String -> [String] -> LibrarySpec -> IO ()
+ preloadFailed sys_errmsg paths spec
+ = do maybePutStr dflags
+ ("failed.\nDynamic linker error message was:\n "
+ ++ sys_errmsg ++ "\nWhilst trying to load: "
+ ++ showLS spec ++ "\nDirectories to search are:\n"
+ ++ unlines (map (" "++) paths) )
+ give_up
+
+ -- not interested in the paths in the static case.
+ preload_static paths name
+ = do b <- doesFileExist name
+ if not b then return False
+ else loadObj name >> return True
+
+ -- return Nothing == success, else Just error message from addDLL
+ preload_dynamic [] name
+ = return Nothing
+ preload_dynamic (path:paths) rootname
+ = do -- addDLL returns NULL on success
+ maybe_errmsg <- addDLL path rootname
+ if maybe_errmsg == nullPtr
+ then preload_dynamic paths rootname
+ else do str <- peekCString maybe_errmsg
+ return (Just str)
+
+ give_up
+ = (throwDyn . CmdLineError)
+ "user specified .o/.so/.DLL could not be loaded."
+
+-- Packages that don't need loading, because the compiler shares them with
+-- the interpreted program.
+dont_load_these = [ "gmp", "rts" ]
+
+-- Packages that are already linked into GHCi. For mingw32, we only
+-- skip gmp and rts, since std and after need to load the msvcrt.dll
+-- library which std depends on.
+loaded_in_ghci
+# ifndef mingw32_TARGET_OS
+ = [ "std", "concurrent", "posix", "text", "util" ]
+# else
+ = [ ]
+# endif
+
+linkPackage :: DynFlags -> PackageConfig -> IO ()
+linkPackage dflags pkg
+ | name pkg `elem` dont_load_these = return ()
+ | otherwise
+ = do
+ -- For each obj, try obj.o and if that fails, obj.so.
+ -- Complication: all the .so's must be loaded before any of the .o's.
+ let dirs = library_dirs pkg
+ let objs = hs_libraries pkg ++ extra_libraries pkg
+ classifieds <- mapM (locateOneObj dirs) objs
+
+ -- Don't load the .so libs if this is a package GHCi is already
+ -- linked against, because we'll already have the .so linked in.
+ let (so_libs, obj_libs) = partition isRight classifieds
+ let sos_first | name pkg `elem` loaded_in_ghci = obj_libs
+ | otherwise = so_libs ++ obj_libs
+
+ maybePutStr dflags ("Loading package " ++ name pkg ++ " ... ")
+ mapM loadClassified sos_first
+ maybePutStr dflags "linking ... "
+ ok <- resolveObjs
+ if ok then maybePutStrLn dflags "done."
+ else panic ("can't load package `" ++ name pkg ++ "'")
+ where
+ isRight (Right _) = True
+ isRight (Left _) = False
+
+loadClassified :: LibrarySpec -> IO ()
+loadClassified (Left obj_absolute_filename)
+ = do loadObj obj_absolute_filename
+loadClassified (Right dll_unadorned)
+ = do maybe_errmsg <- addDLL "" dll_unadorned -- doesn't seem right to me
+ if maybe_errmsg == nullPtr
+ then return ()
+ else do str <- peekCString maybe_errmsg
+ throwDyn (CmdLineError ("can't load .so/.DLL for: "
+ ++ dll_unadorned ++ " (" ++ str ++ ")" ))
+
+locateOneObj :: [FilePath] -> String -> IO LibrarySpec
+locateOneObj [] obj
+ = return (Right obj) -- we assume
+locateOneObj (d:ds) obj
+ = do let path = d ++ '/':obj ++ ".o"
+ b <- doesFileExist path
+ if b then return (Left path) else locateOneObj ds obj