From aa37e329f5027ef04fe0153b51a7bfff20b1f101 Mon Sep 17 00:00:00 2001 From: Ian Lynagh Date: Sat, 14 Jun 2008 13:29:14 +0000 Subject: [PATCH] Fix whitespace in DriverMkDepend --- compiler/main/DriverMkDepend.hs | 453 +++++++++++++++++++-------------------- 1 file changed, 226 insertions(+), 227 deletions(-) diff --git a/compiler/main/DriverMkDepend.hs b/compiler/main/DriverMkDepend.hs index 95587cd..cb8f57a 100644 --- a/compiler/main/DriverMkDepend.hs +++ b/compiler/main/DriverMkDepend.hs @@ -14,21 +14,21 @@ ----------------------------------------------------------------------------- module DriverMkDepend ( - doMkDependHS + doMkDependHS ) where #include "HsVersions.h" import qualified GHC -import GHC ( Session, ModSummary(..) ) +import GHC ( Session, ModSummary(..) ) import DynFlags import Util -import HscTypes ( HscEnv, IsBootInterface, msObjFilePath, msHsFilePath ) -import SysTools ( newTempName ) +import HscTypes ( HscEnv, IsBootInterface, msObjFilePath, msHsFilePath ) +import SysTools ( newTempName ) import qualified SysTools import Module -import Digraph ( SCC(..) ) -import Finder ( findImportedModule, FindResult(..) ) +import Digraph ( SCC(..) ) +import Finder ( findImportedModule, FindResult(..) ) import Util ( global, consIORef ) import Outputable import Panic @@ -39,9 +39,9 @@ import FastString import ErrUtils ( debugTraceMsg, putMsg ) -import Data.IORef ( IORef, readIORef, writeIORef ) +import Data.IORef ( IORef, readIORef, writeIORef ) import Control.Exception -import System.Exit ( ExitCode(..), exitWith ) +import System.Exit ( ExitCode(..), exitWith ) import System.Directory import System.FilePath import System.IO @@ -51,200 +51,199 @@ import Data.Maybe ( isJust ) ----------------------------------------------------------------- -- --- The main function +-- The main function -- ----------------------------------------------------------------- doMkDependHS :: Session -> [FilePath] -> IO () doMkDependHS session srcs - = do { -- Initialisation - dflags <- GHC.getSessionDynFlags session - ; files <- beginMkDependHS dflags + = 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 { + -- 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 { - -- Sort into dependency order - -- There should be no cycles - let sorted = GHC.topSortModuleGraph False mod_summaries Nothing + -- Sort into dependency order + -- There should be no cycles + let sorted = GHC.topSortModuleGraph False mod_summaries Nothing - -- Print out the dependencies if wanted - ; debugTraceMsg dflags 2 (text "Module dependencies" $$ ppr sorted) + -- Print out the dependencies if wanted + ; debugTraceMsg dflags 2 (text "Module dependencies" $$ ppr sorted) - -- Prcess them one by one, dumping results into makefile - -- and complaining about cycles - ; mapM (processDeps session excl_mods (mkd_tmp_hdl files)) sorted + -- Prcess them one by one, dumping results into makefile + -- and complaining about cycles + ; mapM (processDeps session excl_mods (mkd_tmp_hdl files)) sorted - -- If -ddump-mod-cycles, show cycles in the module graph - ; dumpModCycles dflags mod_summaries + -- If -ddump-mod-cycles, show cycles in the module graph + ; dumpModCycles dflags mod_summaries - -- Tidy up - ; endMkDependHS dflags files }} + -- Tidy up + ; endMkDependHS dflags files }} ----------------------------------------------------------------- -- --- beginMkDependHs --- Create a temporary file, --- find the Makefile, --- slurp through it, etc +-- beginMkDependHs +-- Create a temporary file, +-- find the Makefile, +-- slurp through it, etc -- ----------------------------------------------------------------- -data MkDepFiles - = MkDep { mkd_make_file :: FilePath, -- Name of the makefile - mkd_make_hdl :: Maybe Handle, -- Handle for the open makefile - mkd_tmp_file :: FilePath, -- Name of the temporary file - mkd_tmp_hdl :: Handle } -- Handle of the open temporary file +data MkDepFiles + = MkDep { mkd_make_file :: FilePath, -- Name of the makefile + mkd_make_hdl :: Maybe Handle, -- Handle for the open makefile + mkd_tmp_file :: FilePath, -- Name of the temporary file + mkd_tmp_hdl :: Handle } -- Handle of the open temporary file beginMkDependHS :: DynFlags -> IO MkDepFiles - beginMkDependHS dflags = do - -- slurp in the mkdependHS-style options + -- 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. + -- 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 + -- open the makefile makefile <- readIORef v_Dep_makefile exists <- doesFileExist makefile - mb_make_hdl <- - if not exists - then return Nothing - else do - makefile_hdl <- openFile makefile ReadMode - - -- slurp through until we get the magic start string, - -- copying the contents into dep_makefile - let slurp = do - l <- hGetLine makefile_hdl - if (l == depStartMarker) - then return () - else do hPutStrLn tmp_hdl l; slurp - - -- slurp through until we get the magic end marker, - -- throwing away the contents - let chuck = do - l <- hGetLine makefile_hdl - if (l == depEndMarker) - then return () - else chuck - - catchJust ioErrors slurp - (\e -> if isEOFError e then return () else ioError e) - catchJust ioErrors chuck - (\e -> if isEOFError e then return () else ioError e) - - return (Just makefile_hdl) - - - -- write the magic marker into the tmp file + mb_make_hdl <- + if not exists + then return Nothing + else do + makefile_hdl <- openFile makefile ReadMode + + -- slurp through until we get the magic start string, + -- copying the contents into dep_makefile + let slurp = do + l <- hGetLine makefile_hdl + if (l == depStartMarker) + then return () + else do hPutStrLn tmp_hdl l; slurp + + -- slurp through until we get the magic end marker, + -- throwing away the contents + let chuck = do + l <- hGetLine makefile_hdl + if (l == depEndMarker) + then return () + else chuck + + catchJust ioErrors slurp + (\e -> if isEOFError e then return () else ioError e) + catchJust ioErrors chuck + (\e -> if isEOFError e then return () else ioError e) + + return (Just makefile_hdl) + + + -- write the magic marker into the tmp file hPutStrLn tmp_hdl depStartMarker - return (MkDep { mkd_make_file = makefile, mkd_make_hdl = mb_make_hdl, - mkd_tmp_file = tmp_file, mkd_tmp_hdl = tmp_hdl}) + return (MkDep { mkd_make_file = makefile, mkd_make_hdl = mb_make_hdl, + mkd_tmp_file = tmp_file, mkd_tmp_hdl = tmp_hdl}) ----------------------------------------------------------------- -- --- processDeps +-- processDeps -- ----------------------------------------------------------------- processDeps :: Session - -> [ModuleName] - -> Handle -- Write dependencies to here - -> SCC ModSummary - -> IO () + -> [ModuleName] + -> Handle -- Write dependencies to here + -> SCC ModSummary + -> IO () -- Write suitable dependencies to handle -- Always: --- this.o : this.hs +-- this.o : this.hs -- -- If the dependency is on something other than a .hi file: --- this.o this.p_o ... : dep +-- this.o this.p_o ... : dep -- otherwise --- this.o ... : dep.hi --- this.p_o ... : dep.p_hi --- ... +-- this.o ... : dep.hi +-- this.p_o ... : dep.p_hi +-- ... -- (where .o is $osuf, and the other suffixes come from -- the cmdline -s options). -- -- For {-# SOURCE #-} imports the "hi" will be "hi-boot". processDeps session excl_mods hdl (CyclicSCC nodes) - = -- There shouldn't be any cycles; report them + = -- There shouldn't be any cycles; report them throwDyn (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 - 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 - is_boot include_pkg_deps - ; case mb_hi of { - Nothing -> return () ; - Just hi_file -> do - { let hi_files = insertSuffixes hi_file extra_suffixes - write_dep (obj,hi) = writeDependency hdl [obj] hi - - -- Add one dependency for each suffix; - -- e.g. A.o : B.hi - -- A.x_o : B.x_hi - ; mapM_ write_dep (obj_files `zip` hi_files) }}} - - - -- Emit std dependency of the object(s) on the source file - -- Something like A.o : A.hs - ; writeDependency hdl obj_files src_file - - -- Emit a dependency for each import - - -- SOURCE imports - ; mapM_ (do_imp True) - (filter (`notElem` excl_mods) (map unLoc (ms_srcimps node))) - - -- regular imports - ; mapM_ (do_imp False) - (filter (`notElem` excl_mods) (map unLoc (ms_imps node))) - } - - -findDependency :: HscEnv - -> FilePath -- Importing module: used only for error msg - -> ModuleName -- Imported module - -> IsBootInterface -- Source import - -> Bool -- Record dependency on package modules - -> IO (Maybe FilePath) -- Interface file file + = 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 + 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 + is_boot include_pkg_deps + ; case mb_hi of { + Nothing -> return () ; + Just hi_file -> do + { let hi_files = insertSuffixes hi_file extra_suffixes + write_dep (obj,hi) = writeDependency hdl [obj] hi + + -- Add one dependency for each suffix; + -- e.g. A.o : B.hi + -- A.x_o : B.x_hi + ; mapM_ write_dep (obj_files `zip` hi_files) }}} + + + -- Emit std dependency of the object(s) on the source file + -- Something like A.o : A.hs + ; writeDependency hdl obj_files src_file + + -- Emit a dependency for each import + + -- SOURCE imports + ; mapM_ (do_imp True) + (filter (`notElem` excl_mods) (map unLoc (ms_srcimps node))) + + -- regular imports + ; mapM_ (do_imp False) + (filter (`notElem` excl_mods) (map unLoc (ms_imps node))) + } + + +findDependency :: HscEnv + -> FilePath -- Importing module: used only for error msg + -> 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 - = 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 - -- 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))) - - -- Not in this package: we don't need a dependency - | otherwise - -> return Nothing - - _ -> panic "findDependency" - } + = 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 + -- 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))) + + -- Not in this package: we don't need a dependency + | otherwise + -> return Nothing + + _ -> panic "findDependency" + } ----------------------------- writeDependency :: Handle -> [FilePath] -> FilePath -> IO () @@ -255,23 +254,23 @@ writeDependency hdl targets dep where forOutput = escapeSpaces . reslash Forwards . normalise ----------------------------- -insertSuffixes - :: FilePath -- Original filename; e.g. "foo.o" - -> [String] -- Extra suffices e.g. ["x","y"] - -> [FilePath] -- Zapped filenames e.g. ["foo.o", "foo.x_o", "foo.y_o"] - -- Note that that the extra bit gets inserted *before* the old suffix - -- We assume the old suffix contains no dots, so we can strip it with removeSuffix - - -- NOTE: we used to have this comment - -- In order to construct hi files with alternate suffixes, we - -- now have to find the "basename" of the hi file. This is - -- difficult because we can't just split the hi filename - -- at the last dot - the hisuf might have dots in it. So we - -- check whether the hi filename ends in hisuf, and if it does, - -- we strip off hisuf, otherwise we strip everything after the - -- last dot. - -- But I'm not sure we care about hisufs with dots in them. - -- Lots of other things will break first! +insertSuffixes + :: FilePath -- Original filename; e.g. "foo.o" + -> [String] -- Extra suffices e.g. ["x","y"] + -> [FilePath] -- Zapped filenames e.g. ["foo.o", "foo.x_o", "foo.y_o"] + -- Note that that the extra bit gets inserted *before* the old suffix + -- We assume the old suffix contains no dots, so we can strip it with removeSuffix + + -- NOTE: we used to have this comment + -- In order to construct hi files with alternate suffixes, we + -- now have to find the "basename" of the hi file. This is + -- difficult because we can't just split the hi filename + -- at the last dot - the hisuf might have dots in it. So we + -- check whether the hi filename ends in hisuf, and if it does, + -- we strip off hisuf, otherwise we strip everything after the + -- last dot. + -- But I'm not sure we care about hisufs with dots in them. + -- Lots of other things will break first! insertSuffixes file_name extras = file_name : [ basename <.> (extra ++ "_" ++ suffix) | extra <- extras ] @@ -283,16 +282,16 @@ insertSuffixes file_name extras ----------------------------------------------------------------- -- --- endMkDependHs --- Complete the makefile, close the tmp file etc +-- endMkDependHs +-- Complete the makefile, close the tmp file etc -- ----------------------------------------------------------------- endMkDependHS :: DynFlags -> MkDepFiles -> IO () -endMkDependHS dflags +endMkDependHS dflags (MkDep { mkd_make_file = makefile, mkd_make_hdl = makefile_hdl, - mkd_tmp_file = tmp_file, mkd_tmp_hdl = tmp_hdl }) + mkd_tmp_file = tmp_file, mkd_tmp_hdl = tmp_hdl }) = do -- write the magic marker into the tmp file hPutStrLn tmp_hdl depEndMarker @@ -301,35 +300,35 @@ endMkDependHS dflags Nothing -> return () Just hdl -> do - -- slurp the rest of the original makefile and copy it into the output - let slurp = do - l <- hGetLine hdl - hPutStrLn tmp_hdl l - slurp - - catchJust ioErrors slurp - (\e -> if isEOFError e then return () else ioError e) + -- slurp the rest of the original makefile and copy it into the output + let slurp = do + l <- hGetLine hdl + hPutStrLn tmp_hdl l + slurp - hClose hdl + catchJust ioErrors slurp + (\e -> if isEOFError e then return () else ioError e) + + hClose hdl hClose tmp_hdl -- make sure it's flushed - -- Create a backup of the original makefile + -- Create a backup of the original makefile when (isJust makefile_hdl) - (SysTools.copy dflags ("Backing up " ++ makefile) - makefile (makefile++".bak")) + (SysTools.copy dflags ("Backing up " ++ makefile) + makefile (makefile++".bak")) - -- Copy the new makefile in place + -- Copy the new makefile in place SysTools.copy dflags "Installing new makefile" tmp_file makefile ----------------------------------------------------------------- --- Module cycles +-- Module cycles ----------------------------------------------------------------- dumpModCycles :: DynFlags -> [ModSummary] -> IO () dumpModCycles dflags mod_summaries - | not (dopt Opt_D_dump_mod_cycles dflags) + | not (dopt Opt_D_dump_mod_cycles dflags) = return () | null cycles @@ -342,76 +341,76 @@ dumpModCycles dflags mod_summaries cycles :: [[ModSummary]] cycles = [ c | CyclicSCC c <- GHC.topSortModuleGraph True mod_summaries Nothing ] - pp_cycles = vcat [ (ptext (sLit "---------- Cycle") <+> int n <+> ptext (sLit "----------")) - $$ pprCycle c $$ text "" - | (n,c) <- [1..] `zip` cycles ] + pp_cycles = vcat [ (ptext (sLit "---------- Cycle") <+> int n <+> ptext (sLit "----------")) + $$ pprCycle c $$ text "" + | (n,c) <- [1..] `zip` cycles ] pprCycle :: [ModSummary] -> SDoc -- Print a cycle, but show only the imports within the cycle pprCycle summaries = pp_group (CyclicSCC summaries) where - cycle_mods :: [ModuleName] -- The modules in this cycle + cycle_mods :: [ModuleName] -- The modules in this cycle cycle_mods = map (moduleName . ms_mod) summaries pp_group (AcyclicSCC ms) = pp_ms ms - pp_group (CyclicSCC mss) - = ASSERT( not (null boot_only) ) - -- The boot-only list must be non-empty, else there would - -- be an infinite chain of non-boot imoprts, and we've - -- already checked for that in processModDeps - 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)) - in_group (L _ m) = m `elem` group_mods - group_mods = map (moduleName . ms_mod) mss - - loop_breaker = head boot_only - all_others = tail boot_only ++ others - groups = GHC.topSortModuleGraph True all_others Nothing + pp_group (CyclicSCC mss) + = ASSERT( not (null boot_only) ) + -- The boot-only list must be non-empty, else there would + -- be an infinite chain of non-boot imoprts, and we've + -- already checked for that in processModDeps + 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)) + in_group (L _ m) = m `elem` group_mods + group_mods = map (moduleName . ms_mod) mss + + loop_breaker = head boot_only + all_others = tail boot_only ++ others + 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)) - where - mod_str = moduleNameString (moduleName (ms_mod summary)) + <+> (pp_imps empty (ms_imps summary) $$ + pp_imps (ptext (sLit "{-# SOURCE #-}")) (ms_srcimps summary)) + where + mod_str = moduleNameString (moduleName (ms_mod summary)) pp_imps :: SDoc -> [Located ModuleName] -> SDoc pp_imps what [] = empty - pp_imps what lms - = case [m | L _ m <- lms, m `elem` cycle_mods] of - [] -> empty - ms -> what <+> ptext (sLit "imports") <+> - pprWithCommas ppr ms + pp_imps what lms + = case [m | L _ m <- lms, m `elem` cycle_mods] of + [] -> empty + ms -> what <+> ptext (sLit "imports") <+> + pprWithCommas ppr ms ----------------------------------------------------------------- -- --- Flags +-- Flags -- ----------------------------------------------------------------- - -- Flags -GLOBAL_VAR(v_Dep_makefile, "Makefile", String); -GLOBAL_VAR(v_Dep_include_pkg_deps, False, Bool); + -- 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); +GLOBAL_VAR(v_Dep_suffixes, [], [String]); +GLOBAL_VAR(v_Dep_warnings, True, Bool); 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) ) +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-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) ) + , ( "-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) ) ] -- 1.7.10.4