X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FDriverMkDepend.hs;h=481cd0c983f51f790bb0edd649e0e9c41543b6e1;hb=54ef1c3c9ef6cecd968d5c1ed6ded3a1a201a870;hp=cb8f57a51a7e3bc8fdf1e5a2b5df4aa33819ee14;hpb=aa37e329f5027ef04fe0153b51a7bfff20b1f101;p=ghc-hetmet.git diff --git a/compiler/main/DriverMkDepend.hs b/compiler/main/DriverMkDepend.hs index cb8f57a..481cd0c 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 ----------------------------------------------------------------------------- -- @@ -29,23 +25,20 @@ 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 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 ) @@ -64,7 +57,7 @@ doMkDependHS session srcs -- 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 + ; let excl_mods = depExcludeMods dflags ; r <- GHC.depanal session excl_mods True {- Allow dup roots -} ; case r of Nothing -> exitWith (ExitFailure 1) @@ -79,7 +72,7 @@ doMkDependHS session srcs -- Prcess them one by one, dumping results into makefile -- and complaining about cycles - ; mapM (processDeps session excl_mods (mkd_tmp_hdl files)) sorted + ; mapM (processDeps dflags session excl_mods (mkd_tmp_hdl files)) sorted -- If -ddump-mod-cycles, show cycles in the module graph ; dumpModCycles dflags mod_summaries @@ -104,17 +97,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 +127,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 +148,8 @@ beginMkDependHS dflags = do -- ----------------------------------------------------------------- -processDeps :: Session +processDeps :: DynFlags + -> Session -> [ModuleName] -> Handle -- Write dependencies to here -> SCC ModSummary @@ -179,15 +169,15 @@ 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 session excl_mods hdl (AcyclicSCC node) + = do { hsc_env <- GHC.sessionHscEnv session + ; 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 @@ -228,12 +218,12 @@ findDependency :: HscEnv -> 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 _ 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 ; case r of - Found loc mod + Found loc _ -- Home package: just depend on the .hi or hi-boot file | isJust (ml_hs_file loc) -> return (Just (addBootSuffix_maybe is_boot (ml_hi_file loc))) @@ -306,7 +296,7 @@ endMkDependHS dflags hPutStrLn tmp_hdl l slurp - catchJust ioErrors slurp + catchIO slurp (\e -> if isEOFError e then return () else ioError e) hClose hdl @@ -376,7 +366,7 @@ pprCycle summaries = pp_group (CyclicSCC summaries) 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 +379,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) ) - ]