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