[project @ 2002-06-12 22:04:25 by wolfgang]
[ghc-hetmet.git] / ghc / compiler / main / DriverFlags.hs
index 333b230..e0196f2 100644 (file)
@@ -1,7 +1,5 @@
-{-# OPTIONS -#include "hschooks.h" #-}
-
 -----------------------------------------------------------------------------
--- $Id: DriverFlags.hs,v 1.69 2001/09/06 15:43:35 simonpj Exp $
+-- $Id: DriverFlags.hs,v 1.97 2002/06/12 22:04:26 wolfgang Exp $
 --
 -- Driver flags
 --
@@ -11,8 +9,7 @@
 
 module DriverFlags ( 
        processArgs, OptKind(..), static_flags, dynamic_flags, 
-       getDynFlags, dynFlag, 
-       getOpts, getVerbFlag, addCmdlineHCInclude,
+       addCmdlineHCInclude,
        buildStaticHscOpts, 
        machdepCCOpts
   ) where
@@ -20,9 +17,11 @@ module DriverFlags (
 #include "HsVersions.h"
 #include "../includes/config.h"
 
+import MkIface         ( showIface )
 import DriverState
+import DriverPhases
 import DriverUtil
-import SysTools                ( setTmpDir, setPgm, setDryRun, showGhcUsage )
+import SysTools
 import CmdLineOpts
 import Config
 import Util
@@ -137,8 +136,8 @@ findArg spec arg
 arg_ok (NoArg _)            rest arg = null rest
 arg_ok (HasArg _)           rest arg = True
 arg_ok (SepArg _)           rest arg = null rest
-arg_ok (Prefix _)          rest arg = not (null rest)
-arg_ok (PrefixPred p _)     rest arg = not (null rest) && p rest
+arg_ok (Prefix _)          rest arg = notNull rest
+arg_ok (PrefixPred p _)     rest arg = notNull rest && p rest
 arg_ok (OptPrefix _)       rest arg = True
 arg_ok (PassFlag _)         rest arg = null rest 
 arg_ok (AnySuffix _)        rest arg = True
@@ -152,21 +151,40 @@ 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))
 
+      ------- interfaces ----------------------------------------------------
+  ,  ( "-show-iface"     , HasArg (\f -> do showIface f
+                                           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 +201,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 +241,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
@@ -240,6 +263,12 @@ static_flags =
   ,  ( "L"             , Prefix (addToDirList v_Library_paths) )
   ,  ( "l"             , Prefix (add v_Cmdline_libraries) )
 
+#ifdef darwin_TARGET_OS
+       ------- Frameworks --------------------------------------------------
+        -- -framework-path should really be -F ...
+  ,  ( "framework-path" , HasArg (addToDirList v_Framework_paths) )
+  ,  ( "framework"     , HasArg (add v_Cmdline_frameworks) )
+#endif
         ------- Packages ----------------------------------------------------
   ,  ( "package-name"   , HasArg (\s -> add v_Opt_C ("-inpackage="++s)) )
 
@@ -248,7 +277,17 @@ static_flags =
   ,  ( "syslib"         , HasArg (addPackage) )        -- for compatibility w/ old vsns
 
         ------- Specific phases  --------------------------------------------
-  ,  ( "pgm"           , HasArg setPgm )
+  ,  ( "pgmP"           , HasArg setPgmP )
+  ,  ( "pgmF"           , HasArg setPgmF )
+  ,  ( "pgmc"           , HasArg setPgmc )
+  ,  ( "pgmm"           , HasArg setPgmm )
+  ,  ( "pgms"           , HasArg setPgms )
+  ,  ( "pgma"           , HasArg setPgma )
+  ,  ( "pgml"           , HasArg setPgml )
+#ifdef ILX
+  ,  ( "pgmI"           , HasArg setPgmI )
+  ,  ( "pgmi"           , HasArg setPgmi )
+#endif
 
   ,  ( "optdep"                , HasArg (add v_Opt_dep) )
   ,  ( "optl"          , HasArg (add v_Opt_l) )
@@ -265,13 +304,18 @@ 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) )
 
   ,  ( "fmax-simplifier-iterations", 
                Prefix (writeIORef v_MaxSimplifierIterations . read) )
 
+  ,  ( "frule-check", 
+               SepArg (\s -> writeIORef v_RuleCheck (Just s)) )
+
   ,  ( "fusagesp"         , NoArg (do writeIORef v_UsageSPInf True
                                       add v_Opt_C "-fusagesp-on") )
 
@@ -282,7 +326,6 @@ 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) )
-  ,  ( "fno-cpr"          , NoArg (writeIORef v_CPR False) )
   ,  ( "fno-cse"          , NoArg (writeIORef v_CSE False) )
 
        -- All other "-fno-<blah>" options cancel out "-f<blah>" on the hsc cmdline
@@ -296,12 +339,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) )
@@ -317,7 +362,7 @@ dynamic_flags = [
        -- on all other systems, quoting is necessary, to avoid interpretation
        -- of shell metacharacters in the arguments (e.g. green-card's
        -- -DBEGIN_GHC_ONLY='}-' trick).
-#ifndef mingw32_TARGET_OS
+#ifndef mingw32_HOST_OS
   ,  ( "D",            Prefix (\s -> addOpt_P ("-D'"++s++"'") ) )
   ,  ( "U",            Prefix (\s -> addOpt_P ("-U'"++s++"'") ) )
 #else
@@ -343,7 +388,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) )
@@ -365,6 +410,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) )
@@ -387,10 +433,12 @@ dynamic_flags = [
   ,  ( "fvia-c",       NoArg (setLang HscC) )
   ,  ( "fvia-C",       NoArg (setLang HscC) )
   ,  ( "filx",         NoArg (setLang HscILX) )
-  ,  ( "fno-code",      NoArg (setLang HscNothing) )
+  ,  ( "fcore",                NoArg (setLang HscCore) )
 
        -- "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)) )
@@ -415,8 +463,13 @@ fFlags = [
   ( "warn-unused-matches",             Opt_WarnUnusedMatches ),
   ( "warn-deprecations",               Opt_WarnDeprecations ),
   ( "glasgow-exts",                    Opt_GlasgowExts ),
+  ( "fi",                              Opt_FFI ),  -- support `-ffi'...
+  ( "ffi",                             Opt_FFI ),  -- ...and also `-fffi'
+  ( "with",                            Opt_With ), -- with keyword
+  ( "parr",                            Opt_PArr ),
   ( "allow-overlapping-instances",     Opt_AllowOverlappingInstances ),
   ( "allow-undecidable-instances",     Opt_AllowUndecidableInstances ),
+  ( "allow-incoherent-instances",      Opt_AllowIncoherentInstances ),
   ( "generics",                        Opt_Generics )
   ]
 
@@ -459,7 +512,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*
@@ -482,7 +536,7 @@ buildStaticHscOpts = do
 
 machdepCCOpts 
    | prefixMatch "alpha"   cTARGETPLATFORM  
-       = return ( ["-static"], ["-w"] )
+       = 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.
@@ -517,6 +571,9 @@ machdepCCOpts
                        "-DSTOLEN_X86_REGS="++show n_regs ]
                    )
 
+   | prefixMatch "ia64"    cTARGETPLATFORM  
+       = return ( [], ["-fomit-frame-pointer", "-G0"] )
+
    | prefixMatch "mips"    cTARGETPLATFORM
        = return ( ["-static"], [] )
 
@@ -526,16 +583,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})
@@ -544,25 +606,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})