Commit a37ef0a9 authored by simonmar's avatar simonmar
Browse files

[project @ 2000-11-14 16:28:38 by simonmar]

Make -fvia-C and -fasm-XXX into dynamic flags.  The HscLang handling
is somewhat cleaned up.
parent 7507153e
-----------------------------------------------------------------------------
-- $Id: DriverFlags.hs,v 1.18 2000/11/13 16:16:05 sewardj Exp $
-- $Id: DriverFlags.hs,v 1.19 2000/11/14 16:28:38 simonmar Exp $
--
-- Driver flags
--
......@@ -128,8 +128,8 @@ arg_ok (Prefix _) rest arg = not (null rest)
arg_ok (PrefixPred p _) rest arg = not (null rest) && p rest
arg_ok (OptPrefix _) rest arg = True
arg_ok (PassFlag _) rest arg = null rest
arg_ok (AnySuffix _) rest arg = not (null rest)
arg_ok (AnySuffixPred p _) rest arg = not (null rest) && p arg
arg_ok (AnySuffix _) rest arg = True
arg_ok (AnySuffixPred p _) rest arg = p arg
-----------------------------------------------------------------------------
-- Static flags
......@@ -263,11 +263,6 @@ static_flags =
, ( "O2-for-C" , NoArg (writeIORef v_minus_o2_for_C True) )
, ( "O" , OptPrefix (setOptLevel) )
, ( "fasm" , OptPrefix (\_ -> writeIORef v_Hsc_Lang HscAsm) )
, ( "fvia-c" , NoArg (writeIORef v_Hsc_Lang HscC) )
, ( "fvia-C" , NoArg (writeIORef v_Hsc_Lang HscC) )
, ( "fno-asm-mangling" , NoArg (writeIORef v_Do_asm_mangling False) )
, ( "fmax-simplifier-iterations",
......@@ -307,6 +302,15 @@ unSetDynFlag f = do
dfs <- readIORef v_DynFlags
writeIORef v_DynFlags dfs{ flags = filter (/= f) (flags dfs) }
-- we can only change HscC to HscAsm and vice-versa with dynamic flags
-- (-fvia-C and -fasm).
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 }
_ -> return ()
dynamic_flags = [
( "cpp", NoArg (updateState (\s -> s{ cpp_flag = True })) )
......@@ -390,6 +394,11 @@ dynamic_flags = [
------ Compiler flags -----------------------------------------------
, ( "fasm" , AnySuffix (\_ -> setLang HscAsm) )
, ( "fvia-c" , NoArg (setLang HscC) )
, ( "fvia-C" , NoArg (setLang HscC) )
, ( "fglasgow-exts", NoArg (setDynFlag Opt_GlasgowExts) )
, ( "fno-implicit-prelude", NoArg (setDynFlag Opt_NoImplicitPrelude) )
......
-----------------------------------------------------------------------------
-- $Id: DriverPipeline.hs,v 1.23 2000/11/14 14:30:40 simonmar Exp $
-- $Id: DriverPipeline.hs,v 1.24 2000/11/14 16:28:38 simonmar Exp $
--
-- GHC Driver
--
......@@ -120,6 +120,7 @@ genPipeline
:: GhcMode -- when to stop
-> String -- "stop after" flag (for error messages)
-> Bool -- True => output is persistent
-> HscLang -- preferred output language for hsc
-> String -- original filename
-> IO [ -- list of phases to run for this file
(Phase,
......@@ -127,11 +128,10 @@ genPipeline
String) -- output file suffix
]
genPipeline todo stop_flag persistent_output filename
genPipeline todo stop_flag persistent_output lang filename
= do
split <- readIORef v_Split_object_files
mangle <- readIORef v_Do_asm_mangling
lang <- readIORef v_Hsc_Lang
keep_hc <- readIORef v_Keep_hc_files
keep_raw_s <- readIORef v_Keep_raw_s_files
keep_s <- readIORef v_Keep_s_files
......@@ -146,9 +146,9 @@ genPipeline todo stop_flag persistent_output filename
haskellish = haskellish_suffix suffix
cish = cish_suffix suffix
-- for a .hc file, or if the -C flag is given, we need to force lang to HscC
real_lang | suffix == "hc" = HscC
| otherwise = lang
-- for a .hc file we need to force lang to HscC
real_lang | start_phase == HCc = HscC
| otherwise = lang
let
----------- ----- ---- --- -- -- - - -
......@@ -719,7 +719,8 @@ doLink o_files = do
preprocess :: FilePath -> IO FilePath
preprocess filename =
ASSERT(haskellish_file filename)
do pipeline <- genPipeline (StopBefore Hsc) ("preprocess") False filename
do pipeline <- genPipeline (StopBefore Hsc) ("preprocess") False
defaultHscLang filename
runPipeline pipeline filename False{-no linking-} False{-no -o flag-}
......@@ -772,7 +773,7 @@ compile summary old_iface hst hit pcs = do
processArgs dynamic_flags opts []
dyn_flags <- readIORef v_DynFlags
hsc_lang <- readIORef v_Hsc_Lang
let hsc_lang = hscLang dyn_flags
output_fn <- case hsc_lang of
HscAsm -> newTempName (phaseInputExt As)
HscC -> newTempName (phaseInputExt HCc)
......@@ -812,7 +813,8 @@ compile summary old_iface hst hit pcs = do
Nothing -> panic "compile: no interpreted code"
-- we're in batch mode: finish the compilation pipeline.
_other -> do pipe <- genPipeline (StopBefore Ln) "" True output_fn
_other -> do pipe <- genPipeline (StopBefore Ln) "" True
hsc_lang output_fn
o_file <- runPipeline pipe output_fn False False
return [ DotO o_file ]
......@@ -853,7 +855,8 @@ dealWithStubs basename maybe_stub_h maybe_stub_c
])
-- compile the _stub.c file w/ gcc
pipeline <- genPipeline (StopBefore Ln) "" True stub_c
pipeline <- genPipeline (StopBefore Ln) "" True
defaultHscLang stub_c
stub_o <- runPipeline pipeline stub_c False{-no linking-}
False{-no -o option-}
......
-----------------------------------------------------------------------------
-- $Id: DriverState.hs,v 1.12 2000/11/09 12:54:09 simonmar Exp $
-- $Id: DriverState.hs,v 1.13 2000/11/14 16:28:38 simonmar Exp $
--
-- Settings for the driver
--
......@@ -154,12 +154,11 @@ can_split = prefixMatch "i386" cTARGETPLATFORM
-----------------------------------------------------------------------------
-- Compiler output options
GLOBAL_VAR(v_Hsc_Lang, if cGhcWithNativeCodeGen == "YES" &&
(prefixMatch "i386" cTARGETPLATFORM ||
prefixMatch "sparc" cTARGETPLATFORM)
then HscAsm
else HscC,
HscLang)
defaultHscLang
| cGhcWithNativeCodeGen == "YES" &&
(prefixMatch "i386" cTARGETPLATFORM ||
prefixMatch "sparc" cTARGETPLATFORM) = HscAsm
| otherwise = HscC
GLOBAL_VAR(v_Output_dir, Nothing, Maybe String)
GLOBAL_VAR(v_Object_suf, Nothing, Maybe String)
......@@ -232,23 +231,16 @@ GLOBAL_VAR(v_Warning_opt, W_default, WarningState)
GLOBAL_VAR(v_OptLevel, 0, Int)
setOptLevel :: String -> IO ()
setOptLevel "" = do { writeIORef v_OptLevel 1; go_via_C }
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
when (level >= 1) go_via_C
setOptLevel s = unknownFlagErr ("-O"++s)
go_via_C = do
l <- readIORef v_Hsc_Lang
case l of { HscAsm -> writeIORef v_Hsc_Lang HscC;
_other -> return () }
GLOBAL_VAR(v_minus_o2_for_C, False, Bool)
GLOBAL_VAR(v_MaxSimplifierIterations, 4, Int)
GLOBAL_VAR(v_StgStats, False, Bool)
GLOBAL_VAR(v_minus_o2_for_C, False, Bool)
GLOBAL_VAR(v_MaxSimplifierIterations, 4, Int)
GLOBAL_VAR(v_StgStats, False, Bool)
GLOBAL_VAR(v_UsageSPInf, False, Bool) -- Off by default
GLOBAL_VAR(v_Strictness, True, Bool)
GLOBAL_VAR(v_CPR, True, Bool)
......
{-# OPTIONS -W -fno-warn-incomplete-patterns #-}
-----------------------------------------------------------------------------
-- $Id: Main.hs,v 1.20 2000/11/13 12:43:20 sewardj Exp $
-- $Id: Main.hs,v 1.21 2000/11/14 16:28:38 simonmar Exp $
--
-- GHC Driver program
--
......@@ -157,10 +157,6 @@ main =
(flags2, mode, stop_flag) <- getGhcMode argv'
writeIORef v_GhcMode mode
-- force lang to "C" if the -C flag was given
case mode of StopBefore HCc -> writeIORef v_Hsc_Lang HscC
_ -> return ()
-- process all the other arguments, and get the source files
non_static <- processArgs static_flags flags2 []
......@@ -187,7 +183,16 @@ main =
core_todo <- buildCoreToDo
stg_todo <- buildStgToDo
lang <- readIORef v_Hsc_Lang
-- 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
let lang = case mode of
StopBefore HCc -> HscC
DoInteractive -> HscInterpreted
_other | opt_level >= 1 -> HscC -- -O implies -fvia-C
| otherwise -> defaultHscLang
writeIORef v_DynFlags
DynFlags{ coreToDo = core_todo,
stgToDo = stg_todo,
......@@ -222,11 +227,12 @@ main =
when (mode == DoMkDependHS) beginMkDependHS
-- make/interactive require invoking the compilation manager
if (mode == DoMake) then beginMake pkg_details srcs else do
if (mode == DoInteractive) then beginInteractive srcs else do
if (mode == DoMake) then beginMake pkg_details srcs else do
if (mode == DoInteractive) then beginInteractive pkg_details srcs else do
-- for each source file, find which phases to run
pipelines <- mapM (genPipeline mode stop_flag True) srcs
let lang = hscLang init_dyn_flags
pipelines <- mapM (genPipeline mode stop_flag True lang) srcs
let src_pipelines = zip srcs pipelines
-- sanity checking
......@@ -266,13 +272,33 @@ setTopDir args = do
beginMake :: PackageConfigInfo -> [String] -> IO ()
beginMake pkg_details mods
| null mods
= throwDyn (UsageError "no input files")
| not (null (tail mods))
= throwDyn (UsageError "only one module allowed with --make")
| otherwise
= do state <- cmInit pkg_details
cmLoadModule state (mkModuleName (head mods))
return ()
beginInteractive srcs = panic "`ghc --interactive' unimplemented"
= do case mods of
[] -> throwDyn (UsageError "no input files")
[mod] -> do state <- cmInit pkg_details
cmLoadModule state (mkModuleName mod)
return ()
_ -> throwDyn (UsageError "only one module allowed with --make")
beginInteractive pkg_details mods
= do case mods of
[] -> return ()
[mod] -> do state <- cmInit pkg_details
cmLoadModule state (mkModuleName mod)
return ()
_ -> throwDyn (UsageError
"only one module allowed with --interactive")
interactiveUI
interactiveUI :: IO ()
interactiveUI = do
hPutStr stdout ghciWelcomeMsg
throwDyn (OtherError "GHCi not implemented yet")
ghciWelcomeMsg = "\
\ _____ __ __ ____ ------------------------------------------------\n\
\(| || || (| |) GHCi: GHC Interactive, version 5.00 \n\
\|| __ ||___|| || () For Haskell 98. \n\
\|| |) ||---|| || // http://www.haskell.org/ghc \n\
\|| || || || || // Bug reports to: glasgow-haskell-bugs@haskell.org\n\
\(|___|| || || (|__|) (| ________________________________________________\n"
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