Commit 16d5d1c7 authored by simonpj's avatar simonpj

[project @ 2001-06-14 12:50:05 by simonpj]

----------------------
	Installation packaging
	----------------------

GHC runs various system programs like
	cp, touch
	gcc, as, ld etc

On Windows we plan to deliver these programs along with GHC,
so we have to be careful about where to find them.

This commit isolates all these dependencies in a single module

	main/SysTools.lhs

Most of the #ifdefery for mingw has moved into this module.
There's some documentation in SysTools.lhs

Along the way I did lots of other cleanups.  In particular

  * There is no more 'globbing' needed when calling runSomething
  * All file removal goes via the standard Directory.removeFile
  * TmpFiles.hs has gone; absorbed into SysTools
  * Some DynFlag stuff has moved from DriverFlags to CmdLineOpts


Still to do:

  **	I'm a bit concerned that calling removeFile one at a time
	when deleting masses of split-object files is going to be
	rather slow

  **	GHC now expects to find split,mangle,unlit in
		libdir/extra-bin
	instead of just
		libdir

	So something needs to change in the Unix installation scripts

  **    The "ineffective C preprocessor" is a perversion and should die
parent 8245241e
......@@ -12,7 +12,7 @@ you will screw up the layout where they are used in case expressions!
#ifdef __GLASGOW_HASKELL__
#define GLOBAL_VAR(name,value,ty) \
name = global (value) :: IORef (ty); \
name = Util.global (value) :: IORef (ty); \
{-# NOINLINE name #-}
#endif
......
# -----------------------------------------------------------------------------
# $Id: Makefile,v 1.155 2001/05/28 03:31:19 sof Exp $
# $Id: Makefile,v 1.156 2001/06/14 12:50:06 simonpj Exp $
TOP = ..
include $(TOP)/mk/boilerplate.mk
......@@ -25,6 +25,9 @@ endif
# -----------------------------------------------------------------------------
# Create compiler configuration
#
# The 'echo' commands simply spit the values of various make variables
# into Config.hs, whence they can be compiled and used by GHC itself
CURRENT_DIR = ghc/compiler
CONFIG_HS = main/Config.hs
......@@ -41,41 +44,31 @@ $(CONFIG_HS) : $(FPTOOLS_TOP)/mk/config.mk Makefile
@echo "cHscIfaceFileVersion = \"$(HscIfaceFileVersion)\"" >> $(CONFIG_HS)
@echo "cHOSTPLATFORM = \"$(HOSTPLATFORM)\"" >> $(CONFIG_HS)
@echo "cTARGETPLATFORM = \"$(TARGETPLATFORM)\"" >> $(CONFIG_HS)
@echo "cCURRENT_DIR = \"$(CURRENT_DIR)\"" >> $(CONFIG_HS)
@echo "cGHC_LIB_DIR = \"$(GHC_LIB_DIR)\"" >> $(CONFIG_HS)
@echo "cGHC_RUNTIME_DIR = \"$(GHC_RUNTIME_DIR)\"" >> $(CONFIG_HS)
@echo "cGHC_UTILS_DIR = \"$(GHC_UTILS_DIR)\"" >> $(CONFIG_HS)
@echo "cGHC_INCLUDE_DIR = \"$(GHC_INCLUDE_DIR)\"" >> $(CONFIG_HS)
@echo "cGHC_DRIVER_DIR = \"$(GHC_DRIVER_DIR)\"" >> $(CONFIG_HS)
@echo "cGCC = \"$(WhatGccIsCalled)\"" >> $(CONFIG_HS)
@echo "cMkDLL = \"$(BLD_DLL)\"" >> $(CONFIG_HS)
@echo "cGhcWithNativeCodeGen = \"$(GhcWithNativeCodeGen)\"" >> $(CONFIG_HS)
@echo "cGhcUnregisterised = \"$(GhcUnregisterised)\"" >> $(CONFIG_HS)
@echo "cLeadingUnderscore = \"$(LeadingUnderscore)\"" >> $(CONFIG_HS)
@echo "cRAWCPP = \"$(GHC_RAWCPP)\"" >> $(CONFIG_HS)
@echo "cGCC = \"$(WhatGccIsCalled)\"" >> $(CONFIG_HS)
@echo "cMkDLL = \"$(BLD_DLL)\"" >> $(CONFIG_HS)
@echo "cGHC_DRIVER_DIR = \"$(GHC_DRIVER_DIR)\"" >> $(CONFIG_HS)
@echo "cGHC_TOUCHY = \"$(GHC_TOUCHY)\"" >> $(CONFIG_HS)
@echo "cGHC_TOUCHY_DIR = \"$(GHC_TOUCHY)\"" >> $(CONFIG_HS)
@echo "cGHC_UNLIT = \"$(GHC_UNLIT)\"" >> $(CONFIG_HS)
@echo "cGHC_UNLIT_DIR = \"$(GHC_UNLIT_DIR)\"" >> $(CONFIG_HS)
@echo "cGHC_MANGLER = \"$(GHC_MANGLER)\"" >> $(CONFIG_HS)
@echo "cGHC_MANGLER_DIR = \"$(GHC_MANGLER_DIR)\"" >> $(CONFIG_HS)
@echo "cGHC_SPLIT = \"$(GHC_SPLIT)\"" >> $(CONFIG_HS)
@echo "cGHC_SPLIT_DIR = \"$(GHC_SPLIT_DIR)\"" >> $(CONFIG_HS)
@echo "cGHC_SYSMAN = \"$(GHC_SYSMAN)\"" >> $(CONFIG_HS)
@echo "cGHC_SYSMAN_DIR = \"$(GHC_SYSMAN_DIR)\"" >> $(CONFIG_HS)
@echo "cGHC_CP = \"$(GHC_CP)\"" >> $(CONFIG_HS)
@echo "cGHC_PERL = \"$(GHC_PERL)\"" >> $(CONFIG_HS)
@echo "cEnableWin32DLLs = \"$(EnableWin32DLLs)\"" >> $(CONFIG_HS)
ifeq "$(TARGETPLATFORM) and $(MinimalUnixDeps)" "i386-unknown-mingw32 and YES"
@echo "cCP = \"copy /y\"" >> $(CONFIG_HS)
@echo "cRM = \"del /F /Q\"" >> $(CONFIG_HS)
@echo "cTOUCH = \"$(GHC_TOUCHY)\"" >> $(CONFIG_HS)
else
@echo "cCP = \"$(CP)\"" >> $(CONFIG_HS)
@echo "cRM = \"$(RM)\"" >> $(CONFIG_HS)
@echo "cTOUCH = \"touch\"" >> $(CONFIG_HS)
endif
@echo "cCONTEXT_DIFF = \"$(CONTEXT_DIFF)\"" >> $(CONFIG_HS)
@echo "cHaveLibGmp = \"$(HaveLibGmp)\"" >> $(CONFIG_HS)
@echo "cUSER_WAY_NAMES = \"$(USER_WAY_NAMES)\"" >> $(CONFIG_HS)
@echo "cUSER_WAY_OPTS = \"$(USER_WAY_OPTS)\"" >> $(CONFIG_HS)
@echo "cDEFAULT_TMPDIR = \"$(DEFAULT_TMPDIR)\"" >> $(CONFIG_HS)
ifeq "$(TARGETPLATFORM) and $(MinimalUnixDeps)" "i386-unknown-mingw32 and YES"
@echo "cRAWCPP = \"$(subst -mwin32,,$(RAWCPP))\"" >> $(CONFIG_HS)
else
@echo "cRAWCPP = \"$(RAWCPP)\"" >> $(CONFIG_HS)
endif
@echo done.
CLEAN_FILES += $(CONFIG_HS)
......@@ -250,7 +243,7 @@ main/DriverPipeline_HC_OPTS = -fno-cse
main/DriverState_HC_OPTS = -fno-cse
main/DriverUtil_HC_OPTS = -fno-cse
main/Finder_HC_OPTS = -fno-cse
main/TmpFiles_HC_OPTS = -fno-cse
main/SysTools_HC_OPTS = -fno-cse
# ----------------------------------------------------------------------------
# C compilations
......
......@@ -104,6 +104,8 @@ LocalId and GlobalId
A GlobalId is
* always a constant (top-level)
* imported, or data constructor, or primop, or record selector
* has a Unique that is globally unique across the whole
GHC invocation (a single invocation may compile multiple modules)
A LocalId is
* bound within an expression (lambda, case, local let(rec))
......
......@@ -35,9 +35,8 @@ import FiniteMap
import Outputable
import ErrUtils ( showPass )
import CmdLineOpts ( DynFlags(..) )
import Panic ( panic, GhcException(..) )
import Panic ( panic )
import Exception
import List
import Monad
import IO
......@@ -219,9 +218,6 @@ link' Interactive dflags batch_attempt_linking linkables pls
linkObjs (objs ++ bcos) pls
-- get the objects first
ppLinkableSCC :: SCC Linkable -> SDoc
ppLinkableSCC = ppr . flattenSCC
filterModuleLinkables :: (ModuleName -> Bool) -> [Linkable] -> [Linkable]
filterModuleLinkables p [] = []
filterModuleLinkables p (li:lis)
......
......@@ -55,8 +55,8 @@ import UniqFM
import Unique ( Uniquable )
import Digraph ( SCC(..), stronglyConnComp, flattenSCC )
import ErrUtils ( showPass )
import SysTools ( cleanTempFilesExcept )
import Util
import TmpFiles
import Outputable
import Panic
import CmdLineOpts ( DynFlags(..) )
......
-----------------------------------------------------------------------------
-- $Id: InteractiveUI.hs,v 1.73 2001/06/07 16:00:18 sewardj Exp $
-- $Id: InteractiveUI.hs,v 1.74 2001/06/14 12:50:06 simonpj Exp $
--
-- GHC Interactive User Interface
--
......@@ -24,7 +24,7 @@ import Finder ( flushPackageCache )
import Util
import Name ( Name )
import Outputable
import CmdLineOpts ( DynFlag(..), dopt_unset )
import CmdLineOpts ( DynFlag(..), getDynFlags, saveDynFlags, restoreDynFlags, dopt_unset )
import Panic ( GhcException(..) )
import Config
......@@ -302,7 +302,7 @@ runStmt stmt
= return Nothing
| otherwise
= do st <- getGHCiState
dflags <- io (getDynFlags)
dflags <- io getDynFlags
let dflags' = dopt_unset dflags Opt_WarnUnusedBinds
(new_cmstate, names) <- io (cmRunStmt (cmstate st) dflags' stmt)
setGHCiState st{cmstate = new_cmstate}
......@@ -396,7 +396,7 @@ defineMacro s = do
-- compile the expression
st <- getGHCiState
dflags <- io (getDynFlags)
dflags <- io getDynFlags
(new_cmstate, maybe_hv) <- io (cmCompileExpr (cmstate st) dflags new_expr)
setGHCiState st{cmstate = new_cmstate}
case maybe_hv of
......@@ -427,7 +427,7 @@ loadModule path = timeIt (loadModule' path)
loadModule' path = do
state <- getGHCiState
dflags <- io (getDynFlags)
dflags <- io getDynFlags
cmstate1 <- io (cmUnload (cmstate state) dflags)
setGHCiState state{ cmstate = cmstate1, target = Nothing }
io (revertCAFs) -- always revert CAFs on load.
......@@ -464,7 +464,7 @@ modulesLoadedMsg ok mods = do
typeOfExpr :: String -> GHCi ()
typeOfExpr str
= do st <- getGHCiState
dflags <- io (getDynFlags)
dflags <- io getDynFlags
(new_cmstate, maybe_tystr) <- io (cmTypeOfExpr (cmstate st) dflags str)
setGHCiState st{cmstate = new_cmstate}
case maybe_tystr of
......@@ -513,11 +513,9 @@ setOptions str
-- then, dynamic flags
io $ do
dyn_flags <- readIORef v_InitDynFlags
writeIORef v_DynFlags dyn_flags
restoreDynFlags
leftovers <- processArgs dynamic_flags leftovers []
dyn_flags <- readIORef v_DynFlags
writeIORef v_InitDynFlags dyn_flags
saveDynFlags
if (not (null leftovers))
then throwDyn (CmdLineError ("unrecognised flags: " ++
......@@ -572,7 +570,7 @@ optToStr RevertCAFs = "r"
newPackages new_pkgs = do
state <- getGHCiState
dflags <- io (getDynFlags)
dflags <- io getDynFlags
cmstate1 <- io (cmUnload (cmstate state) dflags)
setGHCiState state{ cmstate = cmstate1, target = Nothing }
......
......@@ -14,7 +14,6 @@ module CmdLineOpts (
HscLang(..),
DynFlag(..), -- needed non-abstractly by DriverFlags
DynFlags(..),
defaultDynFlags,
v_Static_hsc_opts,
......@@ -22,26 +21,35 @@ module CmdLineOpts (
switchIsOn,
isStaticHscFlag,
opt_PprStyle_NoPrags,
opt_PprStyle_RawTypes,
opt_PprUserLength,
opt_PprStyle_Debug,
dopt,
dopt_set,
dopt_unset,
-- other dynamic flags
dopt_CoreToDo,
dopt_StgToDo,
dopt_HscLang,
dopt_OutName,
-- Manipulating DynFlags
defaultDynFlags, -- DynFlags
dopt, -- DynFlag -> DynFlags -> Bool
dopt_set, dopt_unset, -- DynFlags -> DynFlag -> DynFlags
dopt_CoreToDo, -- DynFlags -> [CoreToDo]
dopt_StgToDo, -- DynFlags -> [StgToDo]
dopt_HscLang, -- DynFlags -> HscLang
dopt_OutName, -- DynFlags -> String
-- Manipulating the DynFlags state
getDynFlags, -- IO DynFlags
setDynFlags, -- DynFlags -> IO ()
updDynFlags, -- (DynFlags -> DynFlags) -> IO ()
dynFlag, -- (DynFlags -> a) -> IO a
setDynFlag, unSetDynFlag, -- DynFlag -> IO ()
saveDynFlags, -- IO ()
restoreDynFlags, -- IO DynFlags
-- sets of warning opts
standardWarnings,
minusWOpts,
minusWallOpts,
-- Output style options
opt_PprStyle_NoPrags,
opt_PprStyle_RawTypes,
opt_PprUserLength,
opt_PprStyle_Debug,
-- profiling opts
opt_AutoSccsOnAllToplevs,
opt_AutoSccsOnExportedToplevs,
......@@ -108,7 +116,7 @@ module CmdLineOpts (
import Array ( array, (//) )
import GlaExts
import IOExts ( IORef, readIORef )
import IOExts ( IORef, readIORef, writeIORef )
import Constants -- Default values for some flags
import Util
import FastTypes
......@@ -312,6 +320,14 @@ data DynFlags = DynFlags {
flags :: [DynFlag]
}
data HscLang
= HscC
| HscAsm
| HscJava
| HscILX
| HscInterpreted
deriving (Eq, Show)
defaultDynFlags = DynFlags {
coreToDo = [], stgToDo = [],
hscLang = HscC,
......@@ -353,24 +369,61 @@ dopt_StgToDo = stgToDo
dopt_OutName :: DynFlags -> String
dopt_OutName = hscOutName
dopt_HscLang :: DynFlags -> HscLang
dopt_HscLang = hscLang
dopt_set :: DynFlags -> DynFlag -> DynFlags
dopt_set dfs f = dfs{ flags = f : flags dfs }
dopt_unset :: DynFlags -> DynFlag -> DynFlags
dopt_unset dfs f = dfs{ flags = filter (/= f) (flags dfs) }
\end{code}
data HscLang
= HscC
| HscAsm
| HscJava
| HscILX
| HscInterpreted
deriving (Eq, Show)
-----------------------------------------------------------------------------
-- Mess about with the mutable variables holding the dynamic arguments
dopt_HscLang :: DynFlags -> HscLang
dopt_HscLang = hscLang
-- v_InitDynFlags
-- is the "baseline" dynamic flags, initialised from
-- the defaults and command line options, and updated by the
-- ':s' command in GHCi.
--
-- v_DynFlags
-- is the dynamic flags for the current compilation. It is reset
-- to the value of v_InitDynFlags before each compilation, then
-- updated by reading any OPTIONS pragma in the current module.
\begin{code}
GLOBAL_VAR(v_InitDynFlags, defaultDynFlags, DynFlags)
GLOBAL_VAR(v_DynFlags, defaultDynFlags, DynFlags)
setDynFlags :: DynFlags -> IO ()
setDynFlags dfs = writeIORef v_DynFlags dfs
saveDynFlags :: IO ()
saveDynFlags = do dfs <- readIORef v_DynFlags
writeIORef v_InitDynFlags dfs
restoreDynFlags :: IO DynFlags
restoreDynFlags = do dfs <- readIORef v_InitDynFlags
writeIORef v_DynFlags dfs
return dfs
getDynFlags :: IO DynFlags
getDynFlags = readIORef v_DynFlags
updDynFlags :: (DynFlags -> DynFlags) -> IO ()
updDynFlags f = do dfs <- readIORef v_DynFlags
writeIORef v_DynFlags (f dfs)
dynFlag :: (DynFlags -> a) -> IO a
dynFlag f = do dflags <- readIORef v_DynFlags; return (f dflags)
setDynFlag, unSetDynFlag :: DynFlag -> IO ()
setDynFlag f = updDynFlags (\dfs -> dopt_set dfs f)
unSetDynFlag f = updDynFlags (\dfs -> dopt_unset dfs f)
\end{code}
%************************************************************************
%* *
\subsection{Warnings}
......
{-# OPTIONS -#include "hschooks.h" #-}
-----------------------------------------------------------------------------
-- $Id: DriverFlags.hs,v 1.57 2001/06/13 15:50:25 rrt Exp $
-- $Id: DriverFlags.hs,v 1.58 2001/06/14 12:50:06 simonpj Exp $
--
-- Driver flags
--
......@@ -11,10 +11,9 @@
module DriverFlags (
processArgs, OptKind(..), static_flags, dynamic_flags,
v_InitDynFlags, v_DynFlags, getDynFlags, dynFlag,
getDynFlags, dynFlag,
getOpts, getVerbFlag, addCmdlineHCInclude,
buildStaticHscOpts,
runSomething,
machdepCCOpts
) where
......@@ -22,7 +21,7 @@ module DriverFlags (
import DriverState
import DriverUtil
import TmpFiles ( v_TmpDir )
import SysTools ( setTmpDir, setPgm, setDryRun, showGhcUsage )
import CmdLineOpts
import Config
import Util
......@@ -30,11 +29,11 @@ import Panic
import Exception
import IOExts
import System ( exitWith, ExitCode(..) )
import IO
import Maybe
import Monad
import System
import Char
-----------------------------------------------------------------------------
......@@ -71,15 +70,15 @@ data OptKind
| AnySuffixPred (String -> Bool) (String -> IO ())
processArgs :: [(String,OptKind)] -> [String] -> [String]
-> IO [String] -- returns spare args
-> IO [String] -- returns spare args
processArgs _spec [] spare = return (reverse spare)
processArgs spec args@(('-':arg):args') spare = do
case findArg spec arg of
Just (rest,action) ->
do args' <- processOneArg action rest args
processArgs spec args' spare
Nothing ->
processArgs spec args' (('-':arg):spare)
Just (rest,action) -> do args' <- processOneArg action rest args
processArgs spec args' spare
Nothing -> processArgs spec args' (('-':arg):spare)
processArgs spec (arg:args) spare =
processArgs spec args (arg:spare)
......@@ -127,7 +126,8 @@ processOneArg action rest (dash_arg@('-':arg):args) =
findArg :: [(String,OptKind)] -> String -> Maybe (String,OptKind)
findArg spec arg
= case [ (remove_spaces rest, k)
| (pat,k) <- spec, Just rest <- [my_prefix_match pat arg],
| (pat,k) <- spec,
Just rest <- [my_prefix_match pat arg],
arg_ok k rest arg ]
of
[] -> Nothing
......@@ -152,8 +152,8 @@ arg_ok (AnySuffixPred p _) rest arg = p arg
static_flags =
[ ------- help -------------------------------------------------------
( "?" , NoArg long_usage)
, ( "-help" , NoArg long_usage)
( "?" , NoArg showGhcUsage)
, ( "-help" , NoArg showGhcUsage)
------- version ----------------------------------------------------
......@@ -164,7 +164,7 @@ static_flags =
exitWith ExitSuccess))
------- verbosity ----------------------------------------------------
, ( "n" , NoArg (writeIORef v_Dry_run True) )
, ( "n" , NoArg setDryRun )
------- recompilation checker --------------------------------------
, ( "recomp" , NoArg (writeIORef v_Recomp True) )
......@@ -210,7 +210,7 @@ static_flags =
, ( "hisuf" , HasArg (writeIORef v_Hi_suf) )
, ( "hidir" , HasArg (writeIORef v_Hi_dir . Just) )
, ( "buildtag" , HasArg (writeIORef v_Build_tag) )
, ( "tmpdir" , HasArg (writeIORef v_TmpDir . (++ "/")) )
, ( "tmpdir" , HasArg setTmpDir)
, ( "ohi" , HasArg (writeIORef v_Output_hi . Just) )
-- -odump?
......@@ -242,13 +242,7 @@ static_flags =
, ( "syslib" , HasArg (addPackage) ) -- for compatibility w/ old vsns
------- Specific phases --------------------------------------------
, ( "pgmL" , HasArg (writeIORef v_Pgm_L) )
, ( "pgmP" , HasArg (writeIORef v_Pgm_P) )
, ( "pgmc" , HasArg (writeIORef v_Pgm_c) )
, ( "pgmm" , HasArg (writeIORef v_Pgm_m) )
, ( "pgms" , HasArg (writeIORef v_Pgm_s) )
, ( "pgma" , HasArg (writeIORef v_Pgm_a) )
, ( "pgml" , HasArg (writeIORef v_Pgm_l) )
, ( "pgm" , HasArg setPgm )
, ( "optdep" , HasArg (add v_Opt_dep) )
, ( "optl" , HasArg (add v_Opt_l) )
......@@ -293,73 +287,6 @@ static_flags =
, ( "f", AnySuffixPred (isStaticHscFlag) (add v_Opt_C) )
]
-----------------------------------------------------------------------------
-- parse the dynamic arguments
-- v_InitDynFlags
-- is the "baseline" dynamic flags, initialised from
-- the defaults and command line options, and updated by the
-- ':s' command in GHCi.
--
-- v_DynFlags
-- is the dynamic flags for the current compilation. It is reset
-- to the value of v_InitDynFlags before each compilation, then
-- updated by reading any OPTIONS pragma in the current module.
GLOBAL_VAR(v_InitDynFlags, defaultDynFlags, DynFlags)
GLOBAL_VAR(v_DynFlags, defaultDynFlags, DynFlags)
updDynFlags f = do
dfs <- readIORef v_DynFlags
writeIORef v_DynFlags (f dfs)
getDynFlags :: IO DynFlags
getDynFlags = readIORef v_DynFlags
dynFlag :: (DynFlags -> a) -> IO a
dynFlag f = do dflags <- readIORef v_DynFlags; return (f dflags)
setDynFlag f = updDynFlags (\dfs -> dopt_set dfs f)
unSetDynFlag f = updDynFlags (\dfs -> dopt_unset dfs f)
addOpt_L a = updDynFlags (\s -> s{opt_L = a : opt_L s})
addOpt_P a = updDynFlags (\s -> s{opt_P = a : opt_P s})
addOpt_c a = updDynFlags (\s -> s{opt_c = a : opt_c s})
addOpt_a a = updDynFlags (\s -> s{opt_a = a : opt_a s})
addOpt_m a = updDynFlags (\s -> s{opt_m = a : opt_m s})
addCmdlineHCInclude a =
updDynFlags (\s -> s{cmdlineHcIncludes = a : cmdlineHcIncludes s})
-- we add to the options from the front, so we need to reverse the list
getOpts :: (DynFlags -> [a]) -> IO [a]
getOpts opts = dynFlag opts >>= return . reverse
-- we can only change HscC to HscAsm and vice-versa with dynamic flags
-- (-fvia-C and -fasm).
-- NB: we can also set the new lang to ILX, via -filx. I hope this is right
setLang l = do
dfs <- readIORef v_DynFlags
case hscLang dfs of
HscC -> writeIORef v_DynFlags dfs{ hscLang = l }
HscAsm -> writeIORef v_DynFlags dfs{ hscLang = l }
HscILX -> writeIORef v_DynFlags dfs{ hscLang = l }
_ -> return ()
setVerbosityAtLeast n =
updDynFlags (\dfs -> if verbosity dfs < n
then dfs{ verbosity = n }
else dfs)
setVerbosity "" = updDynFlags (\dfs -> dfs{ verbosity = 3 })
setVerbosity n
| all isDigit n = updDynFlags (\dfs -> dfs{ verbosity = read n })
| otherwise = throwDyn (UsageError "can't parse verbosity flag (-v<n>)")
getVerbFlag = do
verb <- dynFlag verbosity
if verb >= 3 then return "-v" else return ""
dynamic_flags = [
( "cpp", NoArg (updDynFlags (\s -> s{ cppFlag = True })) )
......@@ -488,8 +415,6 @@ decodeSize str
n = read m :: Double
pred c = isDigit c || c == '.'
floatOpt :: IORef Double -> String -> IO ()
floatOpt ref str = writeIORef ref (read str :: Double)
-----------------------------------------------------------------------------
-- RTS Hooks
......@@ -526,30 +451,6 @@ buildStaticHscOpts = do
return ( static : filtered_opts )
-----------------------------------------------------------------------------
-- Running an external program
-- sigh, here because both DriverMkDepend & DriverPipeline need it.
runSomething phase_name cmd
= do
verb <- dynFlag verbosity
when (verb >= 2) $ hPutStrLn stderr ("*** " ++ phase_name)
when (verb >= 3) $ hPutStrLn stderr cmd
hFlush stderr
-- test for -n flag
n <- readIORef v_Dry_run
unless n $ do
-- and run it!
exit_code <- system cmd
if exit_code /= ExitSuccess
then throwDyn (PhaseFailed phase_name exit_code)
else do when (verb >= 3) (hPutStr stderr "\n")
return ()
-----------------------------------------------------------------------------
-- Via-C compilation stuff
......@@ -599,3 +500,35 @@ machdepCCOpts
| otherwise
= return ( [], [] )
addOpt_L a = updDynFlags (\s -> s{opt_L = a : opt_L s})
addOpt_P a = updDynFlags (\s -> s{opt_P = a : opt_P s})
addOpt_c a = updDynFlags (\s -> s{opt_c = a : opt_c s})
addOpt_a a = updDynFlags (\s -> s{opt_a = a : opt_a s})
addOpt_m a = updDynFlags (\s -> s{opt_m = a : opt_m s})
addCmdlineHCInclude a = updDynFlags (\s -> s{cmdlineHcIncludes = a : cmdlineHcIncludes s})
getOpts :: (DynFlags -> [a]) -> IO [a]
-- We add to the options from the front, so we need to reverse the list
getOpts opts = dynFlag opts >>= return . reverse
-- we can only change HscC to HscAsm and vice-versa with dynamic flags
-- (-fvia-C and -fasm).
-- NB: we can also set the new lang to ILX, via -filx. I hope this is right
setLang l = updDynFlags (\ dfs -> case hscLang dfs of
HscC -> dfs{ hscLang = l }
HscAsm -> dfs{ hscLang = l }
HscILX -> dfs{ hscLang = l }
_ -> dfs)
setVerbosity "" = updDynFlags (\dfs -> dfs{ verbosity = 3 })
setVerbosity n
| all isDigit n = updDynFlags (\dfs -> dfs{ verbosity = read n })
| otherwise = throwDyn (UsageError "can't parse verbosity flag (-v<n>)")
getVerbFlag = do
verb <- dynFlag verbosity
if verb >= 3 then return "-v" else return ""
-----------------------------------------------------------------------------
-- $Id: DriverMkDepend.hs,v 1.11 2001/05/28 03:31:19 sof Exp $
-- $Id: DriverMkDepend.hs,v 1.12 2001/06/14 12:50:06 simonpj Exp $
--
-- GHC Driver
--
......@@ -14,7 +14,8 @@ module DriverMkDepend where
import DriverState
import DriverUtil
import DriverFlags
import TmpFiles
import SysTools ( newTempName )
import qualified SysTools
import Module
import Config
import Util
......@@ -158,14 +159,12 @@ endMkDependHS = do
hClose tmp_hdl -- make sure it's flushed
-- create a backup of the original makefile
when (isJust makefile_hdl) $
runSomething ("Backing up " ++ makefile)
(unwords [ cCP, dosifyPath makefile, dosifyPath $ makefile++".bak" ])
-- Create a backup of the original makefile
when (isJust makefile_hdl)
(SysTools.copy ("Backing up " ++ makefile) makefile (makefile++".bak"))
-- copy the new makefile in place
runSomething "Installing new makefile"
(unwords [ cCP, dosifyPath tmp_file, dosifyPath makefile ])
-- Copy the new makefile in place
SysTools.copy "Installing new makefile" tmp_file makefile
findDependency :: Bool -> FilePath -> ModuleName -> IO (Maybe (String, Bool))
......
This diff is collapsed.
-----------------------------------------------------------------------------
-- $Id: DriverState.hs,v 1.43 2001/06/13 10:23:23 simonmar Exp $
-- $Id: DriverState.hs,v 1.44 2001/06/14 12:50:06 simonpj Exp $
--
-- Settings for the driver
--
......@@ -19,10 +19,6 @@ import Util
import Config
import Exception
import IOExts
#ifdef mingw32_TARGET_OS
import TmpFiles ( newTempName )
import Directory ( removeFile )
#endif
import Panic
import List
......@@ -37,9 +33,6 @@ cHaskell1Version = "5" -- i.e., Haskell 98
-----------------------------------------------------------------------------
-- Global compilation flags
-- location of compiler-related files
GLOBAL_VAR(v_TopDir, error "no TOPDIR", String)
-- Cpp-related flags
v_Hs_source_cpp_opts = global
[ "-D__HASKELL1__="++cHaskell1Version
......@@ -58,7 +51,6 @@ GLOBAL_VAR(v_Keep_tmp_files, False, Bool)
-- Misc
GLOBAL_VAR(v_Scale_sizes_by, 1.0, Double)
GLOBAL_VAR(v_Dry_run, False, Bool)
GLOBAL_VAR(v_Static, True, Bool)
GLOBAL_VAR(v_NoHsMain, False, Bool)
GLOBAL_VAR(v_Recomp, True, Bool)
......@@ -70,8 +62,9 @@ GLOBAL_VAR(v_Excess_precision, False, Bool)
-- Splitting object files (for libraries)
GLOBAL_VAR(v_Split_object_files, False, Bool)
GLOBAL_VAR(v_Split_prefix, "", String)
GLOBAL_VAR(v_N_split_files, 0, Int)
GLOBAL_VAR(v_Split_info, ("",0), (String,Int))
-- The split prefix and number of files
can_split :: Bool
can_split = prefixMatch "i386" cTARGETPLATFORM
......@@ -326,8 +319,6 @@ GLOBAL_VAR(v_HCHeader, "", String)
-----------------------------------------------------------------------------
-- Packages
GLOBAL_VAR(v_Path_package_config, error "path_package_config", String)
-- package list is maintained in dependency order
GLOBAL_VAR(v_Packages, ("std":"rts":"gmp":[]), [String])
......@@ -590,19 +581,6 @@ unregFlags =
-----------------------------------------------------------------------------
-- Programs for particular phases
GLOBAL_VAR(v_Pgm_L, error "pgm_L", String)
GLOBAL_VAR(v_Pgm_P, cRAWCPP, String)
GLOBAL_VAR(v_Pgm_c, cGCC, String)
GLOBAL_VAR(v_Pgm_m, error "pgm_m", String)
GLOBAL_VAR(v_Pgm_s, error "pgm_s", String)
GLOBAL_VAR(v_Pgm_a, cGCC, String)
GLOBAL_VAR(v_Pgm_l, cGCC, String)
GLOBAL_VAR(v_Pgm_dll, cMkDLL, String)