ghc/compiler/main/DriverMkDepend.hs

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