ghc/compiler/main/DriverMkDepend.hs

   1 -----------------------------------------------------------------------------
   2 -- $Id: DriverMkDepend.hs,v 1.11 2001/05/28 03:31:19 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 TmpFiles
  18 import Module
  19 import Config
  20 import Util
  21 import Panic
  22
  23 import IOExts
  24 import Exception
  25
  26 import Directory
  27 import IO
  28 import Monad
  29 import Maybe
  30
  31 -------------------------------------------------------------------------------
  32 -- mkdependHS
  33
  34         -- flags
  35 GLOBAL_VAR(v_Dep_makefile,              "Makefile", String);
  36 GLOBAL_VAR(v_Dep_include_prelude,       False, Bool);
  37 GLOBAL_VAR(v_Dep_ignore_dirs,           [], [String]);
  38 GLOBAL_VAR(v_Dep_exclude_mods,          [], [String]);
  39 GLOBAL_VAR(v_Dep_suffixes,              [], [String]);
  40 GLOBAL_VAR(v_Dep_warnings,              True, Bool);
  41
  42         -- global vars
  43 GLOBAL_VAR(v_Dep_makefile_hdl,  error "dep_makefile_hdl", Maybe Handle);
  44 GLOBAL_VAR(v_Dep_tmp_file,      error "dep_tmp_file", String);
  45 GLOBAL_VAR(v_Dep_tmp_hdl,       error "dep_tmp_hdl", Handle);
  46 GLOBAL_VAR(v_Dep_dir_contents,  error "dep_dir_contents", [(String,[String])]);
  47
  48 depStartMarker = "# DO NOT DELETE: Beginning of Haskell dependencies"
  49 depEndMarker   = "# DO NOT DELETE: End of Haskell dependencies"
  50
  51 -- for compatibility with the old mkDependHS, we accept options of the form
  52 -- -optdep-f -optdep.depend, etc.
  53 dep_opts = [
  54    (  "s",                      SepArg (add v_Dep_suffixes) ),
  55    (  "f",                      SepArg (writeIORef v_Dep_makefile) ),
  56    (  "w",                      NoArg (writeIORef v_Dep_warnings False) ),
  57    (  "-include-prelude",       NoArg (writeIORef v_Dep_include_prelude True) ),
  58    (  "X",                      Prefix (addToDirList v_Dep_ignore_dirs) ),
  59    (  "-exclude-directory=",    Prefix (addToDirList v_Dep_ignore_dirs) )
  60 --   (  "-exclude-module=",       Prefix (add v_Dep_exclude_mods) )
  61 --   (  "x",                      Prefix (add v_Dep_exclude_mods) )
  62
  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         -- ignore packages unless --include-prelude is on
 127   include_prelude <- readIORef v_Dep_include_prelude
 128   when (not include_prelude) $
 129     mapM_ (add v_Dep_ignore_dirs) pkg_import_dirs
 130
 131   return ()
 132
 133
 134 endMkDependHS :: IO ()
 135 endMkDependHS = do
 136   makefile     <- readIORef v_Dep_makefile
 137   makefile_hdl <- readIORef v_Dep_makefile_hdl
 138   tmp_file     <- readIORef v_Dep_tmp_file
 139   tmp_hdl      <- readIORef v_Dep_tmp_hdl
 140
 141         -- write the magic marker into the tmp file
 142   hPutStrLn tmp_hdl depEndMarker
 143
 144   case makefile_hdl of
 145      Nothing  -> return ()
 146      Just hdl -> do
 147
 148           -- slurp the rest of the orignal makefile and copy it into the output
 149         let slurp = do
 150                 l <- hGetLine hdl
 151                 hPutStrLn tmp_hdl l
 152                 slurp
 153
 154         catchJust ioErrors slurp
 155                 (\e -> if isEOFError e then return () else ioError e)
 156
 157         hClose hdl
 158
 159   hClose tmp_hdl  -- make sure it's flushed
 160
 161         -- create a backup of the original makefile
 162   when (isJust makefile_hdl) $
 163      runSomething ("Backing up " ++ makefile)
 164         (unwords [ cCP, dosifyPath makefile, dosifyPath $ makefile++".bak" ])
 165
 166         -- copy the new makefile in place
 167   runSomething "Installing new makefile"
 168         (unwords [ cCP, dosifyPath tmp_file, dosifyPath makefile ])
 169
 170
 171 findDependency :: Bool -> FilePath -> ModuleName -> IO (Maybe (String, Bool))
 172 findDependency is_source src imp = do
 173    dir_contents <- readIORef v_Dep_dir_contents
 174    ignore_dirs  <- readIORef v_Dep_ignore_dirs
 175    excl_mods    <- readIORef v_Dep_exclude_mods
 176    hisuf <- readIORef v_Hi_suf
 177
 178    let
 179      imp_mod      = moduleNameUserString imp
 180      imp_hi       = imp_mod ++ '.':hisuf
 181      imp_hiboot   = imp_mod ++ ".hi-boot"
 182      imp_hiboot_v = imp_mod ++ ".hi-boot-" ++ cHscIfaceFileVersion
 183      imp_hs       = imp_mod ++ ".hs"
 184      imp_lhs      = imp_mod ++ ".lhs"
 185
 186      deps | is_source = [ imp_hiboot_v, imp_hiboot, imp_hs, imp_lhs ]
 187           | otherwise = [ imp_hi, imp_hs, imp_lhs ]
 188
 189      search [] = throwDyn (ProgramError (src ++ ": " ++ "can't find one of the following: " ++
 190                                       unwords (map (\d -> '`': d ++ "'") deps)))
 191      search ((dir, contents) : dirs)
 192            | null present = search dirs
 193            | otherwise =
 194                 if dir `elem` ignore_dirs
 195                         then return Nothing
 196                         else if is_source
 197                                 then if dep /= imp_hiboot_v
 198                                         then return (Just (dir++'/':imp_hiboot, False))
 199                                         else return (Just (dir++'/':dep, False))
 200                                 else return (Just (dir++'/':imp_hi, not is_source))
 201            where
 202                 present = filter (`elem` contents) deps
 203                 dep     = head present
 204
 205    -- in
 206    if imp_mod `elem` excl_mods then
 207       return Nothing
 208     else
 209       search dir_contents