[project @ 2000-11-15 15:43:30 by sewardj]

[ghc-hetmet.git] / ghc / compiler / compMan / CmLink.lhs

diff --git a/ghc/compiler/compMan/CmLink.lhs b/ghc/compiler/compMan/CmLink.lhs
index 12b1f7f..9940eca 100644 (file)
--- a/ghc/compiler/compMan/CmLink.lhs
+++ b/ghc/compiler/compMan/CmLink.lhs
@@ -6,6 +6,7 @@
 \begin{code}
 module CmLink ( Linkable(..),  Unlinked(..),
                filterModuleLinkables, 
+               findModuleLinkable,
                modname_of_linkable, is_package_linkable,
                LinkResult(..),
                 link, 
@@ -14,13 +15,12 @@ where
 
 
 import Interpreter
-import CmStaticInfo    ( PackageConfigInfo )
+import CmStaticInfo    ( PackageConfigInfo, GhciMode(..) )
 import Module          ( ModuleName, PackageName )
 import Outputable      ( SDoc )
-import Digraph         ( SCC(..), flattenSCC, flattenSCCs )
+import Digraph         ( SCC(..), flattenSCC )
 import Outputable
 import Panic           ( panic )
-import BasicTypes      ( GhciMode(..) )
 
 #include "HsVersions.h"
 \end{code}
@@ -86,6 +86,13 @@ instance Outputable Linkable where
    ppr (LM mod_nm unlinkeds) = text "LinkableM" <+> ppr mod_nm <+> ppr unlinkeds
    ppr (LP package_nm)       = text "LinkableP" <+> ptext package_nm
 
+findModuleLinkable :: [Linkable] -> ModuleName -> Linkable
+findModuleLinkable lis mod 
+   = case [LM nm us | LM nm us <- lis, nm == mod] of
+        [li] -> li
+        other -> pprPanic "findModuleLinkable" (ppr mod)
+
+
 emptyPLS :: IO PersistentLinkerState
 #ifdef GHCI
 emptyPLS = return (PersistentLinkerState { closure_env = emptyFM, 
@@ -103,8 +110,7 @@ emptyPLS = return (PersistentLinkerState {})
 link :: ([String] -> IO ()) 
      -> GhciMode               -- interactive or batch
      -> Bool                   -- attempt linking in batch mode?
-     -> PackageConfigInfo 
-     -> [SCC Linkable] 
+     -> [Linkable]             -- only contains LMs, not LPs
      -> PersistentLinkerState 
      -> IO LinkResult
 
@@ -118,11 +124,11 @@ link :: ([String] -> IO ())
 -- batch mode.  It should only be True if the upsweep was
 -- successful and someone exports main, i.e., we have good
 -- reason to believe that linking will succeed.
-link doLink Batch batch_attempt_linking pci groups pls1
+link doLink Batch batch_attempt_linking linkables pls1
    | batch_attempt_linking
    = do putStrLn "LINK(batch): linkables are ..."
-        putStrLn (showSDoc (vcat (map ppLinkableSCC groups)))
-        let o_files = concatMap getOfiles (flattenSCCs groups)
+        putStrLn (showSDoc (vcat (map ppr linkables)))
+        let o_files = concatMap getOfiles linkables
         doLink o_files
        -- doLink only returns if it succeeds
         putStrLn "LINK(batch): done"
@@ -132,10 +138,10 @@ link doLink Batch batch_attempt_linking pci groups pls1
         putStrLn "               -- not doing linking"
         return (LinkOK pls1)
    where
-      getOfiles (LP _)    = []
+      getOfiles (LP _)    = panic "link.getOfiles: shouldn't get package linkables"
       getOfiles (LM _ us) = map nameOfObject (filter isObject us)
 
-link doLink Interactive batch_attempt_linking pci groups pls1
+link doLink Interactive batch_attempt_linking linkables pls1
    = do putStrLn "LINKER(interactive): not yet implemented"
         return (LinkOK pls1)