ghc/compiler/main/DriverMkDepend.hs

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