X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FLinker.lhs;h=a7e9492deaa8d6e3124ca4db2ae2d63d6a8c9c5d;hb=98de5f474de6eb5dc9b2e2ec582e02902fdb3856;hp=5c05122ed40bc1dfe50f18a07fd372d10261c084;hpb=4fa44a3ae9c36222ccb460ba3ed24e46bf7c70ae;p=ghc-hetmet.git

diff --git a/compiler/ghci/Linker.lhs b/compiler/ghci/Linker.lhs
index 5c05122..a7e9492 100644
--- a/compiler/ghci/Linker.lhs
+++ b/compiler/ghci/Linker.lhs
@@ -51,6 +51,7 @@ import ErrUtils
 import SrcLoc
 import qualified Maybes
 import UniqSet
+import FiniteMap
 import Constants
 import FastString
 import Config		( cProjectVersion )
@@ -526,8 +527,8 @@ dieWith span msg = ghcError (ProgramError (showSDoc (mkLocMessage span msg)))
 
 checkNonStdWay :: DynFlags -> SrcSpan -> IO (Maybe String)
 checkNonStdWay dflags srcspan = do
-  tag <- readIORef v_Build_tag
-  if null tag then return Nothing else do
+  let tag = buildTag dflags
+  if null tag || tag == "dyn" then return Nothing else do
   let default_osuf = phaseInputExt StopLn
   if objectSuf dflags == default_osuf
 	then failNonStd srcspan
@@ -973,23 +974,25 @@ linkPackages dflags new_pkgs = do
 linkPackages' :: DynFlags -> [PackageId] -> PersistentLinkerState
              -> IO PersistentLinkerState
 linkPackages' dflags new_pks pls = do
-    let pkg_map = pkgIdMap (pkgState dflags)
-
-    pkgs' <- link pkg_map (pkgs_loaded pls) new_pks
-
+    pkgs' <- link (pkgs_loaded pls) new_pks
     return $! pls { pkgs_loaded = pkgs' }
   where
-     link :: PackageConfigMap -> [PackageId] -> [PackageId] -> IO [PackageId]
-     link pkg_map pkgs new_pkgs =
-         foldM (link_one pkg_map) pkgs new_pkgs
+     pkg_map = pkgIdMap (pkgState dflags)
+     ipid_map = installedPackageIdMap (pkgState dflags)
+
+     link :: [PackageId] -> [PackageId] -> IO [PackageId]
+     link pkgs new_pkgs =
+         foldM link_one pkgs new_pkgs
 
-     link_one pkg_map pkgs new_pkg
+     link_one pkgs new_pkg
 	| new_pkg `elem` pkgs	-- Already linked
 	= return pkgs
 
 	| Just pkg_cfg <- lookupPackage pkg_map new_pkg
 	= do { 	-- Link dependents first
-	       pkgs' <- link pkg_map pkgs (map mkPackageId (depends pkg_cfg))
+               pkgs' <- link pkgs [ Maybes.expectJust "link_one" $
+                                    lookupFM ipid_map ipid
+                                  | ipid <- depends pkg_cfg ]
 		-- Now link the package itself
 	     ; linkPackage dflags pkg_cfg
 	     ; return (new_pkg : pkgs') }
@@ -1021,7 +1024,7 @@ linkPackage dflags pkg
 	let dlls = [ dll | DLL dll    <- classifieds ]
 	    objs = [ obj | Object obj <- classifieds ]
 
-	maybePutStr dflags ("Loading package " ++ display (package pkg) ++ " ... ")
+	maybePutStr dflags ("Loading package " ++ display (sourcePackageId pkg) ++ " ... ")
 
 	-- See comments with partOfGHCi
 	when (packageName pkg `notElem` partOfGHCi) $ do
@@ -1045,7 +1048,7 @@ linkPackage dflags pkg
         maybePutStr dflags "linking ... "
         ok <- resolveObjs
 	if succeeded ok then maybePutStrLn dflags "done."
-	      else ghcError (InstallationError ("unable to load package `" ++ display (package pkg) ++ "'"))
+	      else ghcError (InstallationError ("unable to load package `" ++ display (sourcePackageId pkg) ++ "'"))
 
 load_dyn :: [FilePath] -> FilePath -> IO ()
 load_dyn dirs dll = do r <- loadDynamic dirs dll