X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FDriverMkDepend.hs;h=adfcbbdbf0071f67e49e9f25142113991e739c68;hb=aedb94f5f220b5e442b23ecc445fd38c8d9b6ba0;hp=cb8f57a51a7e3bc8fdf1e5a2b5df4aa33819ee14;hpb=aa37e329f5027ef04fe0153b51a7bfff20b1f101;p=ghc-hetmet.git diff --git a/compiler/main/DriverMkDepend.hs b/compiler/main/DriverMkDepend.hs index cb8f57a..adfcbbd 100644 --- a/compiler/main/DriverMkDepend.hs +++ b/compiler/main/DriverMkDepend.hs @@ -1,9 +1,5 @@ -{-# OPTIONS -w #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and fix --- any warnings in the module. See --- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings --- for details +{-# OPTIONS -fno-cse #-} +-- -fno-cse is needed for GLOBAL_VAR's to behave properly ----------------------------------------------------------------------------- -- @@ -20,32 +16,31 @@ module DriverMkDepend ( #include "HsVersions.h" import qualified GHC -import GHC ( Session, ModSummary(..) ) +import GHC ( ModSummary(..), GhcMonad ) +import HsSyn ( ImportDecl(..) ) +import PrelNames import DynFlags import Util -import HscTypes ( HscEnv, IsBootInterface, msObjFilePath, msHsFilePath ) +import HscTypes ( HscEnv, IsBootInterface, msObjFilePath, msHsFilePath, getSession ) import SysTools ( newTempName ) import qualified SysTools import Module import Digraph ( SCC(..) ) import Finder ( findImportedModule, FindResult(..) ) -import Util ( global, consIORef ) import Outputable import Panic import SrcLoc import Data.List -import CmdLineParser import FastString +import Exception import ErrUtils ( debugTraceMsg, putMsg ) +import MonadUtils ( liftIO ) -import Data.IORef ( IORef, readIORef, writeIORef ) -import Control.Exception -import System.Exit ( ExitCode(..), exitWith ) import System.Directory import System.FilePath import System.IO -import SYSTEM_IO_ERROR ( isEOFError ) +import System.IO.Error ( isEOFError ) import Control.Monad ( when ) import Data.Maybe ( isJust ) @@ -55,37 +50,42 @@ import Data.Maybe ( isJust ) -- ----------------------------------------------------------------- -doMkDependHS :: Session -> [FilePath] -> IO () -doMkDependHS session srcs - = do { -- Initialisation - dflags <- GHC.getSessionDynFlags session - ; files <- beginMkDependHS dflags - - -- Do the downsweep to find all the modules - ; targets <- mapM (\s -> GHC.guessTarget s Nothing) srcs - ; GHC.setTargets session targets - ; excl_mods <- readIORef v_Dep_exclude_mods - ; r <- GHC.depanal session excl_mods True {- Allow dup roots -} - ; case r of - Nothing -> exitWith (ExitFailure 1) - Just mod_summaries -> do { +doMkDependHS :: GhcMonad m => [FilePath] -> m () +doMkDependHS srcs = do + -- Initialisation + dflags <- GHC.getSessionDynFlags + files <- liftIO $ beginMkDependHS dflags + + -- Do the downsweep to find all the modules + targets <- mapM (\s -> GHC.guessTarget s Nothing) srcs + GHC.setTargets targets + let excl_mods = depExcludeMods dflags + mod_summaries <- GHC.depanal excl_mods True {- Allow dup roots -} + + -- Sort into dependency order + -- There should be no cycles + let sorted = GHC.topSortModuleGraph False mod_summaries Nothing + + -- Print out the dependencies if wanted + liftIO $ debugTraceMsg dflags 2 (text "Module dependencies" $$ ppr sorted) - -- Sort into dependency order - -- There should be no cycles - let sorted = GHC.topSortModuleGraph False mod_summaries Nothing + -- Prcess them one by one, dumping results into makefile + -- and complaining about cycles + hsc_env <- getSession + mapM (liftIO . processDeps dflags hsc_env excl_mods (mkd_tmp_hdl files)) sorted - -- Print out the dependencies if wanted - ; debugTraceMsg dflags 2 (text "Module dependencies" $$ ppr sorted) + -- If -ddump-mod-cycles, show cycles in the module graph + liftIO $ dumpModCycles dflags mod_summaries - -- Prcess them one by one, dumping results into makefile - -- and complaining about cycles - ; mapM (processDeps session excl_mods (mkd_tmp_hdl files)) sorted + -- Tidy up + liftIO $ endMkDependHS dflags files - -- If -ddump-mod-cycles, show cycles in the module graph - ; dumpModCycles dflags mod_summaries + -- Unconditional exiting is a bad idea. If an error occurs we'll get an + --exception; if that is not caught it's fine, but at least we have a + --chance to find out exactly what went wrong. Uncomment the following + --line if you disagree. - -- Tidy up - ; endMkDependHS dflags files }} + --`GHC.ghcCatch` \_ -> io $ exitWith (ExitFailure 1) ----------------------------------------------------------------- -- @@ -104,17 +104,13 @@ data MkDepFiles beginMkDependHS :: DynFlags -> IO MkDepFiles beginMkDependHS dflags = do - -- slurp in the mkdependHS-style options - let flags = getOpts dflags opt_dep - _ <- processArgs dep_opts flags - -- open a new temp file in which to stuff the dependency info -- as we go along. tmp_file <- newTempName dflags "dep" tmp_hdl <- openFile tmp_file WriteMode -- open the makefile - makefile <- readIORef v_Dep_makefile + let makefile = depMakefile dflags exists <- doesFileExist makefile mb_make_hdl <- if not exists @@ -138,9 +134,9 @@ beginMkDependHS dflags = do then return () else chuck - catchJust ioErrors slurp + catchIO slurp (\e -> if isEOFError e then return () else ioError e) - catchJust ioErrors chuck + catchIO chuck (\e -> if isEOFError e then return () else ioError e) return (Just makefile_hdl) @@ -159,7 +155,8 @@ beginMkDependHS dflags = do -- ----------------------------------------------------------------- -processDeps :: Session +processDeps :: DynFlags + -> HscEnv -> [ModuleName] -> Handle -- Write dependencies to here -> SCC ModSummary @@ -179,20 +176,19 @@ processDeps :: Session -- -- For {-# SOURCE #-} imports the "hi" will be "hi-boot". -processDeps session excl_mods hdl (CyclicSCC nodes) +processDeps _ _ _ _ (CyclicSCC nodes) = -- There shouldn't be any cycles; report them - throwDyn (ProgramError (showSDoc $ GHC.cyclicModuleErr nodes)) + ghcError (ProgramError (showSDoc $ GHC.cyclicModuleErr nodes)) -processDeps session excl_mods hdl (AcyclicSCC node) - = do { extra_suffixes <- readIORef v_Dep_suffixes - ; hsc_env <- GHC.sessionHscEnv session - ; include_pkg_deps <- readIORef v_Dep_include_pkg_deps - ; let src_file = msHsFilePath node +processDeps dflags hsc_env excl_mods hdl (AcyclicSCC node) + = do { let extra_suffixes = depSuffixes dflags + include_pkg_deps = depIncludePkgDeps dflags + src_file = msHsFilePath node obj_file = msObjFilePath node obj_files = insertSuffixes obj_file extra_suffixes - do_imp is_boot imp_mod - = do { mb_hi <- findDependency hsc_env src_file imp_mod + do_imp is_boot pkg_qual imp_mod + = do { mb_hi <- findDependency hsc_env pkg_qual imp_mod is_boot include_pkg_deps ; case mb_hi of { Nothing -> return () ; @@ -212,30 +208,34 @@ processDeps session excl_mods hdl (AcyclicSCC node) -- Emit a dependency for each import - -- SOURCE imports - ; mapM_ (do_imp True) - (filter (`notElem` excl_mods) (map unLoc (ms_srcimps node))) + ; let do_imps is_boot idecls = sequence_ + [ do_imp is_boot (ideclPkgQual i) mod + | L _ i <- idecls, + let mod = unLoc (ideclName i), + mod `notElem` excl_mods ] + + ; do_imps True (ms_srcimps node) + ; do_imps False (ms_imps node) - -- regular imports - ; mapM_ (do_imp False) - (filter (`notElem` excl_mods) (map unLoc (ms_imps node))) + ; when (dopt Opt_ImplicitPrelude (ms_hspp_opts node)) $ + do_imp False Nothing pRELUDE_NAME } findDependency :: HscEnv - -> FilePath -- Importing module: used only for error msg + -> Maybe FastString -- package qualifier, if any -> ModuleName -- Imported module -> IsBootInterface -- Source import -> Bool -- Record dependency on package modules -> IO (Maybe FilePath) -- Interface file file -findDependency hsc_env src imp is_boot include_pkg_deps +findDependency hsc_env pkg imp is_boot include_pkg_deps = do { -- Find the module; this will be fast because -- we've done it once during downsweep - r <- findImportedModule hsc_env imp Nothing + r <- findImportedModule hsc_env imp pkg ; case r of - Found loc mod + Found loc _ -- Home package: just depend on the .hi or hi-boot file - | isJust (ml_hs_file loc) + | isJust (ml_hs_file loc) || include_pkg_deps -> return (Just (addBootSuffix_maybe is_boot (ml_hi_file loc))) -- Not in this package: we don't need a dependency @@ -306,7 +306,7 @@ endMkDependHS dflags hPutStrLn tmp_hdl l slurp - catchJust ioErrors slurp + catchIO slurp (\e -> if isEOFError e then return () else ioError e) hClose hdl @@ -361,7 +361,7 @@ pprCycle summaries = pp_group (CyclicSCC summaries) pp_ms loop_breaker $$ vcat (map pp_group groups) where (boot_only, others) = partition is_boot_only mss - is_boot_only ms = not (any in_group (ms_imps ms)) + is_boot_only ms = not (any in_group (map (ideclName.unLoc) (ms_imps ms))) in_group (L _ m) = m `elem` group_mods group_mods = map (moduleName . ms_mod) mss @@ -370,13 +370,13 @@ pprCycle summaries = pp_group (CyclicSCC summaries) groups = GHC.topSortModuleGraph True all_others Nothing pp_ms summary = text mod_str <> text (take (20 - length mod_str) (repeat ' ')) - <+> (pp_imps empty (ms_imps summary) $$ - pp_imps (ptext (sLit "{-# SOURCE #-}")) (ms_srcimps summary)) + <+> (pp_imps empty (map (ideclName.unLoc) (ms_imps summary)) $$ + pp_imps (ptext (sLit "{-# SOURCE #-}")) (map (ideclName.unLoc) (ms_srcimps summary))) where mod_str = moduleNameString (moduleName (ms_mod summary)) pp_imps :: SDoc -> [Located ModuleName] -> SDoc - pp_imps what [] = empty + pp_imps _ [] = empty pp_imps what lms = case [m | L _ m <- lms, m `elem` cycle_mods] of [] -> empty @@ -389,28 +389,7 @@ pprCycle summaries = pp_group (CyclicSCC summaries) -- ----------------------------------------------------------------- - -- Flags -GLOBAL_VAR(v_Dep_makefile, "Makefile", String); -GLOBAL_VAR(v_Dep_include_pkg_deps, False, Bool); -GLOBAL_VAR(v_Dep_exclude_mods, [], [ModuleName]); -GLOBAL_VAR(v_Dep_suffixes, [], [String]); -GLOBAL_VAR(v_Dep_warnings, True, Bool); - +depStartMarker, depEndMarker :: String depStartMarker = "# DO NOT DELETE: Beginning of Haskell dependencies" depEndMarker = "# DO NOT DELETE: End of Haskell dependencies" --- for compatibility with the old mkDependHS, we accept options of the form --- -optdep-f -optdep.depend, etc. -dep_opts = - [ ( "s", SepArg (consIORef v_Dep_suffixes) ) - , ( "f", SepArg (writeIORef v_Dep_makefile) ) - , ( "w", NoArg (writeIORef v_Dep_warnings False) ) - - , ( "-include-prelude", NoArg (writeIORef v_Dep_include_pkg_deps True) ) - -- -include-prelude is the old name for -include-pkg-deps, kept around - -- for backward compatibility, but undocumented - - , ( "-include-pkg-deps", NoArg (writeIORef v_Dep_include_pkg_deps True) ) - , ( "-exclude-module=", Prefix (consIORef v_Dep_exclude_mods . mkModuleName) ) - , ( "x", Prefix (consIORef v_Dep_exclude_mods . mkModuleName) ) - ]