X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FLinker.lhs;h=f59eecc0b048276224c7973c67f9ec16ebc7dcb7;hb=3bec818f91e382b882f8de4bdab8036884eb657f;hp=640fc9d696c019a51239060804b0d4fbb69c2bec;hpb=2c92736ea5a4aedf263a77d58c6e9b032a05b7ef;p=ghc-hetmet.git

diff --git a/compiler/ghci/Linker.lhs b/compiler/ghci/Linker.lhs
index 640fc9d..f59eecc 100644
--- a/compiler/ghci/Linker.lhs
+++ b/compiler/ghci/Linker.lhs
@@ -28,7 +28,6 @@ import ByteCodeLink
 import ByteCodeItbls
 import ByteCodeAsm
 import RtClosureInspect
-import Var
 import IfaceEnv
 import Config
 import OccName
@@ -55,6 +54,7 @@ import StaticFlags
 import ErrUtils
 import DriverPhases
 import SrcLoc
+import UniqSet
 
 -- Standard libraries
 import Control.Monad
@@ -63,7 +63,6 @@ import Control.Arrow    ( second )
 import Data.IORef
 import Data.List
 import Foreign.Ptr
-import GHC.Exts
 
 import System.IO
 import System.Directory
@@ -202,7 +201,9 @@ recoverDCInRTS a = do
 getHValue :: Name -> IO (Maybe HValue)
 getHValue name = do
     pls <- readIORef v_PersistentLinkerState
-    return$ fmap snd (lookupNameEnv (closure_env pls) name)
+    case lookupNameEnv (closure_env pls) name of
+      Just (_,x) -> return$ Just x
+      _          -> return Nothing
 
 withExtendedLinkEnv :: [(Name,HValue)] -> IO a -> IO a
 withExtendedLinkEnv new_env action
@@ -474,17 +475,18 @@ getLinkDeps hsc_env hpt pit maybe_normal_osuf span mods
  = do {	pls <- readIORef v_PersistentLinkerState ;
 	let {
 	-- 1.  Find the dependent home-pkg-modules/packages from each iface
-	    (mods_s, pkgs_s) = unzip (map get_deps mods) ;
+	    (mods_s, pkgs_s) = follow_deps mods emptyUniqSet emptyUniqSet;
 
 	-- 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 ;
+	    mods_needed = mods_s `minusList` linked_mods     ;
+	    pkgs_needed = pkgs_s `minusList` pkgs_loaded pls ;
 
 	    linked_mods = map (moduleName.linkableModule) 
                                 (objs_loaded pls ++ bcos_loaded pls)
 	} ;
 	
+--        putStrLn (showSDoc (ppr mods_s)) ;
 	-- 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
@@ -495,17 +497,43 @@ getLinkDeps hsc_env hpt pit maybe_normal_osuf span mods
     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
+        -- The ModIface contains the transitive closure of the module dependencies
+        -- within the current package, *except* for boot modules: if we encounter
+        -- a boot module, we have to find its real interface and discover the
+        -- dependencies of that.  Hence we need to traverse the dependency
+        -- tree recursively.  See bug #936, testcase ghci/prog007.
+    follow_deps :: [Module]             -- modules to follow
+                -> UniqSet ModuleName         -- accum. module dependencies
+                -> UniqSet PackageId          -- accum. package dependencies
+                -> ([ModuleName], [PackageId]) -- result
+    follow_deps []     acc_mods acc_pkgs
+        = (uniqSetToList acc_mods, uniqSetToList acc_pkgs)
+    follow_deps (mod:mods) acc_mods acc_pkgs
         | pkg /= this_pkg
-        = ([], pkg : dep_pkgs deps)
+        = follow_deps mods acc_mods (addOneToUniqSet acc_pkgs' pkg)
+        | mi_boot iface
+        = link_boot_mod_error mod
 	| otherwise
-	= (moduleName mod : [m | (m,_) <- dep_mods deps], dep_pkgs deps)
-	where
-          pkg   = modulePackageId mod
-	  deps  = mi_deps (get_iface mod)
+        = follow_deps (map (mkModule this_pkg) boot_deps ++ mods) acc_mods' acc_pkgs'
+      where
+        pkg   = modulePackageId mod
+        iface = get_iface mod
+	deps  = mi_deps iface
+
+	pkg_deps = dep_pkgs deps
+        (boot_deps, mod_deps) = partitionWith is_boot (dep_mods deps)
+                where is_boot (m,True)  = Left m
+                      is_boot (m,False) = Right m
+
+        boot_deps' = filter (not . (`elementOfUniqSet` acc_mods)) boot_deps
+        acc_mods'  = addListToUniqSet acc_mods (moduleName mod : mod_deps)
+        acc_pkgs'  = addListToUniqSet acc_pkgs pkg_deps
+
+
+    link_boot_mod_error mod = 
+        throwDyn (ProgramError (showSDoc (
+            text "module" <+> ppr mod <+> 
+            text "cannot be linked; it is only available as a boot module")))
 
     get_iface mod = case lookupIfaceByModule dflags hpt pit mod of
 			    Just iface -> iface
@@ -728,7 +756,7 @@ linkSomeBCOs toplevs_only ie ce_in de_in ul_bcos
         let de_additions = [(address, name) | (address, name) <- zip addresses names
                                             , not(address `elemAddressEnv` de_in) 
                            ]
-            de_out = extendAddressEnvList' de_in de_additions
+            de_out = extendAddressEnvList de_in de_additions
         return ( ce_out, de_out, hvals)
     where 
           goForRefs = getRefs []