ghc/compiler/main/DriverMkDepend.hs

   1 -----------------------------------------------------------------------------
   2 -- $Id: DriverMkDepend.hs,v 1.3 2000/10/26 16:21:02 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 CmSummarise -- for mkdependHS stuff
  15 import DriverState
  16 import DriverUtil
  17 import DriverFlags
  18 import TmpFiles
  19 import Module
  20 import Config
  21 import Util
  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_suffixes,              [], [String]);
  39 GLOBAL_VAR(v_Dep_warnings,              True, Bool);
  40
  41         -- global vars
  42 GLOBAL_VAR(v_Dep_makefile_hdl,  error "dep_makefile_hdl", Maybe Handle);
  43 GLOBAL_VAR(v_Dep_tmp_file,      error "dep_tmp_file", String);
  44 GLOBAL_VAR(v_Dep_tmp_hdl,       error "dep_tmp_hdl", Handle);
  45 GLOBAL_VAR(v_Dep_dir_contents,  error "dep_dir_contents", [(String,[String])]);
  46
  47 depStartMarker = "# DO NOT DELETE: Beginning of Haskell dependencies"
  48 depEndMarker   = "# DO NOT DELETE: End of Haskell dependencies"
  49
  50 -- for compatibility with the old mkDependHS, we accept options of the form
  51 -- -optdep-f -optdep.depend, etc.
  52 dep_opts = [
  53    (  "s",                      SepArg (add v_Dep_suffixes) ),
  54    (  "f",                      SepArg (writeIORef v_Dep_makefile) ),
  55    (  "w",                      NoArg (writeIORef v_Dep_warnings False) ),
  56    (  "-include-prelude",       NoArg (writeIORef v_Dep_include_prelude True) ),
  57    (  "X",                      Prefix (addToDirList v_Dep_ignore_dirs) ),
  58    (  "-exclude-directory=",    Prefix (addToDirList v_Dep_ignore_dirs) )
  59  ]
  60
  61 beginMkDependHS :: IO ()
  62 beginMkDependHS = do
  63
  64         -- slurp in the mkdependHS-style options
  65   flags <- getStaticOpts v_Opt_dep
  66   _ <- processArgs dep_opts flags []
  67
  68         -- open a new temp file in which to stuff the dependency info
  69         -- as we go along.
  70   dep_file <- newTempName "dep"
  71   writeIORef v_Dep_tmp_file dep_file
  72   tmp_hdl <- openFile dep_file WriteMode
  73   writeIORef v_Dep_tmp_hdl tmp_hdl
  74
  75         -- open the makefile
  76   makefile <- readIORef v_Dep_makefile
  77   exists <- doesFileExist makefile
  78   if not exists
  79         then do
  80            writeIORef v_Dep_makefile_hdl Nothing
  81            return ()
  82
  83         else do
  84            makefile_hdl <- openFile makefile ReadMode
  85            writeIORef v_Dep_makefile_hdl (Just makefile_hdl)
  86
  87                 -- slurp through until we get the magic start string,
  88                 -- copying the contents into dep_makefile
  89            let slurp = do
  90                 l <- hGetLine makefile_hdl
  91                 if (l == depStartMarker)
  92                         then return ()
  93                         else do hPutStrLn tmp_hdl l; slurp
  94
  95                 -- slurp through until we get the magic end marker,
  96                 -- throwing away the contents
  97            let chuck = do
  98                 l <- hGetLine makefile_hdl
  99                 if (l == depEndMarker)
 100                         then return ()
 101                         else chuck
 102
 103            catchJust ioErrors slurp
 104                 (\e -> if isEOFError e then return () else ioError e)
 105            catchJust ioErrors chuck
 106                 (\e -> if isEOFError e then return () else ioError e)
 107
 108
 109         -- write the magic marker into the tmp file
 110   hPutStrLn tmp_hdl depStartMarker
 111
 112         -- cache the contents of all the import directories, for future
 113         -- reference.
 114   import_dirs <- readIORef v_Import_paths
 115   pkg_import_dirs <- getPackageImportPath
 116   import_dir_contents <- mapM getDirectoryContents import_dirs
 117   pkg_import_dir_contents <- mapM getDirectoryContents pkg_import_dirs
 118   writeIORef v_Dep_dir_contents
 119         (zip import_dirs import_dir_contents ++
 120          zip pkg_import_dirs pkg_import_dir_contents)
 121
 122         -- ignore packages unless --include-prelude is on
 123   include_prelude <- readIORef v_Dep_include_prelude
 124   when (not include_prelude) $
 125     mapM_ (add v_Dep_ignore_dirs) pkg_import_dirs
 126
 127   return ()
 128
 129
 130 endMkDependHS :: IO ()
 131 endMkDependHS = do
 132   makefile     <- readIORef v_Dep_makefile
 133   makefile_hdl <- readIORef v_Dep_makefile_hdl
 134   tmp_file     <- readIORef v_Dep_tmp_file
 135   tmp_hdl      <- readIORef v_Dep_tmp_hdl
 136
 137         -- write the magic marker into the tmp file
 138   hPutStrLn tmp_hdl depEndMarker
 139
 140   case makefile_hdl of
 141      Nothing  -> return ()
 142      Just hdl -> do
 143
 144           -- slurp the rest of the orignal makefile and copy it into the output
 145         let slurp = do
 146                 l <- hGetLine hdl
 147                 hPutStrLn tmp_hdl l
 148                 slurp
 149
 150         catchJust ioErrors slurp
 151                 (\e -> if isEOFError e then return () else ioError e)
 152
 153         hClose hdl
 154
 155   hClose tmp_hdl  -- make sure it's flushed
 156
 157         -- create a backup of the original makefile
 158   when (isJust makefile_hdl) $
 159      run_something ("Backing up " ++ makefile)
 160         (unwords [ "cp", makefile, makefile++".bak" ])
 161
 162         -- copy the new makefile in place
 163   run_something "Installing new makefile"
 164         (unwords [ "cp", tmp_file, makefile ])
 165
 166
 167 findDependency :: String -> ModImport -> IO (Maybe (String, Bool))
 168 findDependency mod imp = do
 169    dir_contents <- readIORef v_Dep_dir_contents
 170    ignore_dirs  <- readIORef v_Dep_ignore_dirs
 171    hisuf <- readIORef v_Hi_suf
 172
 173    let
 174      (imp_mod, is_source) =
 175         case imp of
 176            MINormal str -> (moduleNameString str, False)
 177            MISource str -> (moduleNameString str, True )
 178
 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 (OtherError ("can't find one of the following: " ++
 189                                       unwords (map (\d -> '`': d ++ "'") deps) ++
 190                                       " (imported from `" ++ mod ++ "')"))
 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    search dir_contents
 207