[project @ 2000-11-13 17:08:36 by sewardj]

First shot at batch linking.  Does not attempt linking if upsweep
was not completely successful.  Always attempts linking if upsweep
successful, even if there's no 'main' to be found anywhere.

diff --git a/ghc/compiler/compMan/CmLink.lhs b/ghc/compiler/compMan/CmLink.lhs
index c645192..e072564 100644 (file)
--- a/ghc/compiler/compMan/CmLink.lhs
+++ b/ghc/compiler/compMan/CmLink.lhs
@@ -17,7 +17,7 @@ import Interpreter
 import CmStaticInfo    ( PackageConfigInfo )
 import Module          ( ModuleName, PackageName )
 import Outputable      ( SDoc )
-import Digraph         ( SCC(..), flattenSCC )
+import Digraph         ( SCC(..), flattenSCC, flattenSCCs )
 import Outputable
 import Panic           ( panic )
 
@@ -70,6 +70,10 @@ isObject (DotA _) = True
 isObject (DotDLL _) = True
 isObject _ = False
 
+nameOfObject (DotO fn)   = fn
+nameOfObject (DotA fn)   = fn
+nameOfObject (DotDLL fn) = fn
+
 isInterpretable (Trees _ _) = True
 isInterpretable _ = False
 
@@ -91,18 +95,39 @@ emptyPLS = return (PersistentLinkerState {})
 \end{code}
 
 \begin{code}
-link :: PackageConfigInfo 
+-- The first arg is supposed to be DriverPipeline.doLink.
+-- Passed in here to avoid a hard-to-avoid circular dependency
+-- between CmLink and DriverPipeline.  Same deal as with
+-- CmSummarise.summarise.
+link :: ([String] -> IO ()) 
+     -> Bool                   -- was the upsweep completely successful?
+     -> PackageConfigInfo 
      -> [SCC Linkable] 
      -> PersistentLinkerState 
      -> IO LinkResult
 
 #ifndef GHCI_NOTYET
 --link = panic "CmLink.link: not implemented"
-link pci groups pls1
+
+-- For the moment, in the batch linker, we don't bother to
+-- tell doLink which packages to link -- it just tries all that
+-- are available.
+link doLink upsweep_complete_success pci groups pls1
+   | upsweep_complete_success
    = do putStrLn "Hello from the Linker!"
         putStrLn (showSDoc (vcat (map ppLinkableSCC groups)))
-        putStrLn "Bye-bye from the Linker!"
+        let o_files = concatMap getOfiles (flattenSCCs groups)
+        doLink o_files
+        putStrLn "Bye-bye from the Linker!"        
         return (LinkOK pls1)
+   | otherwise
+   = do putStrLn "LINKER: upsweep (partially?) failed; not doing batch linking"
+        return (LinkOK pls1)
+   where
+      getOfiles (LP _)    = []
+      getOfiles (LM _ us) = map nameOfObject (filter isObject us)
+
+   
 
 ppLinkableSCC :: SCC Linkable -> SDoc
 ppLinkableSCC = ppr . flattenSCC

diff --git a/ghc/compiler/compMan/CmSummarise.lhs b/ghc/compiler/compMan/CmSummarise.lhs
index 9971fdf..ede8046 100644 (file)
--- a/ghc/compiler/compMan/CmSummarise.lhs
+++ b/ghc/compiler/compMan/CmSummarise.lhs
@@ -72,7 +72,8 @@ type Fingerprint = Int
 
 -- The first arg is supposed to be DriverPipeline.preprocess.
 -- Passed in here to avoid a hard-to-avoid circular dependency
--- between CmSummarise and DriverPipeline.
+-- between CmSummarise and DriverPipeline.  Same deal as with
+-- CmLink.link.
 summarise :: (FilePath -> IO FilePath)
           -> Module -> ModuleLocation -> IO ModSummary
 summarise preprocess mod location

diff --git a/ghc/compiler/compMan/CompManager.lhs b/ghc/compiler/compMan/CompManager.lhs
index 97622da..732e62a 100644 (file)
--- a/ghc/compiler/compMan/CompManager.lhs
+++ b/ghc/compiler/compMan/CompManager.lhs
@@ -30,7 +30,7 @@ import CmSummarise    ( summarise, ModSummary(..),
 import Module          ( ModuleName, moduleName, packageOfModule, 
                          isModuleInThisPackage, PackageName )
 import CmStaticInfo    ( Package(..), PackageConfigInfo )
-import DriverPipeline  ( compile, preprocess, CompResult(..) )
+import DriverPipeline  ( compile, preprocess, doLink, CompResult(..) )
 import HscTypes                ( HomeSymbolTable, HomeIfaceTable, 
                          PersistentCompilerState )
 import HscMain         ( initPersistentCompilerState )
@@ -167,7 +167,8 @@ cmLoadModule cmstate1 modname
         if upsweepOK
 
          then 
-           do let mods_to_relink = upwards_closure mg2 
+           do putStrLn "UPSWEEP COMPLETELY SUCCESSFUL"
+              let mods_to_relink = upwards_closure mg2 
                                       (map modname_of_linkable newLis)
               pkg_linkables <- find_pkg_linkables_for pcii
                                                       mg2 mods_to_relink
@@ -176,7 +177,7 @@ cmLoadModule cmstate1 modname
               let sccs_to_relink = group_uis ui3 mg2 mods_to_relink
               let all_to_relink  = map AcyclicSCC pkg_linkables 
                                    ++ sccs_to_relink
-              linkresult <- link pcii all_to_relink pls1
+              linkresult <- link doLink True pcii all_to_relink pls1
               case linkresult of
                  LinkErrs _ _
                     -> panic "cmLoadModule: link failed (1)"
@@ -188,14 +189,15 @@ cmLoadModule cmstate1 modname
                           return (cmstate3, Just modname)
 
          else 
-           do let mods_to_relink = downwards_closure mg2 
+           do putStrLn "UPSWEEP PARTIALLY SUCCESSFUL"
+              let mods_to_relink = downwards_closure mg2 
                                       (map name_of_summary (flattenSCCs sccOKs))
               pkg_linkables <- find_pkg_linkables_for pcii
                                                       mg2 mods_to_relink
               let sccs_to_relink = group_uis ui3 mg2 mods_to_relink
               let all_to_relink  = map AcyclicSCC pkg_linkables 
                                    ++ sccs_to_relink
-              linkresult <- link pcii all_to_relink pls1
+              linkresult <- link doLink False pcii all_to_relink pls1
               let (hst4, hit4, ui4) 
                      = removeFromTopLevelEnvs mods_to_relink (hst3,hit3,ui3)
               case linkresult of