compiler/main/DriverMkDepend.hs

   1 -----------------------------------------------------------------------------
   2 --
   3 -- Makefile Dependency Generation
   4 --
   5 -- (c) The University of Glasgow 2005
   6 --
   7 -----------------------------------------------------------------------------
   8
   9 module DriverMkDepend (
  10         doMkDependHS
  11   ) where
  12
  13 #include "HsVersions.h"
  14
  15 import qualified GHC
  16 import GHC              ( Session, ModSummary(..) )
  17 import DynFlags         ( DynFlags( verbosity, opt_dep ), getOpts )
  18 import Util             ( escapeSpaces, splitFilename, joinFileExt )
  19 import HscTypes         ( HscEnv, IsBootInterface, msObjFilePath, msHsFilePath )
  20 import Packages         ( PackageIdH(..) )
  21 import SysTools         ( newTempName )
  22 import qualified SysTools
  23 import Module           ( Module, ModLocation(..), mkModule,
  24                           addBootSuffix_maybe )
  25 import Digraph          ( SCC(..) )
  26 import Finder           ( findModule, FindResult(..) )
  27 import Util             ( global, consIORef )
  28 import Outputable
  29 import Panic
  30 import SrcLoc           ( unLoc )
  31 import CmdLineParser
  32
  33 #if __GLASGOW_HASKELL__ <= 408
  34 import Panic            ( catchJust, ioErrors )
  35 #endif
  36 import ErrUtils         ( debugTraceMsg, printErrorsAndWarnings )
  37
  38 import DATA_IOREF       ( IORef, readIORef, writeIORef )
  39 import EXCEPTION
  40
  41 import System           ( ExitCode(..), exitWith )
  42 import Directory
  43 import IO
  44 import Monad            ( when )
  45 import 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                 -- Tidy up
  80         ; endMkDependHS dflags files }}
  81
  82 -----------------------------------------------------------------
  83 --
  84 --              beginMkDependHs
  85 --      Create a temporary file,
  86 --      find the Makefile,
  87 --      slurp through it, etc
  88 --
  89 -----------------------------------------------------------------
  90
  91 data MkDepFiles
  92   = MkDep { mkd_make_file :: FilePath,          -- Name of the makefile
  93             mkd_make_hdl  :: Maybe Handle,      -- Handle for the open makefile
  94             mkd_tmp_file  :: FilePath,          -- Name of the temporary file
  95             mkd_tmp_hdl   :: Handle }           -- Handle of the open temporary file
  96
  97 beginMkDependHS :: DynFlags -> IO MkDepFiles
  98
  99 beginMkDependHS dflags = do
 100         -- slurp in the mkdependHS-style options
 101   let flags = getOpts dflags opt_dep
 102   _ <- processArgs dep_opts flags
 103
 104         -- open a new temp file in which to stuff the dependency info
 105         -- as we go along.
 106   tmp_file <- newTempName dflags "dep"
 107   tmp_hdl <- openFile tmp_file WriteMode
 108
 109         -- open the makefile
 110   makefile <- readIORef v_Dep_makefile
 111   exists <- doesFileExist makefile
 112   mb_make_hdl <-
 113         if not exists
 114         then return Nothing
 115         else do
 116            makefile_hdl <- openFile makefile ReadMode
 117
 118                 -- slurp through until we get the magic start string,
 119                 -- copying the contents into dep_makefile
 120            let slurp = do
 121                 l <- hGetLine makefile_hdl
 122                 if (l == depStartMarker)
 123                         then return ()
 124                         else do hPutStrLn tmp_hdl l; slurp
 125
 126                 -- slurp through until we get the magic end marker,
 127                 -- throwing away the contents
 128            let chuck = do
 129                 l <- hGetLine makefile_hdl
 130                 if (l == depEndMarker)
 131                         then return ()
 132                         else chuck
 133
 134            catchJust ioErrors slurp
 135                 (\e -> if isEOFError e then return () else ioError e)
 136            catchJust ioErrors chuck
 137                 (\e -> if isEOFError e then return () else ioError e)
 138
 139            return (Just makefile_hdl)
 140
 141
 142         -- write the magic marker into the tmp file
 143   hPutStrLn tmp_hdl depStartMarker
 144
 145   return (MkDep { mkd_make_file = makefile, mkd_make_hdl = mb_make_hdl,
 146                   mkd_tmp_file  = tmp_file, mkd_tmp_hdl  = tmp_hdl})
 147
 148
 149 -----------------------------------------------------------------
 150 --
 151 --              processDeps
 152 --
 153 -----------------------------------------------------------------
 154
 155 processDeps :: Session
 156             -> [Module]
 157             -> Handle           -- Write dependencies to here
 158             -> SCC ModSummary
 159             -> IO ()
 160 -- Write suitable dependencies to handle
 161 -- Always:
 162 --                      this.o : this.hs
 163 --
 164 -- If the dependency is on something other than a .hi file:
 165 --                      this.o this.p_o ... : dep
 166 -- otherwise
 167 --                      this.o ...   : dep.hi
 168 --                      this.p_o ... : dep.p_hi
 169 --                      ...
 170 -- (where .o is $osuf, and the other suffixes come from
 171 -- the cmdline -s options).
 172 --
 173 -- For {-# SOURCE #-} imports the "hi" will be "hi-boot".
 174
 175 processDeps session excl_mods hdl (CyclicSCC nodes)
 176   =     -- There shouldn't be any cycles; report them
 177     throwDyn (ProgramError (showSDoc $ GHC.cyclicModuleErr nodes))
 178
 179 processDeps session excl_mods hdl (AcyclicSCC node)
 180   = do  { extra_suffixes   <- readIORef v_Dep_suffixes
 181         ; hsc_env <- GHC.sessionHscEnv session
 182         ; include_pkg_deps <- readIORef v_Dep_include_pkg_deps
 183         ; let src_file  = msHsFilePath node
 184               obj_file  = msObjFilePath node
 185               obj_files = insertSuffixes obj_file extra_suffixes
 186
 187               do_imp is_boot imp_mod
 188                 = do { mb_hi <- findDependency hsc_env src_file imp_mod
 189                                                is_boot include_pkg_deps
 190                      ; case mb_hi of {
 191                            Nothing      -> return () ;
 192                            Just hi_file -> do
 193                      { let hi_files = insertSuffixes hi_file extra_suffixes
 194                            write_dep (obj,hi) = writeDependency hdl [obj] hi
 195
 196                         -- Add one dependency for each suffix;
 197                         -- e.g.         A.o   : B.hi
 198                         --              A.x_o : B.x_hi
 199                      ; mapM_ write_dep (obj_files `zip` hi_files) }}}
 200
 201
 202                 -- Emit std dependency of the object(s) on the source file
 203                 -- Something like       A.o : A.hs
 204         ; writeDependency hdl obj_files src_file
 205
 206                 -- Emit a dependency for each import
 207
 208         -- SOURCE imports
 209         ; mapM_ (do_imp True)
 210                 (filter (`notElem` excl_mods) (map unLoc (ms_srcimps node)))
 211
 212         -- regular imports
 213         ; mapM_ (do_imp False)
 214                 (filter (`notElem` excl_mods) (map unLoc (ms_imps node)))
 215         }
 216
 217
 218 findDependency  :: HscEnv
 219                 -> FilePath             -- Importing module: used only for error msg
 220                 -> Module               -- Imported module
 221                 -> IsBootInterface      -- Source import
 222                 -> Bool                 -- Record dependency on package modules
 223                 -> IO (Maybe FilePath)  -- Interface file file
 224 findDependency hsc_env src imp is_boot include_pkg_deps
 225   = do  {       -- Find the module; this will be fast because
 226                 -- we've done it once during downsweep
 227           r <- findModule hsc_env imp True {-explicit-}
 228         ; case r of
 229             Found loc pkg
 230                 -- Not in this package: we don't need a dependency
 231                 | ExtPackage _ <- pkg, not include_pkg_deps
 232                 -> return Nothing
 233
 234                 -- Home package: just depend on the .hi or hi-boot file
 235                 | otherwise
 236                 -> return (Just (addBootSuffix_maybe is_boot (ml_hi_file loc)))
 237
 238             _ -> panic "findDependency"
 239         }
 240
 241 -----------------------------
 242 writeDependency :: Handle -> [FilePath] -> FilePath -> IO ()
 243 -- (writeDependency h [t1,t2] dep) writes to handle h the dependency
 244 --      t1 t2 : dep
 245 writeDependency hdl targets dep
 246   = hPutStrLn hdl (unwords (map escapeSpaces targets) ++ " : "
 247                    ++ escapeSpaces dep)
 248
 249 -----------------------------
 250 insertSuffixes
 251         :: FilePath     -- Original filename;   e.g. "foo.o"
 252         -> [String]     -- Extra suffices       e.g. ["x","y"]
 253         -> [FilePath]   -- Zapped filenames     e.g. ["foo.o", "foo.x_o", "foo.y_o"]
 254         -- Note that that the extra bit gets inserted *before* the old suffix
 255         -- We assume the old suffix contains no dots, so we can strip it with removeSuffix
 256
 257         -- NOTE: we used to have this comment
 258                 -- In order to construct hi files with alternate suffixes, we
 259                 -- now have to find the "basename" of the hi file.  This is
 260                 -- difficult because we can't just split the hi filename
 261                 -- at the last dot - the hisuf might have dots in it.  So we
 262                 -- check whether the hi filename ends in hisuf, and if it does,
 263                 -- we strip off hisuf, otherwise we strip everything after the
 264                 -- last dot.
 265         -- But I'm not sure we care about hisufs with dots in them.
 266         -- Lots of other things will break first!
 267
 268 insertSuffixes file_name extras
 269   = file_name : [ basename `joinFileExt` (extra ++ "_" ++ suffix) | extra <- extras ]
 270   where
 271     (basename, suffix) = splitFilename file_name
 272
 273
 274 -----------------------------------------------------------------
 275 --
 276 --              endMkDependHs
 277 --      Complete the makefile, close the tmp file etc
 278 --
 279 -----------------------------------------------------------------
 280
 281 endMkDependHS :: DynFlags -> MkDepFiles -> IO ()
 282
 283 endMkDependHS dflags
 284    (MkDep { mkd_make_file = makefile, mkd_make_hdl =  makefile_hdl,
 285             mkd_tmp_file  = tmp_file, mkd_tmp_hdl  =  tmp_hdl })
 286   = do
 287   -- write the magic marker into the tmp file
 288   hPutStrLn tmp_hdl depEndMarker
 289
 290   case makefile_hdl of
 291      Nothing  -> return ()
 292      Just hdl -> do
 293
 294           -- slurp the rest of the original makefile and copy it into the output
 295         let slurp = do
 296                 l <- hGetLine hdl
 297                 hPutStrLn tmp_hdl l
 298                 slurp
 299
 300         catchJust ioErrors slurp
 301                 (\e -> if isEOFError e then return () else ioError e)
 302
 303         hClose hdl
 304
 305   hClose tmp_hdl  -- make sure it's flushed
 306
 307         -- Create a backup of the original makefile
 308   when (isJust makefile_hdl)
 309        (SysTools.copy dflags ("Backing up " ++ makefile)
 310           makefile (makefile++".bak"))
 311
 312         -- Copy the new makefile in place
 313   SysTools.copy dflags "Installing new makefile" tmp_file makefile
 314
 315
 316 -----------------------------------------------------------------
 317 --
 318 --              Flags
 319 --
 320 -----------------------------------------------------------------
 321
 322         -- Flags
 323 GLOBAL_VAR(v_Dep_makefile,              "Makefile", String);
 324 GLOBAL_VAR(v_Dep_include_pkg_deps,      False, Bool);
 325 GLOBAL_VAR(v_Dep_exclude_mods,          [], [Module]);
 326 GLOBAL_VAR(v_Dep_suffixes,              [], [String]);
 327 GLOBAL_VAR(v_Dep_warnings,              True, Bool);
 328
 329 depStartMarker = "# DO NOT DELETE: Beginning of Haskell dependencies"
 330 depEndMarker   = "# DO NOT DELETE: End of Haskell dependencies"
 331
 332 -- for compatibility with the old mkDependHS, we accept options of the form
 333 -- -optdep-f -optdep.depend, etc.
 334 dep_opts =
 335    [ (  "s",                    SepArg (consIORef v_Dep_suffixes) )
 336    , (  "f",                    SepArg (writeIORef v_Dep_makefile) )
 337    , (  "w",                    NoArg (writeIORef v_Dep_warnings False) )
 338    , (  "-include-prelude",     NoArg (writeIORef v_Dep_include_pkg_deps True) )
 339    , (  "-include-pkg-deps",    NoArg (writeIORef v_Dep_include_pkg_deps True) )
 340    , (  "-exclude-module=",     Prefix (consIORef v_Dep_exclude_mods . mkModule) )
 341    , (  "x",                    Prefix (consIORef v_Dep_exclude_mods . mkModule) )
 342    ]