ghc/compiler/main/DriverMkDepend.hs

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