X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=inline;f=ghc%2Fcompiler%2FcompMan%2FCompManager.lhs;h=84ff5aed59b5f15aec7cb9917b214a5565ed0143;hb=5c9bcb9bf34b8f1dff3d78e8f89e98eaa09a51b5;hp=f026f5bb2938e94ec06e3862caed130f86458492;hpb=af2c228cab644ee3cf83ae43c6639f80c3333afa;p=ghc-hetmet.git

diff --git a/ghc/compiler/compMan/CompManager.lhs b/ghc/compiler/compMan/CompManager.lhs
index f026f5b..84ff5ae 100644
--- a/ghc/compiler/compMan/CompManager.lhs
+++ b/ghc/compiler/compMan/CompManager.lhs
@@ -57,7 +57,7 @@ where
 #include "HsVersions.h"
 
 import DriverPipeline	( CompResult(..), preprocess, compile, link )
-import DriverState	( v_Output_file )
+import DriverState	( v_Output_file, v_NoHsMain )
 import DriverPhases
 import DriverUtil
 import Finder
@@ -232,9 +232,9 @@ moduleNameToModule hpt mn = do
     _not_a_home_module -> do
 	  maybe_stuff <- findModule mn
 	  case maybe_stuff of
-	    Nothing -> throwDyn (CmdLineError ("can't find module `"
+	    Left _ -> throwDyn (CmdLineError ("can't find module `"
 	  			    ++ moduleNameUserString mn ++ "'"))
-	    Just (m,_) -> return m
+	    Right (m,_) -> return m
 
 cmGetContext :: CmState -> IO ([String],[String])
 cmGetContext CmState{ic=ic} = 
@@ -256,16 +256,17 @@ cmModuleIsInterpreted cmstate str
 cmInfoThing :: CmState -> DynFlags -> String -> IO (CmState, [(TyThing,Fixity)])
 cmInfoThing cmstate dflags id
    = do (new_pcs, things) <- hscThing hsc_env pcs icontext id
-	let pairs = map (\x -> (x, getFixity new_pcs (getName x))) things
+	let new_pit = eps_PIT (pcs_EPS new_pcs)
+	    pairs = map (\x -> (x, getFixity new_pit (getName x))) things
 	return (cmstate{ pcs=new_pcs }, pairs)
    where
      CmState{ hpt=hpt, pcs=pcs, ic=icontext } = cmstate
      hsc_env = HscEnv { hsc_mode   = Interactive,
 			hsc_dflags = dflags,
 			hsc_HPT    = hpt }
-     pit = eps_PIT (pcs_EPS pcs)
-     getFixity :: PersistentCompilerState -> Name -> Fixity
-     getFixity pcs name
+
+     getFixity :: PackageIfaceTable -> Name -> Fixity
+     getFixity pit name
 	| isExternalName name,
 	  Just iface  <- lookupIface hpt pit (nameModule name),
 	  Just (FixitySig _ fixity _) <- lookupNameEnv (mi_fixities iface) name
@@ -489,7 +490,7 @@ cmDepAnal cmstate dflags rootnames
   = do showPass dflags "Chasing dependencies"
        when (verbosity dflags >= 1 && gmode cmstate == Batch) $
            hPutStrLn stderr (showSDoc (hcat [
-	     text progName, text ": chasing modules from: ",
+	     text "Chasing modules from: ",
 	     hcat (punctuate comma (map text rootnames))]))
        downsweep rootnames (mg cmstate)
 
@@ -570,7 +571,7 @@ cmLoadModules cmstate1 dflags mg2unsorted
 		    valid_old_linkables
 
         when (verb >= 2) $
-           putStrLn (showSDoc (text "Stable modules:" 
+           hPutStrLn stderr (showSDoc (text "Stable modules:" 
                                <+> sep (map (text.moduleNameUserString) stable_mods)))
 
 	-- Unload any modules which are going to be re-linked this
@@ -637,15 +638,22 @@ cmLoadModules cmstate1 dflags mg2unsorted
 	      -- clean up after ourselves
 	      cleanTempFilesExcept verb (ppFilesFromSummaries modsDone)
 
-	      -- issue a warning for the confusing case where the user said '-o foo'
-	      -- but we're not going to do any linking.
 	      ofile <- readIORef v_Output_file
-	      when (ghci_mode == Batch && isJust ofile && not a_root_is_Main
+	      no_hs_main <- readIORef v_NoHsMain
+
+	      -- Issue a warning for the confusing case where the user
+	      -- said '-o foo' but we're not going to do any linking.
+	      -- We attempt linking if either (a) one of the modules is
+	      -- called Main, or (b) the user said -no-hs-main, indicating
+	      -- that main() is going to come from somewhere else.
+	      --
+	      let do_linking = a_root_is_Main || no_hs_main
+	      when (ghci_mode == Batch && isJust ofile && not do_linking
 		     && verb > 0) $
 	         hPutStrLn stderr "Warning: output was redirected with -o, but no output will be generated\nbecause there is no Main module."
 
 	      -- link everything together
-              linkresult <- link ghci_mode dflags a_root_is_Main (hptLinkables hpt3)
+              linkresult <- link ghci_mode dflags do_linking hpt3 
 
 	      cmLoadFinish Succeeded linkresult 
 			   hpt3 modsDone ghci_mode pcs3
@@ -672,7 +680,7 @@ cmLoadModules cmstate1 dflags mg2unsorted
 	      cleanTempFilesExcept verb (ppFilesFromSummaries mods_to_keep)
 
 	      -- Link everything together
-              linkresult <- link ghci_mode dflags False (hptLinkables hpt4)
+              linkresult <- link ghci_mode dflags False hpt4
 
 	      cmLoadFinish Failed linkresult 
 			   hpt4 mods_to_keep ghci_mode pcs3
@@ -1161,15 +1169,13 @@ downsweep roots old_summaries
         getSummary (currentMod,nm)
            = do found <- findModule nm
 		case found of
-		   Just (mod, location) -> do
+		   Right (mod, location) -> do
 			let old_summary = findModInSummaries old_summaries mod
 			summarise mod location old_summary
 
-		   Nothing -> 
-		        throwDyn (CmdLineError 
-                                   ("can't find module `" 
-                                     ++ showSDoc (ppr nm) ++ "' (while processing " 
-				     ++ show currentMod ++ ")"))
+		   Left files -> do
+			dflags <- getDynFlags
+			throwDyn (noModError dflags currentMod nm files)
 
         -- loop invariant: env doesn't contain package modules
         loop :: [(FilePath,ModuleName)] -> ModuleEnv ModSummary -> IO [ModSummary]
@@ -1190,6 +1196,18 @@ downsweep roots old_summaries
                 loop new_imps (extendModuleEnvList env 
 				[ (ms_mod s, s) | s <- new_home_summaries ])
 
+-- ToDo: we don't have a proper line number for this error
+noModError dflags loc mod_nm files = ProgramError (showSDoc (
+  hang (text loc <> colon) 4 $
+    (text "Can't find module" <+> quotes (ppr mod_nm) $$ extra)
+  ))
+  where
+   extra
+    | verbosity dflags < 3 =
+        text "(use -v to see a list of the files searched for)"
+    | otherwise =
+        hang (ptext SLIT("locations searched:")) 4 (vcat (map text files))
+
 -----------------------------------------------------------------------------
 -- Summarising modules