Commit 6f57245b authored by simonmar's avatar simonmar

[project @ 2002-01-04 16:02:03 by simonmar]

Some driver cleanups; in particular -fno-code should work in a more
reasonable way (it is now a "mode flag" like -C, -c, --make etc.).
parent ce26c4b7
......@@ -46,7 +46,6 @@ where
import CmLink
import CmTypes
import DriverPipeline
import DriverFlags ( getDynFlags )
import DriverState ( v_Output_file )
import DriverPhases
import DriverUtil
......@@ -59,7 +58,7 @@ import HscMain ( initPersistentCompilerState )
import HscTypes
import Name ( Name, NamedThing(..), nameRdrName, nameModule,
isHomePackageName )
import RdrName ( lookupRdrEnv, emptyRdrEnv )
import RdrName ( emptyRdrEnv )
import Module
import GetImports
import UniqFM
......@@ -70,11 +69,12 @@ import SysTools ( cleanTempFilesExcept )
import Util
import Outputable
import Panic
import CmdLineOpts ( DynFlags(..) )
import CmdLineOpts ( DynFlags(..), getDynFlags )
import IOExts
#ifdef GHCI
import RdrName ( lookupRdrEnv )
import Id ( idType, idName )
import NameEnv
import Type ( tidyType )
......
......@@ -26,6 +26,9 @@ module CmdLineOpts (
dopt_StgToDo, -- DynFlags -> [StgToDo]
dopt_HscLang, -- DynFlags -> HscLang
dopt_OutName, -- DynFlags -> String
getOpts, -- (DynFlags -> [a]) -> IO [a]
setLang,
getVerbFlag,
-- Manipulating the DynFlags state
getDynFlags, -- IO DynFlags
......@@ -383,6 +386,22 @@ dopt_set dfs f = dfs{ flags = f : flags dfs }
dopt_unset :: DynFlags -> DynFlag -> DynFlags
dopt_unset dfs f = dfs{ flags = filter (/= f) (flags dfs) }
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 switch between HscC, HscAsmm, and HscILX with dynamic flags
-- (-fvia-C, -fasm, -filx respectively).
setLang l = updDynFlags (\ dfs -> case hscLang dfs of
HscC -> dfs{ hscLang = l }
HscAsm -> dfs{ hscLang = l }
HscILX -> dfs{ hscLang = l }
_ -> dfs)
getVerbFlag = do
verb <- dynFlag verbosity
if verb >= 3 then return "-v" else return ""
\end{code}
-----------------------------------------------------------------------------
......
{-# OPTIONS -#include "hschooks.h" #-}
-----------------------------------------------------------------------------
-- $Id: DriverFlags.hs,v 1.83 2001/12/20 11:19:07 simonpj Exp $
-- $Id: DriverFlags.hs,v 1.84 2002/01/04 16:02:04 simonmar Exp $
--
-- Driver flags
--
......@@ -11,8 +11,7 @@
module DriverFlags (
processArgs, OptKind(..), static_flags, dynamic_flags,
getDynFlags, dynFlag,
getOpts, getVerbFlag, addCmdlineHCInclude,
addCmdlineHCInclude,
buildStaticHscOpts,
machdepCCOpts
) where
......@@ -21,6 +20,7 @@ module DriverFlags (
#include "../includes/config.h"
import DriverState
import DriverPhases
import DriverUtil
import SysTools
import CmdLineOpts
......@@ -166,6 +166,22 @@ static_flags =
------- verbosity ----------------------------------------------------
, ( "n" , NoArg setDryRun )
------- primary modes ------------------------------------------------
, ( "M" , PassFlag (setMode DoMkDependHS))
, ( "E" , PassFlag (setMode (StopBefore Hsc)))
, ( "C" , PassFlag (\f -> do setMode (StopBefore HCc) f
setLang HscC))
, ( "S" , PassFlag (setMode (StopBefore As)))
, ( "c" , PassFlag (setMode (StopBefore Ln)))
, ( "-make" , PassFlag (setMode DoMake))
, ( "-interactive" , PassFlag (setMode DoInteractive))
, ( "-mk-dll" , PassFlag (setMode DoMkDLL))
-- -fno-code says to stop after Hsc but don't generate any code.
, ( "fno-code" , PassFlag (\f -> do setMode (StopBefore HCc) f
setLang HscNothing
writeIORef v_Recomp False))
------- GHCi -------------------------------------------------------
, ( "ignore-dot-ghci", NoArg (writeIORef v_Read_DotGHCi False) )
, ( "read-dot-ghci" , NoArg (writeIORef v_Read_DotGHCi True) )
......@@ -268,7 +284,9 @@ static_flags =
------ Compiler flags -----------------------------------------------
, ( "O2-for-C" , NoArg (writeIORef v_minus_o2_for_C True) )
, ( "O" , OptPrefix (setOptLevel) )
, ( "O" , NoArg (setOptLevel 1))
, ( "Onot" , NoArg (setOptLevel 0))
, ( "O" , PrefixPred (all isDigit) (setOptLevel . read))
, ( "fno-asm-mangling" , NoArg (writeIORef v_Do_asm_mangling False) )
......@@ -397,7 +415,6 @@ dynamic_flags = [
, ( "fvia-c", NoArg (setLang HscC) )
, ( "fvia-C", NoArg (setLang HscC) )
, ( "filx", NoArg (setLang HscILX) )
, ( "fno-code", NoArg (setLang HscNothing) )
-- "active negatives"
, ( "fno-implicit-prelude", NoArg (setDynFlag Opt_NoImplicitPrelude) )
......@@ -547,7 +564,8 @@ machdepCCOpts
| otherwise
= return ( [], [] )
-----------------------------------------------------------------------------
-- local utils
addOpt_L a = updDynFlags (\s -> s{opt_L = a : opt_L s})
addOpt_P a = updDynFlags (\s -> s{opt_P = a : opt_P s})
......@@ -560,25 +578,9 @@ addOpt_I a = updDynFlags (\s -> s{opt_I = a : opt_I s})
addOpt_i a = updDynFlags (\s -> s{opt_i = a : opt_i s})
#endif
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). We can also set the new lang to ILX, via -filx.
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 ""
addCmdlineHCInclude a = updDynFlags (\s -> s{cmdlineHcIncludes = a : cmdlineHcIncludes s})
-----------------------------------------------------------------------------
-- $Id: DriverPhases.hs,v 1.14 2001/10/29 11:31:51 simonmar Exp $
-- $Id: DriverPhases.hs,v 1.15 2002/01/04 16:02:04 simonmar Exp $
--
-- GHC Driver
--
-- (c) Simon Marlow 2000
-- (c) The University of Glasgow 2002
--
-----------------------------------------------------------------------------
......@@ -42,7 +42,7 @@ data Phase
| Unlit
| Cpp
| HsPp
| Hsc -- ToDo: HscTargetLang
| Hsc
| Cc
| HCc -- Haskellised C (as opposed to vanilla C) compilation
| Mangle -- assembly mangling, now done by a separate script.
......
......@@ -2,7 +2,7 @@
--
-- GHC Driver
--
-- (c) Simon Marlow 2000
-- (c) The University of Glasgow 2002
--
-----------------------------------------------------------------------------
......@@ -11,7 +11,6 @@
module DriverPipeline (
-- interfaces for the batch-mode driver
GhcMode(..), getGhcMode, v_GhcMode,
genPipeline, runPipeline, pipeLoop,
-- interfaces for the compilation manager (interpreted/batch-mode)
......@@ -59,33 +58,6 @@ import Maybe
import PackedString
import MatchPS
-----------------------------------------------------------------------------
-- GHC modes of operation
modeFlag :: String -> Maybe GhcMode
modeFlag "-M" = Just $ DoMkDependHS
modeFlag "--mk-dll" = Just $ DoMkDLL
modeFlag "-E" = Just $ StopBefore Hsc
modeFlag "-C" = Just $ StopBefore HCc
modeFlag "-S" = Just $ StopBefore As
modeFlag "-c" = Just $ StopBefore Ln
modeFlag "--make" = Just $ DoMake
modeFlag "--interactive" = Just $ DoInteractive
modeFlag _ = Nothing
getGhcMode :: [String]
-> IO ( [String] -- rest of command line
, GhcMode
, String -- "GhcMode" flag
)
getGhcMode flags
= case my_partition modeFlag flags of
([] , rest) -> return (rest, DoLink, "") -- default is to do linking
([(flag,one)], rest) -> return (rest, one, flag)
(_ , _ ) ->
throwDyn (UsageError
"only one of the flags -M, -E, -C, -S, -c, --make, --interactive, --mk-dll is allowed")
-----------------------------------------------------------------------------
-- genPipeline
--
......@@ -161,29 +133,34 @@ genPipeline todo stop_flag persistent_output lang (filename,suffix)
let
----------- ----- ---- --- -- -- - - -
pipeline
| todo == DoMkDependHS = [ Unlit, Cpp, HsPp, MkDependHS ]
pipeline = preprocess ++ compile
preprocess
| haskellish = [ Unlit, Cpp, HsPp ]
| otherwise = [ ]
compile
| todo == DoMkDependHS = [ MkDependHS ]
| cish = [ Cc, As ]
| haskellish =
case real_lang of
HscC | split && mangle -> [ Unlit, Cpp, HsPp, Hsc, HCc, Mangle,
SplitMangle, SplitAs ]
| mangle -> [ Unlit, Cpp, HsPp, Hsc, HCc, Mangle, As ]
HscC | split && mangle -> [ Hsc, HCc, Mangle, SplitMangle, SplitAs ]
| mangle -> [ Hsc, HCc, Mangle, As ]
| split -> not_valid
| otherwise -> [ Unlit, Cpp, HsPp, Hsc, HCc, As ]
| otherwise -> [ Hsc, HCc, As ]
HscAsm | split -> [ Unlit, Cpp, HsPp, Hsc, SplitMangle, SplitAs ]
| otherwise -> [ Unlit, Cpp, HsPp, Hsc, As ]
HscAsm | split -> [ Hsc, SplitMangle, SplitAs ]
| otherwise -> [ Hsc, As ]
HscJava | split -> not_valid
| otherwise -> error "not implemented: compiling via Java"
#ifdef ILX
HscILX | split -> not_valid
| otherwise -> [ Unlit, Cpp, HsPp, Hsc, Ilx2Il, Ilasm ]
| otherwise -> [ Hsc, Ilx2Il, Ilasm ]
#endif
HscNothing -> [ Unlit, Cpp, HsPp, Hsc ]
| cish = [ Cc, As ]
HscNothing -> [ Hsc, HCc ] -- HCc is a dummy stop phase
| otherwise = [ ] -- just pass this file through to the linker
......@@ -212,8 +189,9 @@ genPipeline todo stop_flag persistent_output lang (filename,suffix)
when (start_phase `elem` pipeline &&
(stop_phase /= Ln && stop_phase `notElem` pipeline))
(throwDyn (UsageError
("flag " ++ stop_flag
++ " is incompatible with source file `" ++ filename ++ "'")))
("flag `" ++ stop_flag
++ "' is incompatible with source file `"
++ filename ++ "'" ++ show pipeline ++ show stop_phase)))
let
-- .o and .hc suffixes can be overriden by command-line options:
myPhaseInputExt Ln | Just s <- osuf = s
......@@ -635,12 +613,17 @@ run_phase cc_phase basename suff input_fn output_fn
pkg_extra_cc_opts <- getPackageExtraCcOpts
split_objs <- readIORef v_Split_object_files
let split_opt | hcc && split_objs = [ "-DUSE_SPLIT_MARKERS" ]
| otherwise = [ ]
excessPrecision <- readIORef v_Excess_precision
SysTools.runCc ([ SysTools.Option "-x", SysTools.Option "c"
, SysTools.FileOption "" input_fn
-- force the C compiler to interpret this file as C when
-- compiling .hc files, by adding the -x c option.
let langopt
| cc_phase == HCc = [ SysTools.Option "-x", SysTools.Option "c"]
| otherwise = [ ]
SysTools.runCc (langopt ++
[ SysTools.FileOption "" input_fn
, SysTools.Option "-o"
, SysTools.FileOption "" output_fn
]
......@@ -652,7 +635,6 @@ run_phase cc_phase basename suff input_fn output_fn
++ [ verb, "-S", "-Wimplicit", opt_flag ]
++ [ "-D__GLASGOW_HASKELL__="++cProjectVersionInt ]
++ cc_opts
++ split_opt
++ (if excessPrecision then [] else [ "-ffloat-store" ])
++ include_paths
++ pkg_extra_cc_opts
......
-----------------------------------------------------------------------------
-- $Id: DriverState.hs,v 1.65 2001/12/15 12:03:08 panne Exp $
-- $Id: DriverState.hs,v 1.66 2002/01/04 16:02:04 simonmar Exp $
--
-- Settings for the driver
--
-- (c) The University of Glasgow 2000
-- (c) The University of Glasgow 2002
--
-----------------------------------------------------------------------------
......@@ -46,7 +46,18 @@ data GhcMode
| DoLink -- [ the default ]
deriving (Eq)
GLOBAL_VAR(v_GhcMode, error "mode not set", GhcMode)
GLOBAL_VAR(v_GhcMode, DoLink, GhcMode)
GLOBAL_VAR(v_GhcModeFlag, "", String)
setMode :: GhcMode -> String -> IO ()
setMode m flag = do
old_mode <- readIORef v_GhcMode
old_flag <- readIORef v_GhcModeFlag
when (not (null (old_flag))) $
throwDyn (UsageError
("cannot use `" ++ old_flag ++ "' with `" ++ flag ++ "'"))
writeIORef v_GhcMode m
writeIORef v_GhcModeFlag flag
isCompManagerMode DoMake = True
isCompManagerMode DoInteractive = True
......@@ -146,13 +157,10 @@ osuf_ify f = do
GLOBAL_VAR(v_OptLevel, 0, Int)
setOptLevel :: String -> IO ()
setOptLevel "" = do { writeIORef v_OptLevel 1 }
setOptLevel "not" = writeIORef v_OptLevel 0
setOptLevel [c] | isDigit c = do
let level = ord c - ord '0'
writeIORef v_OptLevel level
setOptLevel s = unknownFlagErr ("-O"++s)
setOptLevel :: Int -> IO ()
setOptLevel n = do
when (n >= 1) $ setLang HscC -- turn on -fvia-C with -O
writeIORef v_OptLevel n
GLOBAL_VAR(v_minus_o2_for_C, False, Bool)
GLOBAL_VAR(v_MaxSimplifierIterations, 4, Int)
......
{-# OPTIONS -fno-warn-incomplete-patterns -optc-DNON_POSIX_SOURCE #-}
-----------------------------------------------------------------------------
-- $Id: Main.hs,v 1.93 2002/01/04 11:35:13 simonmar Exp $
-- $Id: Main.hs,v 1.94 2002/01/04 16:02:04 simonmar Exp $
--
-- GHC Driver program
--
-- (c) Simon Marlow 2000
-- (c) The University of Glasgow 2002
--
-----------------------------------------------------------------------------
......@@ -29,17 +29,16 @@ import Config ( cBooterVersion, cGhcUnregisterised, cProjectVersion )
import SysTools ( getPackageConfigPath, initSysTools, cleanTempFiles )
import Packages ( showPackages )
import DriverPipeline ( GhcMode(..), doLink, doMkDLL, genPipeline,
getGhcMode, pipeLoop, v_GhcMode
)
import DriverPipeline ( doLink, doMkDLL, genPipeline, pipeLoop )
import DriverState ( buildCoreToDo, buildStgToDo, defaultHscLang,
findBuildTag, getPackageInfo, unregFlags,
v_GhcMode, v_GhcModeFlag, GhcMode(..),
v_Cmdline_libraries, v_Keep_tmp_files, v_Ld_inputs,
v_OptLevel, v_Output_file, v_Output_hi,
v_Package_details, v_Ways, getPackageExtraGhcOpts,
readPackageConf
)
import DriverFlags ( dynFlag, getDynFlags, buildStaticHscOpts,
import DriverFlags ( buildStaticHscOpts,
dynamic_flags, processArgs, static_flags)
import DriverMkDepend ( beginMkDependHS, endMkDependHS )
......@@ -48,10 +47,9 @@ import DriverPhases ( Phase(HsPp, Hsc, HCc), haskellish_src_file, objish_file )
import DriverUtil ( add, handle, handleDyn, later, splitFilename,
unknownFlagErr, getFileSuffix )
import CmdLineOpts ( dynFlag, defaultDynFlags, restoreDynFlags,
saveDynFlags, setDynFlags,
saveDynFlags, setDynFlags, getDynFlags, dynFlag,
DynFlags(..), HscLang(..), v_Static_hsc_opts
)
import Outputable
import Util
import Panic ( GhcException(..), panic )
......@@ -79,13 +77,6 @@ import Posix ( Handler(Catch), installHandler, sigINT, sigQUIT )
import Dynamic ( toDyn )
#endif
-----------------------------------------------------------------------------
-- Changes:
-- * -fglasgow-exts NO LONGER IMPLIES -package lang!!! (-fglasgow-exts is a
-- dynamic flag whereas -package is a static flag.)
-----------------------------------------------------------------------------
-- ToDo:
......@@ -104,7 +95,6 @@ import Dynamic ( toDyn )
-- No more "Enter your Haskell program, end with ^D (on a line of its own):"
-- consistency checking removed (may do this properly later)
-- removed -noC
-- no -Ofile
-----------------------------------------------------------------------------
......@@ -158,12 +148,10 @@ main =
conf_file <- getPackageConfigPath
readPackageConf conf_file
-- find the phase to stop after (i.e. -E, -C, -c, -S flags)
(flags2, mode, stop_flag) <- getGhcMode argv'
writeIORef v_GhcMode mode
-- process all the other arguments, and get the source files
non_static <- processArgs static_flags flags2 []
non_static <- processArgs static_flags argv' []
mode <- readIORef v_GhcMode
stop_flag <- readIORef v_GhcModeFlag
-- -O and --interactive are not a good combination
-- ditto with any kind of way selection
......@@ -199,23 +187,18 @@ main =
-- set the "global" HscLang. The HscLang can be further adjusted on a module
-- by module basis, using only the -fvia-C and -fasm flags. If the global
-- HscLang is not HscC or HscAsm, -fvia-C and -fasm have no effect.
opt_level <- readIORef v_OptLevel
dyn_flags <- getDynFlags
let lang = case mode of
StopBefore HCc -> HscC
DoInteractive -> HscInterpreted
_other | opt_level >= 1 -> HscC -- -O implies -fvia-C
| otherwise -> defaultHscLang
setDynFlags (defaultDynFlags{ coreToDo = core_todo,
stgToDo = stg_todo,
hscLang = lang,
-- leave out hscOutName for now
hscOutName = panic "Main.main:hscOutName not set",
verbosity = 1
})
_other -> hscLang dyn_flags
setDynFlags (dyn_flags{ coreToDo = core_todo,
stgToDo = stg_todo,
hscLang = lang,
-- leave out hscOutName for now
hscOutName = panic "Main.main:hscOutName not set",
verbosity = 1
})
-- the rest of the arguments are "dynamic"
srcs <- processArgs dynamic_flags (extra_non_static ++ non_static) []
......
......@@ -16,7 +16,7 @@ module RnHiFiles (
#include "HsVersions.h"
import DriverState ( GhcMode(..), v_GhcMode )
import DriverState ( GhcMode(..), v_GhcMode, isCompManagerMode )
import DriverUtil ( splitFilename )
import CmdLineOpts ( opt_IgnoreIfacePragmas )
import HscTypes ( ModuleLocation(..),
......@@ -497,8 +497,7 @@ findAndReadIface doc_str mod_name hi_boot_file
-- and start up GHCi - it won't complain that all the modules it tries
-- to load are found in the home location.
ioToRnM_no_fail (readIORef v_GhcMode) `thenRn` \ mode ->
let home_allowed = hi_boot_file ||
mode `notElem` [ DoInteractive, DoMake ]
let home_allowed = hi_boot_file || not (isCompManagerMode mode)
in
ioToRnM (if home_allowed
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment