{-# OPTIONS -#include "hschooks.h" #-}
-----------------------------------------------------------------------------
--- $Id: DriverFlags.hs,v 1.42 2001/01/30 10:52:14 simonmar Exp $
+-- $Id: DriverFlags.hs,v 1.53 2001/05/09 09:38:18 simonmar Exp $
--
-- Driver flags
--
#include "HsVersions.h"
-import PackageMaintenance
import DriverState
import DriverUtil
-import TmpFiles ( v_TmpDir )
+import TmpFiles ( v_TmpDir, kludgedSystem )
import CmdLineOpts
import Config
import Util
, ( "dppr-user-length", AnySuffix (add v_Opt_C) )
-- rest of the debugging flags are dynamic
- ------- Interface files ---------------------------------------------
- , ( "hi" , NoArg (writeIORef v_ProduceHi True) )
- , ( "nohi" , NoArg (writeIORef v_ProduceHi False) )
-
--------- Profiling --------------------------------------------------
, ( "auto-dicts" , NoArg (add v_Opt_C "-fauto-sccs-on-dicts") )
, ( "auto-all" , NoArg (add v_Opt_C "-fauto-sccs-on-all-toplevs") )
, ( "odir" , HasArg (writeIORef v_Output_dir . Just) )
, ( "o" , SepArg (writeIORef v_Output_file . Just) )
, ( "osuf" , HasArg (writeIORef v_Object_suf . Just) )
+ , ( "hcsuf" , HasArg (writeIORef v_HC_suf . Just) )
, ( "hisuf" , HasArg (writeIORef v_Hi_suf) )
, ( "tmpdir" , HasArg (writeIORef v_TmpDir . (++ "/")) )
- , ( "ohi" , HasArg (\s -> case s of
- "-" -> writeIORef v_Hi_on_stdout True
- _ -> writeIORef v_Output_hi (Just s)) )
+ , ( "ohi" , HasArg (writeIORef v_Output_hi . Just) )
-- -odump?
, ( "keep-hc-file" , AnySuffix (\_ -> writeIORef v_Keep_hc_files True) )
, ( "package" , HasArg (addPackage) )
, ( "syslib" , HasArg (addPackage) ) -- for compatibility w/ old vsns
- , ( "-list-packages" , NoArg (listPackages) )
- , ( "-add-package" , NoArg (newPackage) )
- , ( "-delete-package" , SepArg (deletePackage) )
-
------- Specific phases --------------------------------------------
, ( "pgmL" , HasArg (writeIORef v_Pgm_L) )
, ( "pgmP" , HasArg (writeIORef v_Pgm_P) )
, ( "optl" , HasArg (add v_Opt_l) )
, ( "optdll" , HasArg (add v_Opt_dll) )
- ------ Warning opts -------------------------------------------------
- , ( "W" , NoArg (writeIORef v_Warning_opt W_) )
- , ( "Wall" , NoArg (writeIORef v_Warning_opt W_all) )
- , ( "Wnot" , NoArg (writeIORef v_Warning_opt W_not) )
- , ( "w" , NoArg (writeIORef v_Warning_opt W_not) )
-
----- Linker --------------------------------------------------------
, ( "static" , NoArg (writeIORef v_Static True) )
, ( "dynamic" , NoArg (writeIORef v_Static False) )
dynFlag :: (DynFlags -> a) -> IO a
dynFlag f = do dflags <- readIORef v_DynFlags; return (f dflags)
-setDynFlag f = updDynFlags (\dfs -> dfs{ flags = f : flags dfs })
-unSetDynFlag f = updDynFlags (\dfs -> dfs{ flags = filter (/= f) (flags dfs) })
+setDynFlag f = updDynFlags (\dfs -> dopt_set dfs f)
+unSetDynFlag f = updDynFlags (\dfs -> dopt_unset dfs f)
addOpt_L a = updDynFlags (\s -> s{opt_L = a : opt_L s})
addOpt_P a = updDynFlags (\s -> s{opt_P = a : opt_P s})
-- we can only change HscC to HscAsm and vice-versa with dynamic flags
-- (-fvia-C and -fasm).
+-- NB: we can also set the new lang to ILX, via -filx. I hope this is right
setLang l = do
dfs <- readIORef v_DynFlags
case hscLang dfs of
setVerbosity "" = updDynFlags (\dfs -> dfs{ verbosity = 3 })
setVerbosity n
| all isDigit n = updDynFlags (\dfs -> dfs{ verbosity = read n })
- | otherwise = throwDyn (OtherError "can't parse verbosity flag (-v<n>)")
+ | otherwise = throwDyn (UsageError "can't parse verbosity flag (-v<n>)")
getVerbFlag = do
verb <- dynFlag verbosity
, ( "ddump-worker-wrapper", NoArg (setDynFlag Opt_D_dump_worker_wrapper) )
, ( "dshow-passes", NoArg (setVerbosity "2") )
, ( "ddump-rn-trace", NoArg (setDynFlag Opt_D_dump_rn_trace) )
+ , ( "ddump-tc-trace", NoArg (setDynFlag Opt_D_dump_tc_trace) )
, ( "ddump-rn-stats", NoArg (setDynFlag Opt_D_dump_rn_stats) )
, ( "ddump-stix", NoArg (setDynFlag Opt_D_dump_stix) )
, ( "ddump-simpl-stats", NoArg (setDynFlag Opt_D_dump_simpl_stats) )
, ( "monly-3-regs", NoArg (updDynFlags (\s -> s{stolen_x86_regs = 3}) ))
, ( "monly-4-regs", NoArg (updDynFlags (\s -> s{stolen_x86_regs = 4}) ))
+ ------ Warning opts -------------------------------------------------
+ , ( "W" , NoArg (mapM_ setDynFlag minusWOpts) )
+ , ( "Wall" , NoArg (mapM_ setDynFlag minusWallOpts) )
+ , ( "Wnot" , NoArg (mapM_ unSetDynFlag minusWallOpts) ) /* DEPREC */
+ , ( "w" , NoArg (mapM_ unSetDynFlag minusWallOpts) )
+
------ Compiler flags -----------------------------------------------
, ( "fasm", AnySuffix (\_ -> setLang HscAsm) )
, ( "fvia-c", NoArg (setLang HscC) )
, ( "fvia-C", NoArg (setLang HscC) )
+#ifdef ILX
+ , ( "filx", NoArg (setLang HscILX) )
+#endif
-- "active negatives"
, ( "fno-implicit-prelude", NoArg (setDynFlag Opt_NoImplicitPrelude) )
( "glasgow-exts", Opt_GlasgowExts ),
( "allow-overlapping-instances", Opt_AllowOverlappingInstances ),
( "allow-undecidable-instances", Opt_AllowUndecidableInstances ),
- ( "fgenerics", Opt_Generics ),
- ( "report-compile", Opt_ReportCompile )
+ ( "generics", Opt_Generics )
]
isFFlag f = f `elem` (map fst fFlags)
| c == "K" || c == "k" = truncate (n * 1000)
| c == "M" || c == "m" = truncate (n * 1000 * 1000)
| c == "G" || c == "g" = truncate (n * 1000 * 1000 * 1000)
- | otherwise = throwDyn (OtherError ("can't decode size: " ++ str))
+ | otherwise = throwDyn (CmdLineError ("can't decode size: " ++ str))
where (m, c) = span pred str
n = read m :: Double
pred c = isDigit c || c == '.'
= do n_regs <- dynFlag stolen_x86_regs
sta <- readIORef v_Static
return ( [ if sta then "-DDONT_WANT_WIN32_DLL_SUPPORT" else "",
- if suffixMatch "mingw32" cTARGETPLATFORM then "-mno-cygwin" else "" ],
+ if suffixMatch "mingw32" cTARGETPLATFORM then "-mno-cygwin -mwin32" else "" ],
[ "-fno-defer-pop", "-fomit-frame-pointer",
"-DSTOLEN_X86_REGS="++show n_regs ]
)
projects / ghc-hetmet.git / blobdiff