1 -----------------------------------------------------------------------------
5 -- Static flags can only be set once, on the command-line. Inside GHC,
6 -- each static flag corresponds to a top-level value, usually of type Bool.
8 -- (c) The University of Glasgow 2005
10 -----------------------------------------------------------------------------
12 module StaticFlagParser (parseStaticFlags) where
14 #include "HsVersions.h"
28 -----------------------------------------------------------------------------
31 -- | Parses GHC's static flags from a list of command line arguments.
33 -- These flags are static in the sense that they can be set only once and they
34 -- are global, meaning that they affect every instance of GHC running;
35 -- multiple GHC threads will use the same flags.
37 -- This function must be called before any session is started, i.e., before
38 -- the first call to 'GHC.withGhc'.
40 -- Static flags are more of a hack and are static for more or less historical
41 -- reasons. In the long run, most static flags should eventually become
44 -- XXX: can we add an auto-generated list of static flags here?
46 parseStaticFlags :: [Located String] -> IO ([Located String], [Located String])
47 parseStaticFlags args = do
48 ready <- readIORef v_opt_C_ready
49 when ready $ ghcError (ProgramError "Too late for parseStaticFlags: call it before newSession")
51 (leftover, errs, warns1) <- processArgs static_flags args
52 when (not (null errs)) $ ghcError $ errorsToGhcException errs
54 -- deal with the way flags: the way (eg. prof) gives rise to
55 -- further flags, some of which might be static.
56 way_flags <- findBuildTag
57 let way_flags' = map (mkGeneralLocated "in way flags") way_flags
59 -- if we're unregisterised, add some more flags
60 let unreg_flags | cGhcUnregisterised == "YES" = unregFlags
63 (more_leftover, errs, warns2) <- processArgs static_flags (unreg_flags ++ way_flags')
65 -- see sanity code in staticOpts
66 writeIORef v_opt_C_ready True
68 -- TABLES_NEXT_TO_CODE affects the info table layout.
69 -- Be careful to do this *after* all processArgs,
70 -- because evaluating tablesNextToCode involves looking at the global
71 -- static flags. Those pesky global variables...
72 let cg_flags | tablesNextToCode = map (mkGeneralLocated "in cg_flags")
73 ["-optc-DTABLES_NEXT_TO_CODE"]
76 -- HACK: -fexcess-precision is both a static and a dynamic flag. If
77 -- the static flag parser has slurped it, we must return it as a
78 -- leftover too. ToDo: make -fexcess-precision dynamic only.
80 | opt_SimplExcessPrecision = map (mkGeneralLocated "in excess_prec")
81 ["-fexcess-precision"]
84 when (not (null errs)) $ ghcError $ errorsToGhcException errs
85 return (excess_prec ++ cg_flags ++ more_leftover ++ leftover,
88 static_flags :: [Flag IO]
89 -- All the static flags should appear in this list. It describes how each
90 -- static flag should be processed. Two main purposes:
91 -- (a) if a command-line flag doesn't appear in the list, GHC can complain
92 -- (b) a command-line flag may remove, or add, other flags; e.g. the "-fno-X" things
94 -- The common (PassFlag addOpt) action puts the static flag into the bunch of
95 -- things that are searched up by the top-level definitions like
96 -- opt_foo = lookUp (fsLit "-dfoo")
98 -- Note that ordering is important in the following list: any flag which
99 -- is a prefix flag (i.e. HasArg, Prefix, OptPrefix, AnySuffix) will override
100 -- flags further down the list with the same prefix.
103 ------- GHCi -------------------------------------------------------
104 Flag "ignore-dot-ghci" (PassFlag addOpt) Supported
105 , Flag "read-dot-ghci" (NoArg (removeOpt "-ignore-dot-ghci")) Supported
107 ------- ways --------------------------------------------------------
108 , Flag "prof" (NoArg (addWay WayProf)) Supported
109 , Flag "ticky" (NoArg (addWay WayTicky)) Supported
110 , Flag "parallel" (NoArg (addWay WayPar)) Supported
111 , Flag "gransim" (NoArg (addWay WayGran)) Supported
112 , Flag "smp" (NoArg (addWay WayThreaded))
113 (Deprecated "Use -threaded instead")
114 , Flag "debug" (NoArg (addWay WayDebug)) Supported
115 , Flag "ndp" (NoArg (addWay WayNDP)) Supported
116 , Flag "threaded" (NoArg (addWay WayThreaded)) Supported
119 ------ Debugging ----------------------------------------------------
120 , Flag "dppr-debug" (PassFlag addOpt) Supported
121 , Flag "dsuppress-uniques" (PassFlag addOpt) Supported
122 , Flag "dppr-user-length" (AnySuffix addOpt) Supported
123 , Flag "dopt-fuel" (AnySuffix addOpt) Supported
124 , Flag "dno-debug-output" (PassFlag addOpt) Supported
125 -- rest of the debugging flags are dynamic
127 --------- Profiling --------------------------------------------------
128 , Flag "auto-all" (NoArg (addOpt "-fauto-sccs-on-all-toplevs"))
130 , Flag "auto" (NoArg (addOpt "-fauto-sccs-on-exported-toplevs"))
132 , Flag "caf-all" (NoArg (addOpt "-fauto-sccs-on-individual-cafs"))
134 -- "ignore-sccs" doesn't work (ToDo)
136 , Flag "no-auto-all" (NoArg (removeOpt "-fauto-sccs-on-all-toplevs"))
138 , Flag "no-auto" (NoArg (removeOpt "-fauto-sccs-on-exported-toplevs"))
140 , Flag "no-caf-all" (NoArg (removeOpt "-fauto-sccs-on-individual-cafs"))
143 ----- Linker --------------------------------------------------------
144 , Flag "static" (PassFlag addOpt) Supported
145 , Flag "dynamic" (NoArg (removeOpt "-static")) Supported
146 -- ignored for compat w/ gcc:
147 , Flag "rdynamic" (NoArg (return ())) Supported
149 ----- RTS opts ------------------------------------------------------
150 , Flag "H" (HasArg (setHeapSize . fromIntegral . decodeSize))
152 , Flag "Rghc-timing" (NoArg (enableTimingStats)) Supported
154 ------ Compiler flags -----------------------------------------------
155 -- All other "-fno-<blah>" options cancel out "-f<blah>" on the hsc cmdline
157 (PrefixPred (\s -> isStaticFlag ("f"++s)) (\s -> removeOpt ("-f"++s)))
160 -- Pass all remaining "-f<blah>" options to hsc
161 , Flag "f" (AnySuffixPred (isStaticFlag) addOpt)
165 isStaticFlag :: String -> Bool
168 "fauto-sccs-on-all-toplevs",
169 "fauto-sccs-on-exported-toplevs",
170 "fauto-sccs-on-individual-cafs",
173 "fspec-inline-join-points",
174 "firrefutable-tuples",
177 "fno-hi-version-check",
180 "fno-ds-multi-tyvar",
185 "fhardwire-lib-paths",
193 || any (`isPrefixOf` f) [
194 "fliberate-case-threshold",
197 "funfolding-creation-threshold",
198 "funfolding-use-threshold",
199 "funfolding-fun-discount",
200 "funfolding-keeness-factor"
203 unregFlags :: [Located String]
204 unregFlags = map (mkGeneralLocated "in unregFlags")
206 , "-optc-DUSE_MINIINTERPRETER"
207 , "-fno-asm-mangling"
211 -----------------------------------------------------------------------------
212 -- convert sizes like "3.5M" into integers
214 decodeSize :: String -> Integer
216 | c == "" = truncate n
217 | c == "K" || c == "k" = truncate (n * 1000)
218 | c == "M" || c == "m" = truncate (n * 1000 * 1000)
219 | c == "G" || c == "g" = truncate (n * 1000 * 1000 * 1000)
220 | otherwise = ghcError (CmdLineError ("can't decode size: " ++ str))
221 where (m, c) = span pred str
223 pred c = isDigit c || c == '.'
225 -----------------------------------------------------------------------------
228 foreign import ccall unsafe "setHeapSize" setHeapSize :: Int -> IO ()
229 foreign import ccall unsafe "enableTimingStats" enableTimingStats :: IO ()