From a37ef0a9233735fffa72a4ccccf6345198623a21 Mon Sep 17 00:00:00 2001 From: simonmar Date: Tue, 14 Nov 2000 16:28:38 +0000 Subject: [PATCH] [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. --- ghc/compiler/main/DriverFlags.hs | 25 +++++++++----- ghc/compiler/main/DriverPipeline.hs | 23 +++++++------ ghc/compiler/main/DriverState.hs | 28 ++++++--------- ghc/compiler/main/Main.hs | 64 ++++++++++++++++++++++++----------- 4 files changed, 85 insertions(+), 55 deletions(-) diff --git a/ghc/compiler/main/DriverFlags.hs b/ghc/compiler/main/DriverFlags.hs index 50e516c..5b2dc2d 100644 --- a/ghc/compiler/main/DriverFlags.hs +++ b/ghc/compiler/main/DriverFlags.hs @@ -1,5 +1,5 @@ ----------------------------------------------------------------------------- --- $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) ) diff --git a/ghc/compiler/main/DriverPipeline.hs b/ghc/compiler/main/DriverPipeline.hs index f761b9d..5eb5e0d 100644 --- a/ghc/compiler/main/DriverPipeline.hs +++ b/ghc/compiler/main/DriverPipeline.hs @@ -1,5 +1,5 @@ ----------------------------------------------------------------------------- --- $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-} diff --git a/ghc/compiler/main/DriverState.hs b/ghc/compiler/main/DriverState.hs index 9c297a8..d6ee6d0 100644 --- a/ghc/compiler/main/DriverState.hs +++ b/ghc/compiler/main/DriverState.hs @@ -1,5 +1,5 @@ ----------------------------------------------------------------------------- --- $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) diff --git a/ghc/compiler/main/Main.hs b/ghc/compiler/main/Main.hs index 83c8ea6..dbbb12f 100644 --- a/ghc/compiler/main/Main.hs +++ b/ghc/compiler/main/Main.hs @@ -1,6 +1,6 @@ {-# 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" + -- 1.7.10.4