ghc/compiler/main/DriverMkDepend.hs

   1 -----------------------------------------------------------------------------
   2 -- $Id: DriverMkDepend.hs,v 1.15 2001/08/03 07:44:47 sof Exp $
   3 --
   4 -- GHC Driver
   5 --
   6 -- (c) Simon Marlow 2000
   7 --
   8 -----------------------------------------------------------------------------
   9
  10 module DriverMkDepend where
  11
  12 #include "HsVersions.h"
  13
  14 import DriverState
  15 import DriverUtil
  16 import DriverFlags
  17 import SysTools         ( newTempName )
  18 import qualified SysTools
  19 import Module
  20 import Config
  21 import Module           ( isHomeModule )
  22 import Finder           ( findModuleDep )
  23 import HscTypes         ( ModuleLocation(..) )
  24 import Util
  25 import Panic
  26
  27 import IOExts
  28 import Exception
  29
  30 import Directory
  31 import IO
  32 import Monad
  33 import Maybe
  34
  35 -------------------------------------------------------------------------------
  36 -- mkdependHS
  37
  38         -- flags
  39 GLOBAL_VAR(v_Dep_makefile,              "Makefile", String);
  40 GLOBAL_VAR(v_Dep_include_prelude,       False, Bool);
  41 GLOBAL_VAR(v_Dep_exclude_mods,          [], [String]);
  42 GLOBAL_VAR(v_Dep_suffixes,              [], [String]);
  43 GLOBAL_VAR(v_Dep_warnings,              True, Bool);
  44
  45         -- global vars
  46 GLOBAL_VAR(v_Dep_makefile_hdl,  error "dep_makefile_hdl", Maybe Handle);
  47 GLOBAL_VAR(v_Dep_tmp_file,      error "dep_tmp_file", String);
  48 GLOBAL_VAR(v_Dep_tmp_hdl,       error "dep_tmp_hdl", Handle);
  49 GLOBAL_VAR(v_Dep_dir_contents,  error "dep_dir_contents", [(String,[String])]);
  50
  51 depStartMarker = "# DO NOT DELETE: Beginning of Haskell dependencies"
  52 depEndMarker   = "# DO NOT DELETE: End of Haskell dependencies"
  53
  54 -- for compatibility with the old mkDependHS, we accept options of the form
  55 -- -optdep-f -optdep.depend, etc.
  56 dep_opts = [
  57    (  "s",                      SepArg (add v_Dep_suffixes) ),
  58    (  "f",                      SepArg (writeIORef v_Dep_makefile) ),
  59    (  "w",                      NoArg (writeIORef v_Dep_warnings False) ),
  60    (  "-include-prelude",       NoArg (writeIORef v_Dep_include_prelude True) )
  61 --   (  "-exclude-module=",       Prefix (add v_Dep_exclude_mods) )
  62 --   (  "x",                      Prefix (add v_Dep_exclude_mods) )
  63  ]
  64
  65 beginMkDependHS :: IO ()
  66 beginMkDependHS = do
  67
  68         -- slurp in the mkdependHS-style options
  69   flags <- getStaticOpts v_Opt_dep
  70   _ <- processArgs dep_opts flags []
  71
  72         -- open a new temp file in which to stuff the dependency info
  73         -- as we go along.
  74   dep_file <- newTempName "dep"
  75   writeIORef v_Dep_tmp_file dep_file
  76   tmp_hdl <- openFile dep_file WriteMode
  77   writeIORef v_Dep_tmp_hdl tmp_hdl
  78
  79         -- open the makefile
  80   makefile <- readIORef v_Dep_makefile
  81   exists <- doesFileExist makefile
  82   if not exists
  83         then do
  84            writeIORef v_Dep_makefile_hdl Nothing
  85            return ()
  86
  87         else do
  88            makefile_hdl <- openFile makefile ReadMode
  89            writeIORef v_Dep_makefile_hdl (Just makefile_hdl)
  90
  91                 -- slurp through until we get the magic start string,
  92                 -- copying the contents into dep_makefile
  93            let slurp = do
  94                 l <- hGetLine makefile_hdl
  95                 if (l == depStartMarker)
  96                         then return ()
  97                         else do hPutStrLn tmp_hdl l; slurp
  98
  99                 -- slurp through until we get the magic end marker,
 100                 -- throwing away the contents
 101            let chuck = do
 102                 l <- hGetLine makefile_hdl
 103                 if (l == depEndMarker)
 104                         then return ()
 105                         else chuck
 106
 107            catchJust ioErrors slurp
 108                 (\e -> if isEOFError e then return () else ioError e)
 109            catchJust ioErrors chuck
 110                 (\e -> if isEOFError e then return () else ioError e)
 111
 112
 113         -- write the magic marker into the tmp file
 114   hPutStrLn tmp_hdl depStartMarker
 115
 116         -- cache the contents of all the import directories, for future
 117         -- reference.
 118   import_dirs <- readIORef v_Import_paths
 119   pkg_import_dirs <- getPackageImportPath
 120   import_dir_contents <- mapM softGetDirectoryContents import_dirs
 121   pkg_import_dir_contents <- mapM softGetDirectoryContents pkg_import_dirs
 122   writeIORef v_Dep_dir_contents
 123         (zip import_dirs import_dir_contents ++
 124          zip pkg_import_dirs pkg_import_dir_contents)
 125
 126   return ()
 127
 128
 129 endMkDependHS :: IO ()
 130 endMkDependHS = do
 131   makefile     <- readIORef v_Dep_makefile
 132   makefile_hdl <- readIORef v_Dep_makefile_hdl
 133   tmp_file     <- readIORef v_Dep_tmp_file
 134   tmp_hdl      <- readIORef v_Dep_tmp_hdl
 135
 136         -- write the magic marker into the tmp file
 137   hPutStrLn tmp_hdl depEndMarker
 138
 139   case makefile_hdl of
 140      Nothing  -> return ()
 141      Just hdl -> do
 142
 143           -- slurp the rest of the original makefile and copy it into the output
 144         let slurp = do
 145                 l <- hGetLine hdl
 146                 hPutStrLn tmp_hdl l
 147                 slurp
 148
 149         catchJust ioErrors slurp
 150                 (\e -> if isEOFError e then return () else ioError e)
 151
 152         hClose hdl
 153
 154   hClose tmp_hdl  -- make sure it's flushed
 155
 156         -- Create a backup of the original makefile
 157   when (isJust makefile_hdl)
 158        (SysTools.copy ("Backing up " ++ makefile) makefile (makefile++".bak"))
 159
 160         -- Copy the new makefile in place
 161   SysTools.copy "Installing new makefile" tmp_file makefile
 162
 163
 164 findDependency :: Bool -> FilePath -> ModuleName -> IO (Maybe (String, Bool))
 165 findDependency is_source src imp = do
 166    excl_mods <- readIORef v_Dep_exclude_mods
 167    include_prelude <- readIORef v_Dep_include_prelude
 168    let imp_mod = moduleNameUserString imp
 169    if imp_mod `elem` excl_mods
 170       then return Nothing
 171       else do
 172         r <- findModuleDep imp is_source
 173         case r of
 174            Just (mod,loc)
 175                 | isHomeModule mod || include_prelude
 176                 -> return (Just (ml_hi_file loc, not is_source))
 177                 | otherwise
 178                 -> return Nothing
 179            Nothing -> throwDyn (ProgramError
 180                 (src ++ ": " ++ "can't locate import `" ++ imp_mod ++ "'"))