ghc/compiler/main/DriverMkDepend.hs

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