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 parseStaticFlags :: [Located String] -> IO ([Located String], [Located String])
32 parseStaticFlags args = do
33 ready <- readIORef v_opt_C_ready
34 when ready $ ghcError (ProgramError "Too late for parseStaticFlags: call it before newSession")
36 (leftover, errs, warns1) <- processArgs static_flags args
37 when (not (null errs)) $ ghcError $ errorsToGhcException errs
39 -- deal with the way flags: the way (eg. prof) gives rise to
40 -- further flags, some of which might be static.
41 way_flags <- findBuildTag
42 let way_flags' = map (mkGeneralLocated "in way flags") way_flags
44 -- if we're unregisterised, add some more flags
45 let unreg_flags | cGhcUnregisterised == "YES" = unregFlags
48 (more_leftover, errs, warns2) <- processArgs static_flags (unreg_flags ++ way_flags')
50 -- see sanity code in staticOpts
51 writeIORef v_opt_C_ready True
53 -- TABLES_NEXT_TO_CODE affects the info table layout.
54 -- Be careful to do this *after* all processArgs,
55 -- because evaluating tablesNextToCode involves looking at the global
56 -- static flags. Those pesky global variables...
57 let cg_flags | tablesNextToCode = map (mkGeneralLocated "in cg_flags")
58 ["-optc-DTABLES_NEXT_TO_CODE"]
61 -- HACK: -fexcess-precision is both a static and a dynamic flag. If
62 -- the static flag parser has slurped it, we must return it as a
63 -- leftover too. ToDo: make -fexcess-precision dynamic only.
65 | opt_SimplExcessPrecision = map (mkGeneralLocated "in excess_prec")
66 ["-fexcess-precision"]
69 when (not (null errs)) $ ghcError $ errorsToGhcException errs
70 return (excess_prec ++ cg_flags ++ more_leftover ++ leftover,
73 static_flags :: [Flag IO]
74 -- All the static flags should appear in this list. It describes how each
75 -- static flag should be processed. Two main purposes:
76 -- (a) if a command-line flag doesn't appear in the list, GHC can complain
77 -- (b) a command-line flag may remove, or add, other flags; e.g. the "-fno-X" things
79 -- The common (PassFlag addOpt) action puts the static flag into the bunch of
80 -- things that are searched up by the top-level definitions like
81 -- opt_foo = lookUp (fsLit "-dfoo")
83 -- Note that ordering is important in the following list: any flag which
84 -- is a prefix flag (i.e. HasArg, Prefix, OptPrefix, AnySuffix) will override
85 -- flags further down the list with the same prefix.
88 ------- GHCi -------------------------------------------------------
89 Flag "ignore-dot-ghci" (PassFlag addOpt) Supported
90 , Flag "read-dot-ghci" (NoArg (removeOpt "-ignore-dot-ghci")) Supported
92 ------- ways --------------------------------------------------------
93 , Flag "prof" (NoArg (addWay WayProf)) Supported
94 , Flag "ticky" (NoArg (addWay WayTicky)) Supported
95 , Flag "parallel" (NoArg (addWay WayPar)) Supported
96 , Flag "gransim" (NoArg (addWay WayGran)) Supported
97 , Flag "smp" (NoArg (addWay WayThreaded))
98 (Deprecated "Use -threaded instead")
99 , Flag "debug" (NoArg (addWay WayDebug)) Supported
100 , Flag "ndp" (NoArg (addWay WayNDP)) Supported
101 , Flag "threaded" (NoArg (addWay WayThreaded)) Supported
104 ------ Debugging ----------------------------------------------------
105 , Flag "dppr-debug" (PassFlag addOpt) Supported
106 , Flag "dsuppress-uniques" (PassFlag addOpt) Supported
107 , Flag "dppr-user-length" (AnySuffix addOpt) Supported
108 , Flag "dopt-fuel" (AnySuffix addOpt) Supported
109 , Flag "dno-debug-output" (PassFlag addOpt) Supported
110 -- rest of the debugging flags are dynamic
112 --------- Profiling --------------------------------------------------
113 , Flag "auto-all" (NoArg (addOpt "-fauto-sccs-on-all-toplevs"))
115 , Flag "auto" (NoArg (addOpt "-fauto-sccs-on-exported-toplevs"))
117 , Flag "caf-all" (NoArg (addOpt "-fauto-sccs-on-individual-cafs"))
119 -- "ignore-sccs" doesn't work (ToDo)
121 , Flag "no-auto-all" (NoArg (removeOpt "-fauto-sccs-on-all-toplevs"))
123 , Flag "no-auto" (NoArg (removeOpt "-fauto-sccs-on-exported-toplevs"))
125 , Flag "no-caf-all" (NoArg (removeOpt "-fauto-sccs-on-individual-cafs"))
128 ----- Linker --------------------------------------------------------
129 , Flag "static" (PassFlag addOpt) Supported
130 , Flag "dynamic" (NoArg (removeOpt "-static")) Supported
131 -- ignored for compat w/ gcc:
132 , Flag "rdynamic" (NoArg (return ())) Supported
134 ----- RTS opts ------------------------------------------------------
135 , Flag "H" (HasArg (setHeapSize . fromIntegral . decodeSize))
137 , Flag "Rghc-timing" (NoArg (enableTimingStats)) Supported
139 ------ Compiler flags -----------------------------------------------
140 -- All other "-fno-<blah>" options cancel out "-f<blah>" on the hsc cmdline
142 (PrefixPred (\s -> isStaticFlag ("f"++s)) (\s -> removeOpt ("-f"++s)))
145 -- Pass all remaining "-f<blah>" options to hsc
146 , Flag "f" (AnySuffixPred (isStaticFlag) addOpt)
150 isStaticFlag :: String -> Bool
153 "fauto-sccs-on-all-toplevs",
154 "fauto-sccs-on-exported-toplevs",
155 "fauto-sccs-on-individual-cafs",
158 "fspec-inline-join-points",
159 "firrefutable-tuples",
162 "fno-hi-version-check",
164 "fno-method-sharing",
166 "fno-ds-multi-tyvar",
171 "fhardwire-lib-paths",
179 || any (`isPrefixOf` f) [
180 "fliberate-case-threshold",
183 "funfolding-creation-threshold",
184 "funfolding-use-threshold",
185 "funfolding-fun-discount",
186 "funfolding-keeness-factor"
189 unregFlags :: [Located String]
190 unregFlags = map (mkGeneralLocated "in unregFlags")
192 , "-optc-DUSE_MINIINTERPRETER"
193 , "-fno-asm-mangling"
197 -----------------------------------------------------------------------------
198 -- convert sizes like "3.5M" into integers
200 decodeSize :: String -> Integer
202 | c == "" = truncate n
203 | c == "K" || c == "k" = truncate (n * 1000)
204 | c == "M" || c == "m" = truncate (n * 1000 * 1000)
205 | c == "G" || c == "g" = truncate (n * 1000 * 1000 * 1000)
206 | otherwise = ghcError (CmdLineError ("can't decode size: " ++ str))
207 where (m, c) = span pred str
209 pred c = isDigit c || c == '.'
211 -----------------------------------------------------------------------------
214 foreign import ccall unsafe "setHeapSize" setHeapSize :: Int -> IO ()
215 foreign import ccall unsafe "enableTimingStats" enableTimingStats :: IO ()