From: simonmar Date: Wed, 11 Oct 2000 15:31:43 +0000 (+0000) Subject: [project @ 2000-10-11 15:31:43 by simonmar] X-Git-Tag: Approximately_9120_patches~3635 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=8e009ec9dfa9fddd6f196c683f6335c84dca55f0;p=ghc-hetmet.git [project @ 2000-10-11 15:31:43 by simonmar] MkDependHS stuff separated into its own file. --- diff --git a/ghc/compiler/main/DriverMkDepend.hs b/ghc/compiler/main/DriverMkDepend.hs new file mode 100644 index 0000000..8a80a85 --- /dev/null +++ b/ghc/compiler/main/DriverMkDepend.hs @@ -0,0 +1,207 @@ +----------------------------------------------------------------------------- +-- $Id: DriverMkDepend.hs,v 1.1 2000/10/11 15:31:43 simonmar Exp $ +-- +-- GHC Driver +-- +-- (c) Simon Marlow 2000 +-- +----------------------------------------------------------------------------- + +module DriverMkDepend where + +#include "HsVersions.h" + +import CmSummarise -- for mkdependHS stuff +import DriverState +import DriverUtil +import DriverFlags +import TmpFiles +import Config +import Util +import CmdLineOpts + +import IOExts +import Exception + +import Directory +import IO +import Monad +import Maybe + +------------------------------------------------------------------------------- +-- mkdependHS + + -- flags +GLOBAL_VAR(dep_makefile, "Makefile", String); +GLOBAL_VAR(dep_include_prelude, False, Bool); +GLOBAL_VAR(dep_ignore_dirs, [], [String]); +GLOBAL_VAR(dep_suffixes, [], [String]); +GLOBAL_VAR(dep_warnings, True, Bool); + + -- global vars +GLOBAL_VAR(dep_makefile_hdl, error "dep_makefile_hdl", Maybe Handle); +GLOBAL_VAR(dep_tmp_file, error "dep_tmp_file", String); +GLOBAL_VAR(dep_tmp_hdl, error "dep_tmp_hdl", Handle); +GLOBAL_VAR(dep_dir_contents, error "dep_dir_contents", [(String,[String])]); + +depStartMarker = "# DO NOT DELETE: Beginning of Haskell dependencies" +depEndMarker = "# DO NOT DELETE: End of Haskell dependencies" + +-- for compatibility with the old mkDependHS, we accept options of the form +-- -optdep-f -optdep.depend, etc. +dep_opts = [ + ( "s", SepArg (add dep_suffixes) ), + ( "f", SepArg (writeIORef dep_makefile) ), + ( "w", NoArg (writeIORef dep_warnings False) ), + ( "-include-prelude", NoArg (writeIORef dep_include_prelude True) ), + ( "X", Prefix (addToDirList dep_ignore_dirs) ), + ( "-exclude-directory=", Prefix (addToDirList dep_ignore_dirs) ) + ] + +beginMkDependHS :: IO () +beginMkDependHS = do + + -- slurp in the mkdependHS-style options + flags <- getStaticOpts opt_dep + _ <- processArgs dep_opts flags [] + + -- open a new temp file in which to stuff the dependency info + -- as we go along. + dep_file <- newTempName "dep" + writeIORef dep_tmp_file dep_file + tmp_hdl <- openFile dep_file WriteMode + writeIORef dep_tmp_hdl tmp_hdl + + -- open the makefile + makefile <- readIORef dep_makefile + exists <- doesFileExist makefile + if not exists + then do + writeIORef dep_makefile_hdl Nothing + return () + + else do + makefile_hdl <- openFile makefile ReadMode + writeIORef dep_makefile_hdl (Just makefile_hdl) + + -- slurp through until we get the magic start string, + -- copying the contents into dep_makefile + let slurp = do + l <- hGetLine makefile_hdl + if (l == depStartMarker) + then return () + else do hPutStrLn tmp_hdl l; slurp + + -- slurp through until we get the magic end marker, + -- throwing away the contents + let chuck = do + l <- hGetLine makefile_hdl + if (l == depEndMarker) + then return () + else chuck + + catchJust ioErrors slurp + (\e -> if isEOFError e then return () else ioError e) + catchJust ioErrors chuck + (\e -> if isEOFError e then return () else ioError e) + + + -- write the magic marker into the tmp file + hPutStrLn tmp_hdl depStartMarker + + -- cache the contents of all the import directories, for future + -- reference. + import_dirs <- readIORef import_paths + pkg_import_dirs <- getPackageImportPath + import_dir_contents <- mapM getDirectoryContents import_dirs + pkg_import_dir_contents <- mapM getDirectoryContents pkg_import_dirs + writeIORef dep_dir_contents + (zip import_dirs import_dir_contents ++ + zip pkg_import_dirs pkg_import_dir_contents) + + -- ignore packages unless --include-prelude is on + include_prelude <- readIORef dep_include_prelude + when (not include_prelude) $ + mapM_ (add dep_ignore_dirs) pkg_import_dirs + + return () + + +endMkDependHS :: IO () +endMkDependHS = do + makefile <- readIORef dep_makefile + makefile_hdl <- readIORef dep_makefile_hdl + tmp_file <- readIORef dep_tmp_file + tmp_hdl <- readIORef dep_tmp_hdl + + -- write the magic marker into the tmp file + hPutStrLn tmp_hdl depEndMarker + + case makefile_hdl of + Nothing -> return () + Just hdl -> do + + -- slurp the rest of the orignal makefile and copy it into the output + let slurp = do + l <- hGetLine hdl + hPutStrLn tmp_hdl l + slurp + + catchJust ioErrors slurp + (\e -> if isEOFError e then return () else ioError e) + + hClose hdl + + hClose tmp_hdl -- make sure it's flushed + + -- create a backup of the original makefile + when (isJust makefile_hdl) $ + run_something ("Backing up " ++ makefile) + (unwords [ "cp", makefile, makefile++".bak" ]) + + -- copy the new makefile in place + run_something "Installing new makefile" + (unwords [ "cp", tmp_file, makefile ]) + + +findDependency :: String -> ModImport -> IO (Maybe (String, Bool)) +findDependency mod imp = do + dir_contents <- readIORef dep_dir_contents + ignore_dirs <- readIORef dep_ignore_dirs + hisuf <- readIORef hi_suf + + let + (imp_mod, is_source) = + case imp of + MINormal str -> (str, False) + MISource str -> (str, True ) + + imp_hi = imp_mod ++ '.':hisuf + imp_hiboot = imp_mod ++ ".hi-boot" + imp_hiboot_v = imp_mod ++ ".hi-boot-" ++ cHscIfaceFileVersion + imp_hs = imp_mod ++ ".hs" + imp_lhs = imp_mod ++ ".lhs" + + deps | is_source = [ imp_hiboot_v, imp_hiboot, imp_hs, imp_lhs ] + | otherwise = [ imp_hi, imp_hs, imp_lhs ] + + search [] = throwDyn (OtherError ("can't find one of the following: " ++ + unwords (map (\d -> '`': d ++ "'") deps) ++ + " (imported from `" ++ mod ++ "')")) + search ((dir, contents) : dirs) + | null present = search dirs + | otherwise = + if dir `elem` ignore_dirs + then return Nothing + else if is_source + then if dep /= imp_hiboot_v + then return (Just (dir++'/':imp_hiboot, False)) + else return (Just (dir++'/':dep, False)) + else return (Just (dir++'/':imp_hi, not is_source)) + where + present = filter (`elem` contents) deps + dep = head present + + -- in + search dir_contents +