ghc/compiler/main/DriverMkDepend.hs

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