Cmm back end upgrades

[ghc-hetmet.git] / compiler / main / GHC.hs

diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
index 0caa1cb..3b8f51e 100644 (file)
--- a/compiler/main/GHC.hs
+++ b/compiler/main/GHC.hs
@@ -266,6 +266,7 @@ import BasicTypes
 import Maybes          ( expectJust, mapCatMaybes )
 import HaddockParse
 import HaddockLex       ( tokenise )
+import FastString
 
 import Control.Concurrent
 import System.Directory ( getModificationTime, doesFileExist,
@@ -1605,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))
 
 -----------------------------------------------------------------------------
@@ -1662,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
@@ -1771,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
 
@@ -1892,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
@@ -1921,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
@@ -1984,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)