-----------------------------------------------------------------------------
--- $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
--
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
, ( "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",
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 })) )
------ 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
--
:: 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,
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
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
----------- ----- ---- --- -- -- - - -
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-}
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)
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 ]
])
-- 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
--
-----------------------------------------------------------------------------
-- 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)
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
--
(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 []
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,
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
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"
+
projects / ghc-hetmet.git / commitdiff