ghc/compiler/main/DriverMkDepend.hs

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