X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FLinker.lhs;h=d2c7fe10810dd1510d673826352a3fe34931b315;hb=1a1164f580d910ad41cb52a17c989cef02010dae;hp=e105bb26f2de87b9a36ff5d3c7167c0bad06a324;hpb=8d5364c135b7d40ae62c63ff9e65c684a1712694;p=ghc-hetmet.git

diff --git a/compiler/ghci/Linker.lhs b/compiler/ghci/Linker.lhs
index e105bb2..d2c7fe1 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
@@ -476,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
@@ -497,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
@@ -724,22 +750,14 @@ linkSomeBCOs toplevs_only ie ce_in de_in ul_bcos
 		     -- closure environment, which leads to trouble.
 		     ASSERT (all (not . (`elemNameEnv` ce_in)) (map fst ce_additions))
 		     extendClosureEnv ce_in ce_additions
-            refs  = goForRefs ul_bcos
-            names = nub$ concatMap (ssElts . unlinkedBCOItbls) (ul_bcos ++ refs)
+            names = concatMap (ssElts . unlinkedBCOItbls) ul_bcos
         addresses <- mapM (lookupIE ie) names
         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 []
-          getRefs acc []  = acc
-          getRefs acc new = getRefs (new++acc) 
-                 [bco | BCOPtrBCO bco <- concatMap (ssElts . unlinkedBCOPtrs) new
-                      , notElemBy bco (new ++ acc) nameEq]
-          ul1 `nameEq` ul2 = unlinkedBCOName ul1 == unlinkedBCOName ul2
-          (x1 `notElemBy` x2) eq = null$ intersectBy eq [x1] x2
+
 \end{code}