compiler/main/DriverMkDepend.hs

   1 {-# OPTIONS -fno-cse #-}
   2 -- -fno-cse is needed for GLOBAL_VAR's to behave properly
   3
   4 -----------------------------------------------------------------------------
   5 --
   6 -- Makefile Dependency Generation
   7 --
   8 -- (c) The University of Glasgow 2005
   9 --
  10 -----------------------------------------------------------------------------
  11
  12 module DriverMkDepend (
  13         doMkDependHS
  14   ) where
  15
  16 #include "HsVersions.h"
  17
  18 import qualified GHC
  19 import GHC              ( Session, ModSummary(..) )
  20 import DynFlags
  21 import Util
  22 import HscTypes         ( HscEnv, IsBootInterface, msObjFilePath, msHsFilePath )
  23 import SysTools         ( newTempName )
  24 import qualified SysTools
  25 import Module
  26 import Digraph          ( SCC(..) )
  27 import Finder           ( findImportedModule, FindResult(..) )
  28 import Outputable
  29 import Panic
  30 import SrcLoc
  31 import Data.List
  32 import CmdLineParser
  33 import FastString
  34
  35 import ErrUtils         ( debugTraceMsg, putMsg )
  36
  37 import Data.IORef       ( IORef, readIORef, writeIORef )
  38 import Control.Exception
  39 import System.Exit      ( ExitCode(..), exitWith )
  40 import System.Directory
  41 import System.FilePath
  42 import System.IO
  43 import System.IO.Error  ( isEOFError )
  44 import Control.Monad    ( when )
  45 import Data.Maybe       ( isJust )
  46
  47 -----------------------------------------------------------------
  48 --
  49 --              The main function
  50 --
  51 -----------------------------------------------------------------
  52
  53 doMkDependHS :: Session -> [FilePath] -> IO ()
  54 doMkDependHS session srcs
  55   = do  {       -- Initialisation
  56           dflags <- GHC.getSessionDynFlags session
  57         ; files <- beginMkDependHS dflags
  58
  59                 -- Do the downsweep to find all the modules
  60         ; targets <- mapM (\s -> GHC.guessTarget s Nothing) srcs
  61         ; GHC.setTargets session targets
  62         ; excl_mods <- readIORef v_Dep_exclude_mods
  63         ; r <- GHC.depanal session excl_mods True {- Allow dup roots -}
  64         ; case r of
  65             Nothing -> exitWith (ExitFailure 1)
  66             Just mod_summaries -> do {
  67
  68                 -- Sort into dependency order
  69                 -- There should be no cycles
  70           let sorted = GHC.topSortModuleGraph False mod_summaries Nothing
  71
  72                 -- Print out the dependencies if wanted
  73         ; debugTraceMsg dflags 2 (text "Module dependencies" $$ ppr sorted)
  74
  75                 -- Prcess them one by one, dumping results into makefile
  76                 -- and complaining about cycles
  77         ; mapM (processDeps session excl_mods (mkd_tmp_hdl files)) sorted
  78
  79                 -- If -ddump-mod-cycles, show cycles in the module graph
  80         ; dumpModCycles dflags mod_summaries
  81
  82                 -- Tidy up
  83         ; endMkDependHS dflags files }}
  84
  85 -----------------------------------------------------------------
  86 --
  87 --              beginMkDependHs
  88 --      Create a temporary file,
  89 --      find the Makefile,
  90 --      slurp through it, etc
  91 --
  92 -----------------------------------------------------------------
  93
  94 data MkDepFiles
  95   = MkDep { mkd_make_file :: FilePath,          -- Name of the makefile
  96             mkd_make_hdl  :: Maybe Handle,      -- Handle for the open makefile
  97             mkd_tmp_file  :: FilePath,          -- Name of the temporary file
  98             mkd_tmp_hdl   :: Handle }           -- Handle of the open temporary file
  99
 100 beginMkDependHS :: DynFlags -> IO MkDepFiles
 101 beginMkDependHS dflags = do
 102         -- slurp in the mkdependHS-style options
 103   let flags = getOpts dflags opt_dep
 104   _ <- processArgs dep_opts flags
 105
 106         -- open a new temp file in which to stuff the dependency info
 107         -- as we go along.
 108   tmp_file <- newTempName dflags "dep"
 109   tmp_hdl <- openFile tmp_file WriteMode
 110
 111         -- open the makefile
 112   makefile <- readIORef v_Dep_makefile
 113   exists <- doesFileExist makefile
 114   mb_make_hdl <-
 115         if not exists
 116         then return Nothing
 117         else do
 118            makefile_hdl <- openFile makefile ReadMode
 119
 120                 -- slurp through until we get the magic start string,
 121                 -- copying the contents into dep_makefile
 122            let slurp = do
 123                 l <- hGetLine makefile_hdl
 124                 if (l == depStartMarker)
 125                         then return ()
 126                         else do hPutStrLn tmp_hdl l; slurp
 127
 128                 -- slurp through until we get the magic end marker,
 129                 -- throwing away the contents
 130            let chuck = do
 131                 l <- hGetLine makefile_hdl
 132                 if (l == depEndMarker)
 133                         then return ()
 134                         else chuck
 135
 136            catchJust ioErrors slurp
 137                 (\e -> if isEOFError e then return () else ioError e)
 138            catchJust ioErrors chuck
 139                 (\e -> if isEOFError e then return () else ioError e)
 140
 141            return (Just makefile_hdl)
 142
 143
 144         -- write the magic marker into the tmp file
 145   hPutStrLn tmp_hdl depStartMarker
 146
 147   return (MkDep { mkd_make_file = makefile, mkd_make_hdl = mb_make_hdl,
 148                   mkd_tmp_file  = tmp_file, mkd_tmp_hdl  = tmp_hdl})
 149
 150
 151 -----------------------------------------------------------------
 152 --
 153 --              processDeps
 154 --
 155 -----------------------------------------------------------------
 156
 157 processDeps :: Session
 158             -> [ModuleName]
 159             -> Handle           -- Write dependencies to here
 160             -> SCC ModSummary
 161             -> IO ()
 162 -- Write suitable dependencies to handle
 163 -- Always:
 164 --                      this.o : this.hs
 165 --
 166 -- If the dependency is on something other than a .hi file:
 167 --                      this.o this.p_o ... : dep
 168 -- otherwise
 169 --                      this.o ...   : dep.hi
 170 --                      this.p_o ... : dep.p_hi
 171 --                      ...
 172 -- (where .o is $osuf, and the other suffixes come from
 173 -- the cmdline -s options).
 174 --
 175 -- For {-# SOURCE #-} imports the "hi" will be "hi-boot".
 176
 177 processDeps _ _ _ (CyclicSCC nodes)
 178   =     -- There shouldn't be any cycles; report them
 179     throwDyn (ProgramError (showSDoc $ GHC.cyclicModuleErr nodes))
 180
 181 processDeps session excl_mods hdl (AcyclicSCC node)
 182   = do  { extra_suffixes   <- readIORef v_Dep_suffixes
 183         ; hsc_env <- GHC.sessionHscEnv session
 184         ; include_pkg_deps <- readIORef v_Dep_include_pkg_deps
 185         ; let src_file  = msHsFilePath node
 186               obj_file  = msObjFilePath node
 187               obj_files = insertSuffixes obj_file extra_suffixes
 188
 189               do_imp is_boot imp_mod
 190                 = do { mb_hi <- findDependency hsc_env src_file imp_mod
 191                                                is_boot include_pkg_deps
 192                      ; case mb_hi of {
 193                            Nothing      -> return () ;
 194                            Just hi_file -> do
 195                      { let hi_files = insertSuffixes hi_file extra_suffixes
 196                            write_dep (obj,hi) = writeDependency hdl [obj] hi
 197
 198                         -- Add one dependency for each suffix;
 199                         -- e.g.         A.o   : B.hi
 200                         --              A.x_o : B.x_hi
 201                      ; mapM_ write_dep (obj_files `zip` hi_files) }}}
 202
 203
 204                 -- Emit std dependency of the object(s) on the source file
 205                 -- Something like       A.o : A.hs
 206         ; writeDependency hdl obj_files src_file
 207
 208                 -- Emit a dependency for each import
 209
 210         -- SOURCE imports
 211         ; mapM_ (do_imp True)
 212                 (filter (`notElem` excl_mods) (map unLoc (ms_srcimps node)))
 213
 214         -- regular imports
 215         ; mapM_ (do_imp False)
 216                 (filter (`notElem` excl_mods) (map unLoc (ms_imps node)))
 217         }
 218
 219
 220 findDependency  :: HscEnv
 221                 -> FilePath             -- Importing module: used only for error msg
 222                 -> ModuleName           -- Imported module
 223                 -> IsBootInterface      -- Source import
 224                 -> Bool                 -- Record dependency on package modules
 225                 -> IO (Maybe FilePath)  -- Interface file file
 226 findDependency hsc_env _ imp is_boot _include_pkg_deps
 227   = do  {       -- Find the module; this will be fast because
 228                 -- we've done it once during downsweep
 229           r <- findImportedModule hsc_env imp Nothing
 230         ; case r of
 231             Found loc _
 232                 -- Home package: just depend on the .hi or hi-boot file
 233                 | isJust (ml_hs_file loc)
 234                 -> return (Just (addBootSuffix_maybe is_boot (ml_hi_file loc)))
 235
 236                 -- Not in this package: we don't need a dependency
 237                 | otherwise
 238                 -> return Nothing
 239
 240             _ -> panic "findDependency"
 241         }
 242
 243 -----------------------------
 244 writeDependency :: Handle -> [FilePath] -> FilePath -> IO ()
 245 -- (writeDependency h [t1,t2] dep) writes to handle h the dependency
 246 --      t1 t2 : dep
 247 writeDependency hdl targets dep
 248   = hPutStrLn hdl (unwords (map forOutput targets) ++ " : " ++ forOutput dep)
 249     where forOutput = escapeSpaces . reslash Forwards . normalise
 250
 251 -----------------------------
 252 insertSuffixes
 253         :: FilePath     -- Original filename;   e.g. "foo.o"
 254         -> [String]     -- Extra suffices       e.g. ["x","y"]
 255         -> [FilePath]   -- Zapped filenames     e.g. ["foo.o", "foo.x_o", "foo.y_o"]
 256         -- Note that that the extra bit gets inserted *before* the old suffix
 257         -- We assume the old suffix contains no dots, so we can strip it with removeSuffix
 258
 259         -- NOTE: we used to have this comment
 260                 -- In order to construct hi files with alternate suffixes, we
 261                 -- now have to find the "basename" of the hi file.  This is
 262                 -- difficult because we can't just split the hi filename
 263                 -- at the last dot - the hisuf might have dots in it.  So we
 264                 -- check whether the hi filename ends in hisuf, and if it does,
 265                 -- we strip off hisuf, otherwise we strip everything after the
 266                 -- last dot.
 267         -- But I'm not sure we care about hisufs with dots in them.
 268         -- Lots of other things will break first!
 269
 270 insertSuffixes file_name extras
 271   = file_name : [ basename <.> (extra ++ "_" ++ suffix) | extra <- extras ]
 272   where
 273     (basename, suffix) = case splitExtension file_name of
 274                          -- Drop the "." from the extension
 275                          (b, s) -> (b, drop 1 s)
 276
 277
 278 -----------------------------------------------------------------
 279 --
 280 --              endMkDependHs
 281 --      Complete the makefile, close the tmp file etc
 282 --
 283 -----------------------------------------------------------------
 284
 285 endMkDependHS :: DynFlags -> MkDepFiles -> IO ()
 286
 287 endMkDependHS dflags
 288    (MkDep { mkd_make_file = makefile, mkd_make_hdl =  makefile_hdl,
 289             mkd_tmp_file  = tmp_file, mkd_tmp_hdl  =  tmp_hdl })
 290   = do
 291   -- write the magic marker into the tmp file
 292   hPutStrLn tmp_hdl depEndMarker
 293
 294   case makefile_hdl of
 295      Nothing  -> return ()
 296      Just hdl -> do
 297
 298           -- slurp the rest of the original makefile and copy it into the output
 299         let slurp = do
 300                 l <- hGetLine hdl
 301                 hPutStrLn tmp_hdl l
 302                 slurp
 303
 304         catchJust ioErrors slurp
 305                 (\e -> if isEOFError e then return () else ioError e)
 306
 307         hClose hdl
 308
 309   hClose tmp_hdl  -- make sure it's flushed
 310
 311         -- Create a backup of the original makefile
 312   when (isJust makefile_hdl)
 313        (SysTools.copy dflags ("Backing up " ++ makefile)
 314           makefile (makefile++".bak"))
 315
 316         -- Copy the new makefile in place
 317   SysTools.copy dflags "Installing new makefile" tmp_file makefile
 318
 319
 320 -----------------------------------------------------------------
 321 --              Module cycles
 322 -----------------------------------------------------------------
 323
 324 dumpModCycles :: DynFlags -> [ModSummary] -> IO ()
 325 dumpModCycles dflags mod_summaries
 326   | not (dopt Opt_D_dump_mod_cycles dflags)
 327   = return ()
 328
 329   | null cycles
 330   = putMsg dflags (ptext (sLit "No module cycles"))
 331
 332   | otherwise
 333   = putMsg dflags (hang (ptext (sLit "Module cycles found:")) 2 pp_cycles)
 334   where
 335
 336     cycles :: [[ModSummary]]
 337     cycles = [ c | CyclicSCC c <- GHC.topSortModuleGraph True mod_summaries Nothing ]
 338
 339     pp_cycles = vcat [ (ptext (sLit "---------- Cycle") <+> int n <+> ptext (sLit "----------"))
 340                         $$ pprCycle c $$ text ""
 341                      | (n,c) <- [1..] `zip` cycles ]
 342
 343 pprCycle :: [ModSummary] -> SDoc
 344 -- Print a cycle, but show only the imports within the cycle
 345 pprCycle summaries = pp_group (CyclicSCC summaries)
 346   where
 347     cycle_mods :: [ModuleName]  -- The modules in this cycle
 348     cycle_mods = map (moduleName . ms_mod) summaries
 349
 350     pp_group (AcyclicSCC ms) = pp_ms ms
 351     pp_group (CyclicSCC mss)
 352         = ASSERT( not (null boot_only) )
 353                 -- The boot-only list must be non-empty, else there would
 354                 -- be an infinite chain of non-boot imoprts, and we've
 355                 -- already checked for that in processModDeps
 356           pp_ms loop_breaker $$ vcat (map pp_group groups)
 357         where
 358           (boot_only, others) = partition is_boot_only mss
 359           is_boot_only ms = not (any in_group (ms_imps ms))
 360           in_group (L _ m) = m `elem` group_mods
 361           group_mods = map (moduleName . ms_mod) mss
 362
 363           loop_breaker = head boot_only
 364           all_others   = tail boot_only ++ others
 365           groups = GHC.topSortModuleGraph True all_others Nothing
 366
 367     pp_ms summary = text mod_str <> text (take (20 - length mod_str) (repeat ' '))
 368                        <+> (pp_imps empty (ms_imps summary) $$
 369                             pp_imps (ptext (sLit "{-# SOURCE #-}")) (ms_srcimps summary))
 370         where
 371           mod_str = moduleNameString (moduleName (ms_mod summary))
 372
 373     pp_imps :: SDoc -> [Located ModuleName] -> SDoc
 374     pp_imps _    [] = empty
 375     pp_imps what lms
 376         = case [m | L _ m <- lms, m `elem` cycle_mods] of
 377             [] -> empty
 378             ms -> what <+> ptext (sLit "imports") <+>
 379                                 pprWithCommas ppr ms
 380
 381 -----------------------------------------------------------------
 382 --
 383 --              Flags
 384 --
 385 -----------------------------------------------------------------
 386
 387         -- Flags
 388 GLOBAL_VAR(v_Dep_makefile,              "Makefile", String);
 389 GLOBAL_VAR(v_Dep_include_pkg_deps,      False, Bool);
 390 GLOBAL_VAR(v_Dep_exclude_mods,          [], [ModuleName]);
 391 GLOBAL_VAR(v_Dep_suffixes,              [], [String]);
 392 GLOBAL_VAR(v_Dep_warnings,              True, Bool);
 393
 394 depStartMarker, depEndMarker :: String
 395 depStartMarker = "# DO NOT DELETE: Beginning of Haskell dependencies"
 396 depEndMarker   = "# DO NOT DELETE: End of Haskell dependencies"
 397
 398 -- for compatibility with the old mkDependHS, we accept options of the form
 399 -- -optdep-f -optdep.depend, etc.
 400 dep_opts :: [Flag IO]
 401 dep_opts =
 402    [ Flag "s"                 (SepArg (consIORef v_Dep_suffixes))
 403           Supported
 404    , Flag "f"                 (SepArg (writeIORef v_Dep_makefile))
 405           Supported
 406    , Flag "w"                 (NoArg (writeIORef v_Dep_warnings False))
 407           Supported
 408
 409    , Flag "-include-prelude"  (NoArg (writeIORef v_Dep_include_pkg_deps True))
 410           (Deprecated "Use --include-pkg-deps instead")
 411
 412    , Flag "-include-pkg-deps" (NoArg (writeIORef v_Dep_include_pkg_deps True))
 413           Supported
 414    , Flag "-exclude-module="  (Prefix (consIORef v_Dep_exclude_mods . mkModuleName))
 415           Supported
 416    , Flag "x"                 (Prefix (consIORef v_Dep_exclude_mods . mkModuleName))
 417           Supported
 418    ]
 419