X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fmain%2FGHC.hs;h=3b8f51ee17009dcb1cdefcff1b9fab6caa53a423;hp=c44cc83541839aedb8ad19a4b5fc20991fa077c0;hb=25628e2771424cae1b3366322e8ce6f8a85440f9;hpb=98c68a1c5b63aadf9c7917274519d95bbe9394d4

diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
index c44cc83..3b8f51e 100644
--- a/compiler/main/GHC.hs
+++ b/compiler/main/GHC.hs
@@ -218,7 +218,8 @@ import TcRnMonad        ( initIfaceCheck )
 import Packages
 import NameSet
 import RdrName
-import HsSyn 
+import qualified HsSyn -- hack as we want to reexport the whole module
+import HsSyn hiding ((<.>))
 import Type             hiding (typeKind)
 import TcType           hiding (typeKind)
 import Id
@@ -247,7 +248,7 @@ import StaticFlags
 import SysTools     ( initSysTools, cleanTempFiles, cleanTempFilesExcept,
                       cleanTempDirs )
 import Module
-import UniqFM
+import LazyUniqFM
 import UniqSet
 import Unique
 import FiniteMap
@@ -265,6 +266,7 @@ import BasicTypes
 import Maybes		( expectJust, mapCatMaybes )
 import HaddockParse
 import HaddockLex       ( tokenise )
+import FastString
 
 import Control.Concurrent
 import System.Directory ( getModificationTime, doesFileExist,
@@ -277,6 +279,7 @@ import System.Exit	( exitWith, ExitCode(..) )
 import System.Time	( ClockTime, getClockTime )
 import Control.Exception as Exception hiding (handle)
 import Data.IORef
+import System.FilePath
 import System.IO
 import System.IO.Error	( try, isDoesNotExistError )
 import Prelude hiding (init)
@@ -395,7 +398,7 @@ guessOutputFile s = modifySession s $ \env ->
             let isMain = (== mainModIs dflags) . ms_mod
             [ms] <- return (filter isMain mod_graph)
             ml_hs_file (ms_location ms)
-        guessedName = fmap basenameOf mainModuleSrcPath
+        guessedName = fmap dropExtension mainModuleSrcPath
     in
     case outputFile dflags of
         Just _ -> env
@@ -456,8 +459,8 @@ guessTarget file Nothing
 	   else do
 	return (Target (TargetModule (mkModuleName file)) Nothing)
      where 
-	 hs_file  = file `joinFileExt` "hs"
-	 lhs_file = file `joinFileExt` "lhs"
+	 hs_file  = file <.> "hs"
+	 lhs_file = file <.> "lhs"
 
 -- -----------------------------------------------------------------------------
 -- Extending the program scope
@@ -1603,7 +1606,7 @@ warnUnnecessarySourceImports dflags sccs =
 	warn :: Located ModuleName -> WarnMsg
 	warn (L loc mod) = 
 	   mkPlainErrMsg loc
-		(ptext SLIT("Warning: {-# SOURCE #-} unnecessary in import of ")
+		(ptext (sLit "Warning: {-# SOURCE #-} unnecessary in import of ")
 		 <+> quotes (ppr mod))
 
 -----------------------------------------------------------------------------
@@ -1660,7 +1663,7 @@ downsweep hsc_env old_summaries excl_mods allow_dup_roots
 		   Nothing -> packageModErr modl
 		   Just s  -> return s
 
-	rootLoc = mkGeneralSrcSpan FSLIT("<command line>")
+	rootLoc = mkGeneralSrcSpan (fsLit "<command line>")
 
 	-- In a root module, the filename is allowed to diverge from the module
 	-- name, so we have to check that there aren't multiple root files
@@ -1769,7 +1772,7 @@ summariseFile hsc_env old_summaries file mb_phase maybe_buf
    	let dflags = hsc_dflags hsc_env
 
 	(dflags', hspp_fn, buf)
-	    <- preprocessFile dflags file mb_phase maybe_buf
+	    <- preprocessFile hsc_env file mb_phase maybe_buf
 
         (srcimps,the_imps, L _ mod_name) <- getImports dflags' buf hspp_fn file
 
@@ -1890,13 +1893,14 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod) maybe_buf exc
       = do
 	-- Preprocess the source file and get its imports
 	-- The dflags' contains the OPTIONS pragmas
-	(dflags', hspp_fn, buf) <- preprocessFile dflags src_fn Nothing maybe_buf
+	(dflags', hspp_fn, buf) <- preprocessFile hsc_env src_fn Nothing maybe_buf
         (srcimps, the_imps, L mod_loc mod_name) <- getImports dflags' buf hspp_fn src_fn
 
 	when (mod_name /= wanted_mod) $
 		throwDyn $ mkPlainErrMsg mod_loc $ 
-			      text "file name does not match module name"
-			      <+> quotes (ppr mod_name)
+			      text "File name does not match module name:" 
+			      $$ text "Saw:" <+> quotes (ppr mod_name)
+                              $$ text "Expected:" <+> quotes (ppr wanted_mod)
 
 		-- Find the object timestamp, and return the summary
 	obj_timestamp <- getObjTimestamp location is_boot
@@ -1919,16 +1923,17 @@ getObjTimestamp location is_boot
 	       else modificationTimeIfExists (ml_obj_file location)
 
 
-preprocessFile :: DynFlags -> FilePath -> Maybe Phase -> Maybe (StringBuffer,ClockTime)
+preprocessFile :: HscEnv -> FilePath -> Maybe Phase -> Maybe (StringBuffer,ClockTime)
   -> IO (DynFlags, FilePath, StringBuffer)
-preprocessFile dflags src_fn mb_phase Nothing
+preprocessFile hsc_env src_fn mb_phase Nothing
   = do
-	(dflags', hspp_fn) <- preprocess dflags (src_fn, mb_phase)
+	(dflags', hspp_fn) <- preprocess hsc_env (src_fn, mb_phase)
 	buf <- hGetStringBuffer hspp_fn
 	return (dflags', hspp_fn, buf)
 
-preprocessFile dflags src_fn mb_phase (Just (buf, _time))
+preprocessFile hsc_env src_fn mb_phase (Just (buf, _time))
   = do
+        let dflags = hsc_dflags hsc_env
 	-- case we bypass the preprocessing stage?
 	let 
 	    local_opts = getOptions buf src_fn
@@ -1982,11 +1987,11 @@ multiRootsErr summs@(summ1:_)
 
 cyclicModuleErr :: [ModSummary] -> SDoc
 cyclicModuleErr ms
-  = hang (ptext SLIT("Module imports form a cycle for modules:"))
+  = hang (ptext (sLit "Module imports form a cycle for modules:"))
        2 (vcat (map show_one ms))
   where
     show_one ms = sep [ show_mod (ms_hsc_src ms) (ms_mod ms),
-			nest 2 $ ptext SLIT("imports:") <+> 
+			nest 2 $ ptext (sLit "imports:") <+> 
 				   (pp_imps HsBootFile (ms_srcimps ms)
 				   $$ pp_imps HsSrcFile  (ms_imps ms))]
     show_mod hsc_src mod = ppr mod <> text (hscSourceString hsc_src)