import CmLink
import CmTypes
import DriverPipeline
-import DriverFlags ( getDynFlags )
import DriverState ( v_Output_file )
import DriverPhases
import DriverUtil
import HscTypes
import Name ( Name, NamedThing(..), nameRdrName, nameModule,
isHomePackageName )
-import RdrName ( lookupRdrEnv, emptyRdrEnv )
+import RdrName ( emptyRdrEnv )
import Module
import GetImports
import UniqFM
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 )
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
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
--
module DriverFlags (
processArgs, OptKind(..), static_flags, dynamic_flags,
- getDynFlags, dynFlag,
- getOpts, getVerbFlag, addCmdlineHCInclude,
+ addCmdlineHCInclude,
buildStaticHscOpts,
machdepCCOpts
) where
#include "../includes/config.h"
import DriverState
+import DriverPhases
import DriverUtil
import SysTools
import CmdLineOpts
------- 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) )
------ 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) )
, ( "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) )
| 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})
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
--
-----------------------------------------------------------------------------
| 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.
--
-- GHC Driver
--
--- (c) Simon Marlow 2000
+-- (c) The University of Glasgow 2002
--
-----------------------------------------------------------------------------
module DriverPipeline (
-- interfaces for the batch-mode driver
- GhcMode(..), getGhcMode, v_GhcMode,
genPipeline, runPipeline, pipeLoop,
-- interfaces for the compilation manager (interpreted/batch-mode)
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
--
-- Herein is all the magic about which phases to run in which order, whether
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
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
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
]
++ [ 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
--
-----------------------------------------------------------------------------
| 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
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
--
-----------------------------------------------------------------------------
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 )
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 )
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:
-- 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
-----------------------------------------------------------------------------
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
-- 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) []
#include "HsVersions.h"
-import DriverState ( GhcMode(..), v_GhcMode )
+import DriverState ( GhcMode(..), v_GhcMode, isCompManagerMode )
import DriverUtil ( splitFilename )
import CmdLineOpts ( opt_IgnoreIfacePragmas )
import HscTypes ( ModuleLocation(..),
-- 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
projects / ghc-hetmet.git / commitdiff