[project @ 2002-12-26 17:54:51 by wolfgang]
[ghc-hetmet.git] / ghc / compiler / ghci / Linker.lhs
index 7f34acb..3caefbb 100644 (file)
@@ -16,9 +16,10 @@ necessary.
 {-# OPTIONS -optc-DNON_POSIX_SOURCE #-}
 
 module Linker ( HValue, initLinker, showLinkerState,
-               linkPackages, linkLibraries, findLinkable,
-               linkModules, unload, extendLinkEnv, linkExpr,
-               LibrarySpec(..)
+               linkLibraries, linkExpr,
+               unload, extendLinkEnv, 
+               LibrarySpec(..),
+               linkPackages,
        ) where
 
 #include "../includes/config.h"
@@ -27,23 +28,17 @@ module Linker ( HValue, initLinker, showLinkerState,
 import ObjLink         ( loadDLL, loadObj, unloadObj, resolveObjs, initLinker )
 import ByteCodeLink    ( HValue, ClosureEnv, extendClosureEnv, linkBCO )
 import ByteCodeItbls   ( ItblEnv )
-import ByteCodeAsm     ( CompiledByteCode(..), bcosFreeNames,
-                         UnlinkedBCO, UnlinkedBCOExpr, nameOfUnlinkedBCO )
-
-import Packages                ( PackageConfig(..), PackageName, PackageConfigMap, lookupPkg,
-                         packageDependents, packageNameString )
-import DriverState     ( v_Library_paths, v_Cmdline_libraries, getPackageConfigMap )
-import DriverUtil      ( splitFilename3 )
-import Finder          ( findModule )
-import HscTypes                ( Linkable(..), isObjectLinkable, nameOfObject, byteCodeOfObject,
-                         Unlinked(..), isInterpretable, isObject, Dependencies(..),
-                         HscEnv(..), PersistentCompilerState(..), ExternalPackageState(..),
-                         HomePackageTable, PackageIfaceTable, ModIface(..), HomeModInfo(..),
-                         lookupIface )
+import ByteCodeAsm     ( CompiledByteCode(..), bcoFreeNames, UnlinkedBCO(..))
+
+import Packages
+import DriverState     ( v_Library_paths, v_Opt_l,
+                         v_Cmdline_frameworks, v_Framework_paths, getStaticOpts )
+import Finder          ( findModule, findLinkable )
+import HscTypes
 import Name            ( Name,  nameModule, isExternalName )
 import NameEnv
 import NameSet         ( nameSetToList )
-import Module          ( ModLocation(..), Module, ModuleName, moduleName, lookupModuleEnvByName )
+import Module
 import FastString      ( FastString(..), unpackFS )
 import ListSetOps      ( minusList )
 import CmdLineOpts     ( DynFlags(verbosity) )
@@ -51,7 +46,6 @@ import BasicTypes     ( SuccessFlag(..), succeeded, failed )
 import Outputable
 import Panic            ( GhcException(..) )
 import Util             ( zipLazy, global )
-import ErrUtils                ( Message )
 
 -- Standard libraries
 import Control.Monad   ( when, filterM, foldM )
@@ -60,7 +54,7 @@ import Data.IORef     ( IORef, readIORef, writeIORef )
 import Data.List       ( partition, nub )
 
 import System.IO       ( putStr, putStrLn, hPutStrLn, stderr, fixIO )
-import System.Directory        ( doesFileExist, getModificationTime )
+import System.Directory        ( doesFileExist )
 
 import Control.Exception ( block, throwDyn )
 
@@ -170,7 +164,7 @@ showLinkerState
 
 \begin{code}
 linkExpr :: HscEnv -> PersistentCompilerState
-        -> UnlinkedBCOExpr -> IO HValue          -- IO BCO# really
+        -> UnlinkedBCO -> IO HValue
 
 -- Link a single expression, *including* first linking packages and 
 -- modules that this expression depends on.
@@ -178,7 +172,7 @@ linkExpr :: HscEnv -> PersistentCompilerState
 -- Raises an IO exception if it can't find a compiled version of the
 -- dependents to link.
 
-linkExpr hsc_env pcs (root_ul_bco, aux_ul_bcos)
+linkExpr hsc_env pcs root_ul_bco
   = do {  
        -- Find what packages and linkables are required
      (lnks, pkgs) <- getLinkDeps hpt pit needed_mods ;
@@ -196,16 +190,15 @@ linkExpr hsc_env pcs (root_ul_bco, aux_ul_bcos)
         ce = closure_env pls
 
        -- Link the necessary packages and linkables
-   ; (_, (root_hval:_)) <- linkSomeBCOs False ie ce all_bcos
+   ; (_, (root_hval:_)) <- linkSomeBCOs False ie ce [root_ul_bco]
    ; return root_hval
    }}
    where
      pit    = eps_PIT (pcs_EPS pcs)
      hpt    = hsc_HPT hsc_env
      dflags = hsc_dflags hsc_env
-     all_bcos   = root_ul_bco : aux_ul_bcos
-     free_names = nameSetToList (bcosFreeNames all_bcos)
-  
+     free_names = nameSetToList (bcoFreeNames root_ul_bco)
+
      needed_mods :: [Module]
      needed_mods = [ nameModule n | n <- free_names, isExternalName n ]
  
@@ -220,35 +213,43 @@ getLinkDeps hpt pit mods
 -- Find all the packages and linkables that a set of modules depends on
  = do {        pls <- readIORef v_PersistentLinkerState ;
        let {
-       -- 1.  Find the iface for each module (must exist), 
-       --     and extract its dependencies
-           deps = [ mi_deps (get_iface mod) | mod <- mods ] ;
-
-       -- 2.  Find the dependent home-pkg-modules/packages from each iface
-       --     Include mods themselves; and exclude ones already linked
-           mods_needed = nub (map moduleName mods ++ [m | dep <- deps, (m,_) <- dep_mods dep])
-                           `minusList`
-                         linked_mods ;
-           linked_mods = map linkableModName (objs_loaded pls ++ bcos_loaded pls) ;
-
-           pkgs_needed = nub (concatMap dep_pkgs deps)
-                            `minusList`
-                         pkgs_loaded pls } ;
+       -- 1.  Find the dependent home-pkg-modules/packages from each iface
+           (mods_s, pkgs_s) = unzip (map get_deps mods) ;
+
+       -- 2.  Exclude ones already linked
+       --      Main reason: avoid findModule calls in get_linkable
+           mods_needed = nub (concat mods_s) `minusList` linked_mods     ;
+           pkgs_needed = nub (concat pkgs_s) `minusList` pkgs_loaded pls ;
+
+           linked_mods = map linkableModName (objs_loaded pls ++ bcos_loaded pls)
+       } ;
        
        -- 3.  For each dependent module, find its linkable
-       --     This will either be in the HPT or (in the case of one-shot compilation)
-       --     we may need to use maybe_getFileLinkable
+       --     This will either be in the HPT or (in the case of one-shot
+       --     compilation) we may need to use maybe_getFileLinkable
        lnks_needed <- mapM get_linkable mods_needed ;
 
        return (lnks_needed, pkgs_needed) }
   where
+    get_deps :: Module -> ([ModuleName],[PackageName])
+       -- Get the things needed for the specified module
+       -- This is rather similar to the code in RnNames.importsFromImportDecl
+    get_deps mod
+       | isHomeModule (mi_module iface) 
+       = (moduleName mod : [m | (m,_) <- dep_mods deps], dep_pkgs deps)
+       | otherwise
+       = ([], mi_package iface : dep_pkgs deps)
+       where
+         iface = get_iface mod
+         deps  = mi_deps iface
+
     get_iface mod = case lookupIface hpt pit mod of
-                       Just iface -> iface
-                       Nothing    -> pprPanic "getLinkDeps" (no_iface mod)
+                           Just iface -> iface
+                           Nothing    -> pprPanic "getLinkDeps" (no_iface mod)
     no_iface mod = ptext SLIT("No iface for") <+> ppr mod
        -- This one is a GHC bug
 
-    no_obj mod = dieWith (ptext SLIT("No compiled code for for") <+> ppr mod)
+    no_obj mod = dieWith (ptext SLIT("No compiled code for") <+> ppr mod)
        -- This one is a build-system bug
 
     get_linkable mod_name      -- A home-package module
@@ -384,23 +385,38 @@ linkLibraries :: DynFlags
 -- specified on the command line. 
 linkLibraries dflags objs
    = do        { lib_paths <- readIORef v_Library_paths
-       ; minus_ls  <- readIORef v_Cmdline_libraries
+       ; opt_l  <- getStaticOpts v_Opt_l
+       ; let minus_ls = [ lib | '-':'l':lib <- opt_l ]
+#ifdef darwin_TARGET_OS
+       ; framework_paths <- readIORef v_Framework_paths
+       ; frameworks <- readIORef v_Cmdline_frameworks
+#endif
         ; let cmdline_lib_specs = map Object objs ++ map DLL minus_ls
-       
+#ifdef darwin_TARGET_OS
+               ++ map Framework frameworks
+#endif
        ; if (null cmdline_lib_specs) then return () 
          else do {
 
                -- Now link them
+#ifdef darwin_TARGET_OS
+       ; mapM_ (preloadLib dflags lib_paths framework_paths) cmdline_lib_specs
+#else
        ; mapM_ (preloadLib dflags lib_paths) cmdline_lib_specs
-
+#endif
        ; maybePutStr dflags "final link ... "
        ; ok <- resolveObjs
        ; if succeeded ok then maybePutStrLn dflags "done."
          else throwDyn (InstallationError "linking extra libraries/objects failed")
        }}
      where
+#ifdef darwin_TARGET_OS
+        preloadLib :: DynFlags -> [String] -> [String] -> LibrarySpec -> IO ()
+        preloadLib dflags lib_paths framework_paths lib_spec
+#else
         preloadLib :: DynFlags -> [String] -> LibrarySpec -> IO ()
         preloadLib dflags lib_paths lib_spec
+#endif
            = do maybePutStr dflags ("Loading object " ++ showLS lib_spec ++ " ... ")
                 case lib_spec of
                    Object static_ish
@@ -413,7 +429,14 @@ linkLibraries dflags objs
                                Nothing -> return ()
                                Just mm -> preloadFailed mm lib_paths lib_spec
                             maybePutStrLn dflags "done"
-
+#ifdef darwin_TARGET_OS
+                   Framework framework
+                      -> do maybe_errstr <- loadFramework framework_paths framework
+                            case maybe_errstr of
+                               Nothing -> return ()
+                               Just mm -> preloadFailed mm framework_paths lib_spec
+                            maybePutStrLn dflags "done"
+#endif
         preloadFailed :: String -> [String] -> LibrarySpec -> IO ()
         preloadFailed sys_errmsg paths spec
            = do maybePutStr dflags
@@ -483,7 +506,7 @@ linkSomeBCOs :: Bool        -- False <=> add _all_ BCOs to returned closure env
                                        
 
 linkSomeBCOs toplevs_only ie ce_in ul_bcos
-   = do let nms = map nameOfUnlinkedBCO ul_bcos
+   = do let nms = map unlinkedBCOName ul_bcos
         hvals <- fixIO 
                     ( \ hvs -> let ce_out = extendClosureEnv ce_in (zipLazy nms hvs)
                                in  mapM (linkBCO ie ce_out) ul_bcos )
@@ -612,11 +635,11 @@ data LibrarySpec
 -- of DLL handles that rts/Linker.c maintains, and that in turn is 
 -- used by lookupSymbol.  So we must call addDLL for each library 
 -- just to get the DLL handle into the list.
-partOfGHCi 
-#          ifndef mingw32_TARGET_OS
-           = [ "base", "haskell98", "haskell-src", "readline" ]
+partOfGHCi
+#          if defined(mingw32_TARGET_OS) || defined(darwin_TARGET_OS)
+           = [ ]
 #          else
-          = [ ]
+           = [ "base", "haskell98", "haskell-src", "readline" ]
 #          endif
 
 showLS (Object nm)  = "(static) " ++ nm
@@ -630,6 +653,13 @@ linkPackages :: DynFlags -> [PackageName] -> IO ()
 -- (unless of course they are already linked)
 -- The dependents are linked automatically, and it doesn't matter
 -- what order you specify the input packages.
+--
+-- NOTE: in fact, since each module tracks all the packages it depends on,
+--      we don't really need to use the package-config dependencies.
+-- However we do need the package-config stuff (to find aux libs etc),
+-- and following them lets us load libraries in the right order, which 
+-- perhaps makes the error message a bit more localised if we get a link
+-- failure.  So the dependency walking code is still here.
 
 linkPackages dflags new_pkgs
    = do        { pls     <- readIORef v_PersistentLinkerState
@@ -664,6 +694,7 @@ linkPackage dflags pkg
    = do 
         let dirs      =  Packages.library_dirs pkg
         let libs      =  Packages.hs_libraries pkg ++ extra_libraries pkg
+                               ++ [ lib | '-':'l':lib <- extra_ld_opts pkg ]
         classifieds   <- mapM (locateOneObj dirs) libs
 #ifdef darwin_TARGET_OS
         let fwDirs    =  Packages.framework_dirs pkg
@@ -781,24 +812,6 @@ findFile mk_file_path (dir:dirs)
             return (Just file_path)
          else
             findFile mk_file_path dirs }
-
-
-findLinkable :: ModuleName -> ModLocation -> IO (Maybe Linkable)
-findLinkable mod locn
-   | Just obj_fn <- ml_obj_file locn
-   = do obj_exist <- doesFileExist obj_fn
-        if not obj_exist 
-         then return Nothing 
-         else 
-         do let stub_fn = case splitFilename3 obj_fn of
-                             (dir, base, ext) -> dir ++ "/" ++ base ++ ".stub_o"
-            stub_exist <- doesFileExist stub_fn
-            obj_time <- getModificationTime obj_fn
-            if stub_exist
-             then return (Just (LM obj_time mod [DotO obj_fn, DotO stub_fn]))
-             else return (Just (LM obj_time mod [DotO obj_fn]))
-   | otherwise
-   = return Nothing
 \end{code}
 
 \begin{code}