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