[project @ 2002-02-11 08:20:38 by chak]
[ghc-hetmet.git] / ghc / compiler / main / DriverFlags.hs
index b696abe..bfb3c00 100644 (file)
@@ -1,7 +1,7 @@
 {-# OPTIONS -#include "hschooks.h" #-}
 
 -----------------------------------------------------------------------------
--- $Id: DriverFlags.hs,v 1.72 2001/09/25 18:08:47 ken Exp $
+-- $Id: DriverFlags.hs,v 1.86 2002/02/11 08:20:41 chak Exp $
 --
 -- Driver flags
 --
@@ -11,8 +11,7 @@
 
 module DriverFlags ( 
        processArgs, OptKind(..), static_flags, dynamic_flags, 
-       getDynFlags, dynFlag, 
-       getOpts, getVerbFlag, addCmdlineHCInclude,
+       addCmdlineHCInclude,
        buildStaticHscOpts, 
        machdepCCOpts
   ) where
@@ -21,8 +20,9 @@ module DriverFlags (
 #include "../includes/config.h"
 
 import DriverState
+import DriverPhases
 import DriverUtil
-import SysTools                ( setTmpDir, setPgm, setDryRun, showGhcUsage )
+import SysTools
 import CmdLineOpts
 import Config
 import Util
@@ -152,21 +152,36 @@ arg_ok (AnySuffixPred p _)  rest arg = p arg
 -- flags further down the list with the same prefix.
 
 static_flags = 
-  [  ------- help -------------------------------------------------------
-     ( "?"             , NoArg showGhcUsage)
-  ,  ( "-help"         , NoArg showGhcUsage)
-  
-
-      ------- version ----------------------------------------------------
-  ,  ( "-version"       , NoArg (do hPutStrLn stdout (cProjectName
+  [  ------- help / version ----------------------------------------------
+     ( "?"              , NoArg showGhcUsage)
+  ,  ( "-help"          , NoArg showGhcUsage)
+  ,  ( "-print-libdir"   , NoArg (do getTopDir >>= putStrLn
+                                    exitWith ExitSuccess))  
+  ,  ( "-version"       , NoArg (do putStrLn (cProjectName
                                      ++ ", version " ++ cProjectVersion)
                                     exitWith ExitSuccess))
-  ,  ( "-numeric-version", NoArg (do hPutStrLn stdout cProjectVersion
+  ,  ( "-numeric-version", NoArg (do putStrLn cProjectVersion
                                     exitWith ExitSuccess))
 
       ------- verbosity ----------------------------------------------------
   ,  ( "n"              , NoArg setDryRun )
 
+      ------- primary modes ------------------------------------------------
+  ,  ( "M"             , PassFlag (setMode DoMkDependHS))
+  ,  ( "E"             , PassFlag (setMode (StopBefore Hsc)))
+  ,  ( "C"             , PassFlag (\f -> do setMode (StopBefore HCc) f
+                                            setLang HscC))
+  ,  ( "S"             , PassFlag (setMode (StopBefore As)))
+  ,  ( "c"             , PassFlag (setMode (StopBefore Ln)))
+  ,  ( "-make"         , PassFlag (setMode DoMake))
+  ,  ( "-interactive"  , PassFlag (setMode DoInteractive))
+  ,  ( "-mk-dll"       , PassFlag (setMode DoMkDLL))
+
+       -- -fno-code says to stop after Hsc but don't generate any code.
+  ,  ( "fno-code"      , PassFlag (\f -> do setMode (StopBefore HCc) f
+                                            setLang HscNothing
+                                            writeIORef v_Recomp False))
+
        ------- GHCi -------------------------------------------------------
   ,  ( "ignore-dot-ghci", NoArg (writeIORef v_Read_DotGHCi False) )
   ,  ( "read-dot-ghci"  , NoArg (writeIORef v_Read_DotGHCi True) )
@@ -183,6 +198,7 @@ static_flags =
   ,  ( "gransim"       , NoArg (addNoDups v_Ways       WayGran) )
   ,  ( "smp"           , NoArg (addNoDups v_Ways       WaySMP) )
   ,  ( "debug"         , NoArg (addNoDups v_Ways       WayDebug) )
+  ,  ( "ndp"           , NoArg (addNoDups v_Ways       WayNDP) )
        -- ToDo: user ways
 
        ------ Debugging ----------------------------------------------------
@@ -222,6 +238,10 @@ static_flags =
   ,  ( "keep-hc-file"   , AnySuffix (\_ -> writeIORef v_Keep_hc_files True) )
   ,  ( "keep-s-file"    , AnySuffix (\_ -> writeIORef v_Keep_s_files  True) )
   ,  ( "keep-raw-s-file", AnySuffix (\_ -> writeIORef v_Keep_raw_s_files  True) )
+#ifdef ILX
+  ,  ( "keep-il-file"   , AnySuffix (\_ -> writeIORef v_Keep_il_files True) )
+  ,  ( "keep-ilx-file"  , AnySuffix (\_ -> writeIORef v_Keep_ilx_files True) )
+#endif
   ,  ( "keep-tmp-files" , AnySuffix (\_ -> writeIORef v_Keep_tmp_files True) )
 
   ,  ( "split-objs"    , NoArg (if can_split
@@ -265,7 +285,9 @@ static_flags =
 
         ------ Compiler flags -----------------------------------------------
   ,  ( "O2-for-C"         , NoArg (writeIORef v_minus_o2_for_C True) )
-  ,  ( "O"                , OptPrefix (setOptLevel) )
+  ,  ( "O"                , NoArg (setOptLevel 1))
+  ,  ( "Onot"             , NoArg (setOptLevel 0))
+  ,  ( "O"                , PrefixPred (all isDigit) (setOptLevel . read))
 
   ,  ( "fno-asm-mangling"  , NoArg (writeIORef v_Do_asm_mangling False) )
 
@@ -285,7 +307,9 @@ static_flags =
        -- -fno-* pattern below doesn't work.  We therefore allow
        -- certain optimisation passes to be turned off explicitly:
   ,  ( "fno-strictness"           , NoArg (writeIORef v_Strictness False) )
+#ifdef DEBUG
   ,  ( "fno-cpr"          , NoArg (writeIORef v_CPR False) )
+#endif
   ,  ( "fno-cse"          , NoArg (writeIORef v_CSE False) )
 
        -- All other "-fno-<blah>" options cancel out "-f<blah>" on the hsc cmdline
@@ -299,12 +323,14 @@ static_flags =
 dynamic_flags = [
 
      ( "cpp",          NoArg  (updDynFlags (\s -> s{ cppFlag = True })) )
+  ,  ( "F",             NoArg  (updDynFlags (\s -> s{ ppFlag = True })) )
   ,  ( "#include",     HasArg (addCmdlineHCInclude) )
 
   ,  ( "v",            OptPrefix (setVerbosity) )
 
   ,  ( "optL",         HasArg (addOpt_L) )
   ,  ( "optP",         HasArg (addOpt_P) )
+  ,  ( "optF",          HasArg (addOpt_F) )
   ,  ( "optc",         HasArg (addOpt_c) )
   ,  ( "optm",         HasArg (addOpt_m) )
   ,  ( "opta",         HasArg (addOpt_a) )
@@ -346,7 +372,7 @@ dynamic_flags = [
   ,  ( "ddump-simpl",           NoArg (setDynFlag Opt_D_dump_simpl) )
   ,  ( "ddump-simpl-iterations", NoArg (setDynFlag Opt_D_dump_simpl_iterations) )
   ,  ( "ddump-spec",            NoArg (setDynFlag Opt_D_dump_spec) )
-  ,  ( "ddump-sat",             NoArg (setDynFlag Opt_D_dump_sat) )
+  ,  ( "ddump-prep",            NoArg (setDynFlag Opt_D_dump_prep) )
   ,  ( "ddump-stg",             NoArg (setDynFlag Opt_D_dump_stg) )
   ,  ( "ddump-stranal",         NoArg (setDynFlag Opt_D_dump_stranal) )
   ,  ( "ddump-tc",              NoArg (setDynFlag Opt_D_dump_tc) )
@@ -368,6 +394,7 @@ dynamic_flags = [
   ,  ( "ddump-hi-diffs",         NoArg (setDynFlag Opt_D_dump_hi_diffs) )
   ,  ( "ddump-hi",               NoArg (setDynFlag Opt_D_dump_hi) )
   ,  ( "ddump-minimal-imports",  NoArg (setDynFlag Opt_D_dump_minimal_imports) )
+  ,  ( "ddump-vect",            NoArg (setDynFlag Opt_D_dump_vect) )
   ,  ( "dcore-lint",            NoArg (setDynFlag Opt_DoCoreLinting) )
   ,  ( "dstg-lint",             NoArg (setDynFlag Opt_DoStgLinting) )
   ,  ( "dusagesp-lint",                 NoArg (setDynFlag Opt_DoUSPLinting) )
@@ -390,10 +417,11 @@ dynamic_flags = [
   ,  ( "fvia-c",       NoArg (setLang HscC) )
   ,  ( "fvia-C",       NoArg (setLang HscC) )
   ,  ( "filx",         NoArg (setLang HscILX) )
-  ,  ( "fno-code",      NoArg (setLang HscNothing) )
 
        -- "active negatives"
   ,  ( "fno-implicit-prelude",  NoArg (setDynFlag Opt_NoImplicitPrelude) )
+  ,  ( "fno-monomorphism-restriction", 
+                       NoArg (setDynFlag Opt_NoMonomorphismRestriction) )
 
        -- the rest of the -f* and -fno-* flags
   ,  ( "fno-",                 PrefixPred (\f -> isFFlag f) (\f -> unSetDynFlag (getFFlag f)) )
@@ -418,8 +446,10 @@ fFlags = [
   ( "warn-unused-matches",             Opt_WarnUnusedMatches ),
   ( "warn-deprecations",               Opt_WarnDeprecations ),
   ( "glasgow-exts",                    Opt_GlasgowExts ),
+  ( "parr",                            Opt_PArr ),
   ( "allow-overlapping-instances",     Opt_AllowOverlappingInstances ),
   ( "allow-undecidable-instances",     Opt_AllowUndecidableInstances ),
+  ( "allow-incoherent-instances",      Opt_AllowIncoherentInstances ),
   ( "generics",                        Opt_Generics )
   ]
 
@@ -462,7 +492,8 @@ buildStaticHscOpts = do
            0 -> hsc_minusNoO_flags
            1 -> hsc_minusO_flags
            2 -> hsc_minusO2_flags
-           _ -> error "unknown opt level"
+           n -> throwDyn (CmdLineError ("unknown optimisation level: "
+                                         ++ show n))
            -- ToDo: -Ofile
  
        -- take into account -fno-* flags by removing the equivalent -f*
@@ -485,7 +516,7 @@ buildStaticHscOpts = do
 
 machdepCCOpts 
    | prefixMatch "alpha"   cTARGETPLATFORM  
-       = return ( ["-static", "-w"], ["-mieee"] )
+       = return ( ["-static", "-w", "-mieee"], [] )
        -- For now, to suppress the gcc warning "call-clobbered
        -- register used for global register variable", we simply
        -- disable all warnings altogether using the -w flag. Oh well.
@@ -529,16 +560,21 @@ machdepCCOpts
        -- register used for global register variable", we simply
        -- disable all warnings altogether using the -w flag. Oh well.
 
+   | prefixMatch "powerpc-apple-darwin" cTARGETPLATFORM
+       = return ( ["-no-cpp-precomp"], [""] )
+
    | prefixMatch "powerpc" cTARGETPLATFORM || prefixMatch "rs6000" cTARGETPLATFORM
        = return ( ["-static"], ["-finhibit-size-directive"] )
 
    | otherwise
        = return ( [], [] )
 
-
+-----------------------------------------------------------------------------
+-- local utils
 
 addOpt_L a = updDynFlags (\s -> s{opt_L = a : opt_L s})
 addOpt_P a = updDynFlags (\s -> s{opt_P = a : opt_P s})
+addOpt_F a = updDynFlags (\s -> s{opt_F = a : opt_F s})
 addOpt_c a = updDynFlags (\s -> s{opt_c = a : opt_c s})
 addOpt_a a = updDynFlags (\s -> s{opt_a = a : opt_a s})
 addOpt_m a = updDynFlags (\s -> s{opt_m = a : opt_m s})
@@ -547,25 +583,9 @@ addOpt_I a = updDynFlags (\s -> s{opt_I = a : opt_I s})
 addOpt_i a = updDynFlags (\s -> s{opt_i = a : opt_i s})
 #endif
 
-addCmdlineHCInclude a = updDynFlags (\s -> s{cmdlineHcIncludes =  a : cmdlineHcIncludes s})
-
-getOpts :: (DynFlags -> [a]) -> IO [a]
-       -- We add to the options from the front, so we need to reverse the list
-getOpts opts = dynFlag opts >>= return . reverse
-
--- we can only change HscC to HscAsm and vice-versa with dynamic flags 
--- (-fvia-C and -fasm). We can also set the new lang to ILX, via -filx.
-setLang l = updDynFlags (\ dfs -> case hscLang dfs of
-                                       HscC   -> dfs{ hscLang = l }
-                                       HscAsm -> dfs{ hscLang = l }
-                                       HscILX -> dfs{ hscLang = l }
-                                       _      -> dfs)
-
 setVerbosity "" = updDynFlags (\dfs -> dfs{ verbosity = 3 })
 setVerbosity n 
   | all isDigit n = updDynFlags (\dfs -> dfs{ verbosity = read n })
   | otherwise     = throwDyn (UsageError "can't parse verbosity flag (-v<n>)")
 
-getVerbFlag = do
-   verb <- dynFlag verbosity
-   if verb >= 3  then return  "-v" else return ""
+addCmdlineHCInclude a = updDynFlags (\s -> s{cmdlineHcIncludes =  a : cmdlineHcIncludes s})