X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FLinker.lhs;h=819e62035608ce33d00980a562912e2957fd39fd;hb=a00334cc6a209c009c7b6e5dc3926f3871c9b097;hp=cec1047be8da3436f32542122321170b06220577;hpb=6f5d77444aec9d84d9af59315c6c7885de33ed55;p=ghc-hetmet.git

diff --git a/compiler/ghci/Linker.lhs b/compiler/ghci/Linker.lhs
index cec1047..819e620 100644
--- a/compiler/ghci/Linker.lhs
+++ b/compiler/ghci/Linker.lhs
@@ -1,5 +1,5 @@
 %
-% (c) The University of Glasgow 2005
+% (c) The University of Glasgow 2005-2006
 %
 
 -- --------------------------------------
@@ -12,7 +12,6 @@ necessary.
 
 
 \begin{code}
-
 {-# OPTIONS -optc-DNON_POSIX_SOURCE -#include "Linker.h" #-}
 
 module Linker ( HValue, showLinkerState,
@@ -23,42 +22,43 @@ module Linker ( HValue, showLinkerState,
 
 #include "HsVersions.h"
 
-import ObjLink		( loadDLL, loadObj, unloadObj, resolveObjs, initObjLinker )
-import ByteCodeLink	( HValue, ClosureEnv, extendClosureEnv, linkBCO )
-import ByteCodeItbls	( ItblEnv )
-import ByteCodeAsm	( CompiledByteCode(..), bcoFreeNames, UnlinkedBCO(..))
+import ObjLink
+import ByteCodeLink
+import ByteCodeItbls
+import ByteCodeAsm
 
 import Packages
-import DriverPhases	( isObjectFilename, isDynLibFilename )
-import Finder		( findModule, findObjectLinkableMaybe, FindResult(..) )
+import DriverPhases
+import Finder
 import HscTypes
-import Name		( Name, nameModule, isExternalName, isWiredInName )
+import Name
 import NameEnv
-import NameSet		( nameSetToList )
+import NameSet
+import UniqFM
 import Module
-import ListSetOps	( minusList )
-import DynFlags		( DynFlags(..), getOpts )
-import BasicTypes	( SuccessFlag(..), succeeded, failed )
+import ListSetOps
+import DynFlags
+import BasicTypes
 import Outputable
-import Panic            ( GhcException(..) )
-import Util             ( zipLazy, global, joinFileExt, joinFileName, suffixOf,
-			  replaceFilenameSuffix )
-import StaticFlags	( v_Ld_inputs, v_Build_tag )
-import ErrUtils         ( debugTraceMsg, mkLocMessage )
-import DriverPhases	( phaseInputExt, Phase(..) )
-import SrcLoc		( SrcSpan )
+import PackageConfig
+import Panic
+import Util
+import StaticFlags
+import ErrUtils
+import DriverPhases
+import SrcLoc
 
 -- Standard libraries
-import Control.Monad	( when, filterM, foldM )
-
-import Data.IORef	( IORef, readIORef, writeIORef, modifyIORef )
-import Data.List	( partition, nub )
+import Control.Monad
+ 
+import Data.IORef
+import Data.List
 
-import System.IO	( putStr, putStrLn, hPutStrLn, stderr, fixIO )
-import System.Directory	( doesFileExist )
+import System.IO
+import System.Directory
 
-import Control.Exception ( block, throwDyn, bracket )
-import Maybe		( isJust, fromJust )
+import Control.Exception
+import Data.Maybe
 
 #if __GLASGOW_HASKELL__ >= 503
 import GHC.IOBase	( IO(..) )
@@ -122,9 +122,7 @@ emptyPLS dflags = PersistentLinkerState {
   --
   -- The linker's symbol table is populated with RTS symbols using an
   -- explicit list.  See rts/Linker.c for details.
-  where init_pkgs
-	  | ExtPackage rts_id <- rtsPackageId (pkgState dflags) = [rts_id]
-	  | otherwise = []
+  where init_pkgs = [rtsPackageId]
 \end{code}
 
 \begin{code}
@@ -192,7 +190,6 @@ We initialise the dynamic linker by
 a) calling the C initialisation procedure
 
 b) Loading any packages specified on the command line,
-   now held in v_ExplicitPackages
 
 c) Loading any packages specified on the command line,
    now held in the -l options in v_Opt_l
@@ -221,7 +218,7 @@ reallyInitDynLinker dflags
 	; initObjLinker 
 
 		-- (b) Load packages from the command-line
-	; linkPackages dflags (explicitPackages (pkgState dflags))
+	; linkPackages dflags (preloadPackages (pkgState dflags))
 
 	   	-- (c) Link libraries from the command-line
 	; let optl = getOpts dflags opt_l
@@ -363,7 +360,6 @@ linkExpr hsc_env span root_ul_bco
    }}
    where
      hpt    = hsc_HPT hsc_env
-     dflags = hsc_dflags hsc_env
      free_names = nameSetToList (bcoFreeNames root_ul_bco)
 
      needed_mods :: [Module]
@@ -413,7 +409,8 @@ getLinkDeps hsc_env hpt pit maybe_normal_osuf span mods
 	    mods_needed = nub (concat mods_s) `minusList` linked_mods     ;
 	    pkgs_needed = nub (concat pkgs_s) `minusList` pkgs_loaded pls ;
 
-	    linked_mods = map linkableModule (objs_loaded pls ++ bcos_loaded pls)
+	    linked_mods = map (moduleName.linkableModule) 
+                                (objs_loaded pls ++ bcos_loaded pls)
 	} ;
 	
 	-- 3.  For each dependent module, find its linkable
@@ -423,19 +420,22 @@ getLinkDeps hsc_env hpt pit maybe_normal_osuf span mods
 
 	return (lnks_needed, pkgs_needed) }
   where
-    get_deps :: Module -> ([Module],[PackageId])
+    dflags = hsc_dflags hsc_env
+    this_pkg = thisPackage dflags
+
+    get_deps :: Module -> ([ModuleName],[PackageId])
 	-- Get the things needed for the specified module
 	-- This is rather similar to the code in RnNames.importsFromImportDecl
     get_deps mod
-	| ExtPackage p <- mi_package iface
-	= ([], p : dep_pkgs deps)
+        | pkg /= this_pkg
+        = ([], pkg : dep_pkgs deps)
 	| otherwise
-	= (mod : [m | (m,_) <- dep_mods deps], dep_pkgs deps)
+	= (moduleName mod : [m | (m,_) <- dep_mods deps], dep_pkgs deps)
 	where
-	  iface = get_iface mod
-	  deps  = mi_deps iface
+          pkg   = modulePackageId mod
+	  deps  = mi_deps (get_iface mod)
 
-    get_iface mod = case lookupIface hpt pit mod of
+    get_iface mod = case lookupIfaceByModule dflags hpt pit mod of
 			    Just iface -> iface
 			    Nothing    -> pprPanic "getLinkDeps" (no_iface mod)
     no_iface mod = ptext SLIT("No iface for") <+> ppr mod
@@ -451,23 +451,22 @@ getLinkDeps hsc_env hpt pit maybe_normal_osuf span mods
 	-- This one is a build-system bug
 
     get_linkable maybe_normal_osuf mod_name	-- A home-package module
-	| Just mod_info <- lookupModuleEnv hpt mod_name 
+	| Just mod_info <- lookupUFM hpt mod_name 
 	= ASSERT(isJust (hm_linkable mod_info))
 	  adjust_linkable (fromJust (hm_linkable mod_info))
 	| otherwise	
-	=	-- It's not in the HPT because we are in one shot mode, 
+	= do	-- It's not in the HPT because we are in one shot mode, 
 		-- so use the Finder to get a ModLocation...
-	  do { mb_stuff <- findModule hsc_env mod_name False ;
-	       case mb_stuff of {
-		  Found loc _ -> found loc mod_name ;
+	     mb_stuff <- findHomeModule hsc_env mod_name
+	     case mb_stuff of
+		  Found loc mod -> found loc mod
 		  _ -> no_obj mod_name
-	     }}
-	where
-	    found loc mod_name = do {
+        where
+            found loc mod = do {
 		-- ...and then find the linkable for it
-	       mb_lnk <- findObjectLinkableMaybe mod_name loc ;
+	       mb_lnk <- findObjectLinkableMaybe mod loc ;
 	       case mb_lnk of {
-		  Nothing -> no_obj mod_name ;
+		  Nothing -> no_obj mod ;
 		  Just lnk -> adjust_linkable lnk
 	      }}