[project @ 2000-11-14 13:59:44 by sewardj]

Only do batch linking if the upsweep succeeds and someone exports Main.main.

diff --git a/ghc/compiler/basicTypes/BasicTypes.lhs b/ghc/compiler/basicTypes/BasicTypes.lhs
index 820a3b9..7551596 100644 (file)
--- a/ghc/compiler/basicTypes/BasicTypes.lhs
+++ b/ghc/compiler/basicTypes/BasicTypes.lhs
@@ -36,7 +36,9 @@ module BasicTypes(
        InsideLam, insideLam, notInsideLam,
        OneBranch, oneBranch, notOneBranch,
 
-        EP(..)
+        EP(..),
+
+        GhciMode(..)
    ) where
 
 #include "HsVersions.h"
@@ -202,6 +204,17 @@ isNonRec NonRecursive = True
 
 %************************************************************************
 %*                                                                     *
+\subsection[Interactive/Batch]{Interactive/Batch flag}
+%*                                                                     *
+%************************************************************************
+
+\begin{code} 
+data GhciMode = Batch
+              | Interactive
+\end{code}
+
+%************************************************************************
+%*                                                                     *
 \subsection[Generic]{Generic flag}
 %*                                                                     *
 %************************************************************************

diff --git a/ghc/compiler/compMan/CmLink.lhs b/ghc/compiler/compMan/CmLink.lhs
index e072564..12b1f7f 100644 (file)
--- a/ghc/compiler/compMan/CmLink.lhs
+++ b/ghc/compiler/compMan/CmLink.lhs
@@ -20,6 +20,7 @@ import Outputable     ( SDoc )
 import Digraph         ( SCC(..), flattenSCC, flattenSCCs )
 import Outputable
 import Panic           ( panic )
+import BasicTypes      ( GhciMode(..) )
 
 #include "HsVersions.h"
 \end{code}
@@ -100,7 +101,8 @@ emptyPLS = return (PersistentLinkerState {})
 -- between CmLink and DriverPipeline.  Same deal as with
 -- CmSummarise.summarise.
 link :: ([String] -> IO ()) 
-     -> Bool                   -- was the upsweep completely successful?
+     -> GhciMode               -- interactive or batch
+     -> Bool                   -- attempt linking in batch mode?
      -> PackageConfigInfo 
      -> [SCC Linkable] 
      -> PersistentLinkerState 
@@ -112,22 +114,31 @@ link :: ([String] -> IO ())
 -- 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!"
+-- batch_attempt_linking should only be *looked at* in 
+-- 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
+   | batch_attempt_linking
+   = do putStrLn "LINK(batch): linkables are ..."
         putStrLn (showSDoc (vcat (map ppLinkableSCC groups)))
         let o_files = concatMap getOfiles (flattenSCCs groups)
         doLink o_files
-        putStrLn "Bye-bye from the Linker!"        
+       -- doLink only returns if it succeeds
+        putStrLn "LINK(batch): done"
         return (LinkOK pls1)
    | otherwise
-   = do putStrLn "LINKER: upsweep (partially?) failed; not doing batch linking"
+   = do putStrLn "LINKER(batch): upsweep (partially?) failed OR main not exported;"
+        putStrLn "               -- not doing linking"
         return (LinkOK pls1)
    where
       getOfiles (LP _)    = []
       getOfiles (LM _ us) = map nameOfObject (filter isObject us)
 
-   
+link doLink Interactive batch_attempt_linking pci groups pls1
+   = do putStrLn "LINKER(interactive): not yet implemented"
+        return (LinkOK pls1)
+
 
 ppLinkableSCC :: SCC Linkable -> SDoc
 ppLinkableSCC = ppr . flattenSCC

diff --git a/ghc/compiler/compMan/CompManager.lhs b/ghc/compiler/compMan/CompManager.lhs
index 732e62a..a7d5ef9 100644 (file)
--- a/ghc/compiler/compMan/CompManager.lhs
+++ b/ghc/compiler/compMan/CompManager.lhs
@@ -14,6 +14,7 @@ where
 
 import List            ( nub )
 import Maybe           ( catMaybes, maybeToList, fromMaybe )
+import Maybes          ( maybeToBool )
 import Outputable
 import UniqFM          ( emptyUFM, lookupUFM, addToUFM, delListFromUFM )
 import Digraph         ( SCC(..), stronglyConnComp, flattenSCC, flattenSCCs )
@@ -28,13 +29,17 @@ import CmSummarise  ( summarise, ModSummary(..),
                          name_of_summary, deps_of_summary,
                          mimp_name, ms_get_imports )
 import Module          ( ModuleName, moduleName, packageOfModule, 
-                         isModuleInThisPackage, PackageName )
+                         isModuleInThisPackage, PackageName, moduleEnvElts )
 import CmStaticInfo    ( Package(..), PackageConfigInfo )
 import DriverPipeline  ( compile, preprocess, doLink, CompResult(..) )
 import HscTypes                ( HomeSymbolTable, HomeIfaceTable, 
-                         PersistentCompilerState )
+                         PersistentCompilerState, ModDetails(..) )
+import Name            ( lookupNameEnv )
+import PrelNames       ( mainName )
 import HscMain         ( initPersistentCompilerState )
 import Finder          ( findModule, emptyHomeDirCache )
+import BasicTypes      ( GhciMode(..) )
+import Util            ( unJust )
 \end{code}
 
 
@@ -163,11 +168,13 @@ cmLoadModule cmstate1 modname
 
         -- Try and do linking in some form, depending on whether the
         -- upsweep was completely or only partially successful.
+        let ghci_mode = Batch  -- ToDo: fix!
 
         if upsweepOK
 
          then 
            do putStrLn "UPSWEEP COMPLETELY SUCCESSFUL"
+              let someone_exports_main = any exports_main (moduleEnvElts hst3)
               let mods_to_relink = upwards_closure mg2 
                                       (map modname_of_linkable newLis)
               pkg_linkables <- find_pkg_linkables_for pcii
@@ -177,7 +184,8 @@ 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 doLink True pcii all_to_relink pls1
+              linkresult <- link doLink ghci_mode someone_exports_main
+                                 pcii all_to_relink pls1
               case linkresult of
                  LinkErrs _ _
                     -> panic "cmLoadModule: link failed (1)"
@@ -197,7 +205,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 doLink False pcii all_to_relink pls1
+              linkresult <- link doLink ghci_mode False pcii all_to_relink pls1
               let (hst4, hit4, ui4) 
                      = removeFromTopLevelEnvs mods_to_relink (hst3,hit3,ui3)
               case linkresult of
@@ -210,6 +218,9 @@ cmLoadModule cmstate1 modname
                                  = CmState { pcms=pcms4, pcs=pcs3, pls=pls4 }
                           return (cmstate4, Just modname)
 
+exports_main :: ModDetails -> Bool
+exports_main md
+   = maybeToBool (lookupNameEnv (md_types md) mainName)
 
 -- Given a (home) module graph and a bunch of names of (home) modules
 -- within that graph, return the names of any packages needed by the