ghc: allow --show-options and --interactive together
[ghc.git] / compiler / main / StaticFlags.hs
1 {-# LANGUAGE CPP #-}
2 {-# OPTIONS_GHC -fno-cse #-}
3 -- -fno-cse is needed for GLOBAL_VAR's to behave properly
4
5 -----------------------------------------------------------------------------
6 --
7 -- Static flags
8 --
9 -- Static flags can only be set once, on the command-line. Inside GHC,
10 -- each static flag corresponds to a top-level value, usually of type Bool.
11 --
12 -- (c) The University of Glasgow 2005
13 --
14 -----------------------------------------------------------------------------
15
16 module StaticFlags (
17 -- entry point
18 parseStaticFlags,
19
20 staticFlags,
21 initStaticOpts,
22 discardStaticFlags,
23
24 -- Output style options
25 opt_PprStyle_Debug,
26 opt_NoDebugOutput,
27
28 -- optimisation opts
29 opt_NoStateHack,
30 opt_CprOff,
31 opt_NoOptCoercion,
32
33 -- For the parser
34 addOpt, removeOpt, v_opt_C_ready,
35
36 -- For options autocompletion
37 flagsStatic, flagsStaticNames
38 ) where
39
40 #include "HsVersions.h"
41
42 import CmdLineParser
43 import FastString
44 import SrcLoc
45 import Util
46 -- import Maybes ( firstJusts )
47 import Panic
48
49 import Control.Monad
50 import Data.IORef
51 import System.IO.Unsafe ( unsafePerformIO )
52
53
54 -----------------------------------------------------------------------------
55 -- Static flags
56
57 -- | Parses GHC's static flags from a list of command line arguments.
58 --
59 -- These flags are static in the sense that they can be set only once and they
60 -- are global, meaning that they affect every instance of GHC running;
61 -- multiple GHC threads will use the same flags.
62 --
63 -- This function must be called before any session is started, i.e., before
64 -- the first call to 'GHC.withGhc'.
65 --
66 -- Static flags are more of a hack and are static for more or less historical
67 -- reasons. In the long run, most static flags should eventually become
68 -- dynamic flags.
69 --
70 -- XXX: can we add an auto-generated list of static flags here?
71 --
72 parseStaticFlags :: [Located String] -> IO ([Located String], [Located String])
73 parseStaticFlags = parseStaticFlagsFull flagsStatic
74
75 -- | Parse GHC's static flags as @parseStaticFlags@ does. However it also
76 -- takes a list of available static flags, such that certain flags can be
77 -- enabled or disabled through this argument.
78 parseStaticFlagsFull :: [Flag IO] -> [Located String]
79 -> IO ([Located String], [Located String])
80 parseStaticFlagsFull flagsAvailable args = do
81 ready <- readIORef v_opt_C_ready
82 when ready $ throwGhcExceptionIO (ProgramError "Too late for parseStaticFlags: call it before runGhc or runGhcT")
83
84 (leftover, errs, warns) <- processArgs flagsAvailable args
85 when (not (null errs)) $ throwGhcExceptionIO $ errorsToGhcException errs
86
87 -- see sanity code in staticOpts
88 writeIORef v_opt_C_ready True
89 return (leftover, warns)
90
91 -- holds the static opts while they're being collected, before
92 -- being unsafely read by unpacked_static_opts below.
93 GLOBAL_VAR(v_opt_C, [], [String])
94 GLOBAL_VAR(v_opt_C_ready, False, Bool)
95
96
97 staticFlags :: [String]
98 staticFlags = unsafePerformIO $ do
99 ready <- readIORef v_opt_C_ready
100 if (not ready)
101 then panic "Static flags have not been initialised!\n Please call GHC.parseStaticFlags early enough."
102 else readIORef v_opt_C
103
104 -- All the static flags should appear in this list. It describes how each
105 -- static flag should be processed. Two main purposes:
106 -- (a) if a command-line flag doesn't appear in the list, GHC can complain
107 -- (b) a command-line flag may remove, or add, other flags; e.g. the "-fno-X"
108 -- things
109 --
110 -- The common (PassFlag addOpt) action puts the static flag into the bunch of
111 -- things that are searched up by the top-level definitions like
112 -- opt_foo = lookUp (fsLit "-dfoo")
113
114 -- Note that ordering is important in the following list: any flag which
115 -- is a prefix flag (i.e. HasArg, Prefix, OptPrefix, AnySuffix) will override
116 -- flags further down the list with the same prefix.
117
118 -- see Note [Updating flag description in the User's Guide] in DynFlags
119 flagsStatic :: [Flag IO]
120 flagsStatic = [
121 ------ Debugging ----------------------------------------------------
122 defFlag "dppr-debug" (PassFlag addOptEwM)
123 , defFlag "dno-debug-output" (PassFlag addOptEwM)
124 -- rest of the debugging flags are dynamic
125
126 ------ Compiler flags -----------------------------------------------
127 -- All other "-fno-<blah>" options cancel out "-f<blah>" on the hsc cmdline
128 , defFlag "fno-"
129 (PrefixPred (\s -> isStaticFlag ("f"++s)) (\s -> removeOptEwM ("-f"++s)))
130
131 -- Pass all remaining "-f<blah>" options to hsc
132 , defFlag "f" (AnySuffixPred isStaticFlag addOptEwM)
133 ]
134
135
136
137 isStaticFlag :: String -> Bool
138 isStaticFlag f = f `elem` flagsStaticNames
139
140
141 -- see Note [Updating flag description in the User's Guide] in DynFlags
142 flagsStaticNames :: [String]
143 flagsStaticNames = [
144 "fno-state-hack",
145 "fno-opt-coercion",
146 "fcpr-off"
147 ]
148
149 -- We specifically need to discard static flags for clients of the
150 -- GHC API, since they can't be safely reparsed or reinitialized. In general,
151 -- the existing flags do nothing other than control debugging and some low-level
152 -- optimizer phases, so for the most part this is OK.
153 --
154 -- See GHC issue #8276: http://ghc.haskell.org/trac/ghc/ticket/8276#comment:37
155 discardStaticFlags :: [String] -> [String]
156 discardStaticFlags = filter (\x -> x `notElem` flags)
157 where flags = [ "-fno-state-hack"
158 , "-fno-opt-coercion"
159 , "-fcpr-off"
160 , "-dppr-debug"
161 , "-dno-debug-output"
162 ]
163
164
165 initStaticOpts :: IO ()
166 initStaticOpts = writeIORef v_opt_C_ready True
167
168 addOpt :: String -> IO ()
169 addOpt = consIORef v_opt_C
170
171 removeOpt :: String -> IO ()
172 removeOpt f = do
173 fs <- readIORef v_opt_C
174 writeIORef v_opt_C $! filter (/= f) fs
175
176 type StaticP = EwM IO
177
178 addOptEwM :: String -> StaticP ()
179 addOptEwM = liftEwM . addOpt
180
181 removeOptEwM :: String -> StaticP ()
182 removeOptEwM = liftEwM . removeOpt
183
184 packed_static_opts :: [FastString]
185 packed_static_opts = map mkFastString staticFlags
186
187 lookUp :: FastString -> Bool
188 lookUp sw = sw `elem` packed_static_opts
189
190 -- debugging options
191
192 -- see Note [Updating flag description in the User's Guide] in DynFlags
193
194 opt_PprStyle_Debug :: Bool
195 opt_PprStyle_Debug = lookUp (fsLit "-dppr-debug")
196
197 opt_NoDebugOutput :: Bool
198 opt_NoDebugOutput = lookUp (fsLit "-dno-debug-output")
199
200 opt_NoStateHack :: Bool
201 opt_NoStateHack = lookUp (fsLit "-fno-state-hack")
202
203 -- Switch off CPR analysis in the new demand analyser
204 opt_CprOff :: Bool
205 opt_CprOff = lookUp (fsLit "-fcpr-off")
206
207 opt_NoOptCoercion :: Bool
208 opt_NoOptCoercion = lookUp (fsLit "-fno-opt-coercion")
209
210 {-
211 -- (lookup_str "foo") looks for the flag -foo=X or -fooX,
212 -- and returns the string X
213 lookup_str :: String -> Maybe String
214 lookup_str sw
215 = case firstJusts (map (stripPrefix sw) staticFlags) of
216 Just ('=' : str) -> Just str
217 Just str -> Just str
218 Nothing -> Nothing
219
220 lookup_def_int :: String -> Int -> Int
221 lookup_def_int sw def = case (lookup_str sw) of
222 Nothing -> def -- Use default
223 Just xx -> try_read sw xx
224
225 lookup_def_float :: String -> Float -> Float
226 lookup_def_float sw def = case (lookup_str sw) of
227 Nothing -> def -- Use default
228 Just xx -> try_read sw xx
229
230 try_read :: Read a => String -> String -> a
231 -- (try_read sw str) tries to read s; if it fails, it
232 -- bleats about flag sw
233 try_read sw str
234 = case reads str of
235 ((x,_):_) -> x -- Be forgiving: ignore trailing goop, and alternative parses
236 [] -> throwGhcException (UsageError ("Malformed argument " ++ str ++ " for flag " ++ sw))
237 -- ToDo: hack alert. We should really parse the arguments
238 -- and announce errors in a more civilised way.
239 -}
240