X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FGHC.hs;h=157539eabad41735c11ebc09dddffe0b414e60c7;hb=8604da0136707cc14845d14a88c2272fe576b6d0;hp=c44cc83541839aedb8ad19a4b5fc20991fa077c0;hpb=98c68a1c5b63aadf9c7917274519d95bbe9394d4;p=ghc-hetmet.git diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs index c44cc83..157539e 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("") + rootLoc = mkGeneralSrcSpan (fsLit "") -- 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 @@ -1895,8 +1898,9 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod) maybe_buf exc 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 @@ -1982,11 +1986,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)