-fno-code shouldn't be a mode.
[ghc-hetmet.git] / ghc / compiler / main / DynFlags.hs
index fc48857..f0c95bc 100644 (file)
@@ -41,6 +41,7 @@ module DynFlags (
        
        -- parsing DynFlags
        parseDynamicFlags,
+        allFlags,
 
        -- misc stuff
        machdepCCOpts, picCCOpts,
@@ -48,6 +49,8 @@ module DynFlags (
 
 #include "HsVersions.h"
 
+import Module          ( Module, mkModule )
+import PrelNames       ( mAIN )
 import StaticFlags     ( opt_Static, opt_PIC, 
                          WayName(..), v_Ways, v_Build_tag, v_RTS_Build_tag )
 import {-# SOURCE #-} Packages (PackageState)
@@ -56,13 +59,19 @@ import Config
 import CmdLineParser
 import Panic           ( panic, GhcException(..) )
 import Util            ( notNull, splitLongestPrefix, split, normalisePath )
+import SrcLoc           ( SrcSpan )
 
 import DATA_IOREF      ( readIORef )
 import EXCEPTION       ( throwDyn )
 import Monad           ( when )
+#ifdef mingw32_TARGET_OS
 import Data.List       ( isPrefixOf )
+#endif
 import Maybe           ( fromJust )
 import Char            ( isDigit, isUpper )
+import Outputable
+import System.IO        ( hPutStrLn, stderr )
+import {-# SOURCE #-} ErrUtils ( Severity(..), Message, mkLocMessage )
 
 -- -----------------------------------------------------------------------------
 -- DynFlags
@@ -107,6 +116,7 @@ data DynFlag
    | Opt_D_dump_hi
    | Opt_D_dump_hi_diffs
    | Opt_D_dump_minimal_imports
+   | Opt_D_faststring_stats
    | Opt_DoCoreLinting
    | Opt_DoStgLinting
    | Opt_DoCmmLinting
@@ -144,6 +154,7 @@ data DynFlag
    | Opt_Generics
    | Opt_ImplicitPrelude 
    | Opt_ScopedTypeVariables
+   | Opt_BangPatterns
 
    -- optimisation opts
    | Opt_Strictness
@@ -163,11 +174,13 @@ data DynFlag
    | Opt_RecompChecking
    | Opt_DryRun
    | Opt_DoAsmMangling
+   | Opt_WriteIface
    | Opt_ExcessPrecision
    | Opt_ReadUserPackageConf
    | Opt_NoHsMain
    | Opt_SplitObjs
    | Opt_StgStats
+   | Opt_HideAllPackages
 
    -- keeping stuff
    | Opt_KeepHiDiffs
@@ -177,7 +190,7 @@ data DynFlag
    | Opt_KeepTmpFiles
 
    deriving (Eq)
-
 data DynFlags = DynFlags {
   ghcMode              :: GhcMode,
   ghcLink              :: GhcLink,
@@ -185,8 +198,6 @@ data DynFlags = DynFlags {
   stgToDo              :: Maybe [StgToDo],  -- similarly
   hscTarget                    :: HscTarget,
   hscOutName           :: String,      -- name of the output file
-  hscStubHOutName      :: String,      -- name of the .stub_h output file
-  hscStubCOutName      :: String,      -- name of the .stub_c output file
   extCoreName          :: String,      -- name of the .core output file
   verbosity            :: Int,         -- verbosity level
   optLevel             :: Int,         -- optimisation level
@@ -195,7 +206,7 @@ data DynFlags = DynFlags {
   stolen_x86_regs      :: Int,         
   cmdlineHcIncludes    :: [String],    -- -#includes
   importPaths          :: [FilePath],
-  mainModIs            :: Maybe String,
+  mainModIs            :: Module,
   mainFunIs            :: Maybe String,
 
   -- ways
@@ -204,13 +215,17 @@ data DynFlags = DynFlags {
   rtsBuildTag          :: String,      -- the RTS "way"
   
   -- paths etc.
-  outputDir            :: Maybe String,
-  outputFile           :: Maybe String,
-  outputHi             :: Maybe String,
+  objectDir            :: Maybe String,
+  hiDir                        :: Maybe String,
+  stubDir              :: Maybe String,
+
   objectSuf            :: String,
   hcSuf                        :: String,
-  hiDir                        :: Maybe String,
   hiSuf                        :: String,
+
+  outputFile           :: Maybe String,
+  outputHi             :: Maybe String,
+
   includePaths         :: [String],
   libraryPaths         :: [String],
   frameworkPaths       :: [String],    -- used on darwin only
@@ -239,7 +254,7 @@ data DynFlags = DynFlags {
   pgm_l                        :: (String,[Option]),
   pgm_dll              :: (String,[Option]),
 
-  -- ** Package flags
+  --  ** Package flags
   extraPkgConfs                :: [FilePath],
        -- The -package-conf flags given on the command line, in the order
        -- they appeared.
@@ -247,11 +262,14 @@ data DynFlags = DynFlags {
   packageFlags         :: [PackageFlag],
        -- The -package and -hide-package flags from the command-line
 
-  -- ** Package state
+  --  ** Package state
   pkgState             :: PackageState,
 
   -- hsc dynamic flags
-  flags                :: [DynFlag]
+  flags                :: [DynFlag],
+  
+  -- message output
+  log_action            :: Severity -> SrcSpan -> PprStyle -> Message -> IO ()
  }
 
 data HscTarget
@@ -292,9 +310,7 @@ data PackageFlag
   | IgnorePackage  String
 
 defaultHscTarget
-#if defined(i386_TARGET_ARCH) || defined(sparc_TARGET_ARCH) || defined(powerpc_TARGET_ARCH)
   | cGhcWithNativeCodeGen == "YES"     =  HscAsm
-#endif
   | otherwise                          =  HscC
 
 initDynFlags dflags = do
@@ -316,8 +332,6 @@ defaultDynFlags =
        stgToDo                 = Nothing, 
        hscTarget               = defaultHscTarget, 
        hscOutName              = "", 
-       hscStubHOutName         = "",
-       hscStubCOutName         = "",
        extCoreName             = "",
        verbosity               = 0, 
        optLevel                = 0,
@@ -326,20 +340,23 @@ defaultDynFlags =
        stolen_x86_regs         = 4,
        cmdlineHcIncludes       = [],
        importPaths             = ["."],
-       mainModIs               = Nothing,
+       mainModIs               = mAIN,
        mainFunIs               = Nothing,
        
        wayNames                = panic "ways",
        buildTag                = panic "buildTag",
        rtsBuildTag             = panic "rtsBuildTag",
 
-       outputDir               = Nothing,
-       outputFile              = Nothing,
-       outputHi                = Nothing,
+       objectDir               = Nothing,
+       hiDir                   = Nothing,
+       stubDir                 = Nothing,
+
        objectSuf               = phaseInputExt StopLn,
        hcSuf                   = phaseInputExt HCc,
-       hiDir                   = Nothing,
        hiSuf                   = "hi",
+
+       outputFile              = Nothing,
+       outputHi                = Nothing,
        includePaths            = [],
        libraryPaths            = [],
        frameworkPaths          = [],
@@ -389,12 +406,19 @@ defaultDynFlags =
                        -- a good thing anyway, but it seems fragile.
     
            Opt_DoAsmMangling,
+            Opt_WriteIface,
     
            -- and the default no-optimisation options:
            Opt_IgnoreInterfacePragmas,
            Opt_OmitInterfacePragmas
     
-               ] ++ standardWarnings
+               ] ++ standardWarnings,
+               
+        log_action = \severity srcSpan style msg -> 
+                        case severity of
+                          SevInfo  -> hPutStrLn stderr (show (msg style))
+                          SevFatal -> hPutStrLn stderr (show (msg style))
+                          _        -> hPutStrLn stderr ('\n':show ((mkLocMessage srcSpan msg) style))
       }
 
 {- 
@@ -426,13 +450,16 @@ getVerbFlag dflags
   | verbosity dflags >= 3  = "-v" 
   | otherwise =  ""
 
-setOutputDir  f d = d{ outputDir  = f}
-setOutputFile f d = d{ outputFile = f}
-setOutputHi   f d = d{ outputHi   = f}
+setObjectDir  f d = d{ objectDir  = f}
+setHiDir      f d = d{ hiDir      = f}
+setStubDir    f d = d{ stubDir    = f}
+
 setObjectSuf  f d = d{ objectSuf  = f}
-setHcSuf      f d = d{ hcSuf      = f}
 setHiSuf      f d = d{ hiSuf      = f}
-setHiDir      f d = d{ hiDir      = f}
+setHcSuf      f d = d{ hcSuf      = f}
+
+setOutputFile f d = d{ outputFile = f}
+setOutputHi   f d = d{ outputHi   = f}
 
 -- XXX HACK: Prelude> words "'does not' work" ===> ["'does","not'","work"]
 -- Config.hs should really use Option.
@@ -601,7 +628,6 @@ getCoreToDo dflags
            MaxSimplifierIterations max_iter
        ]
       ]
-
      else {- opt_level >= 1 -} [ 
 
        -- initial simplify: mk specialiser happy: minimum effort please
@@ -741,6 +767,15 @@ getStgToDo dflags
 -- -----------------------------------------------------------------------------
 -- DynFlags parser
 
+allFlags :: [String]
+allFlags = map ('-':) $
+           [ name | (name, optkind) <- dynamic_flags, ok optkind ] ++
+           map ("fno-"++) flags ++
+           map ("f"++) flags
+    where ok (PrefixPred _ _) = False
+          ok _ = True
+          flags = map fst fFlags
+
 dynamic_flags :: [(String, OptKind DynP)]
 dynamic_flags = [
      ( "n"              , NoArg  (setDynFlag Opt_DryRun) )
@@ -790,7 +825,7 @@ dynamic_flags = [
   ,  ( "framework"     , HasArg (upd . addCmdlineFramework) )
 
        ------- Output Redirection ------------------------------------------
-  ,  ( "odir"          , HasArg (upd . setOutputDir  . Just))
+  ,  ( "odir"          , HasArg (upd . setObjectDir  . Just))
   ,  ( "o"             , SepArg (upd . setOutputFile . Just))
   ,  ( "ohi"           , HasArg (upd . setOutputHi   . Just ))
   ,  ( "osuf"          , HasArg (upd . setObjectSuf))
@@ -798,10 +833,13 @@ dynamic_flags = [
   ,  ( "hisuf"         , HasArg (upd . setHiSuf))
   ,  ( "hidir"         , HasArg (upd . setHiDir . Just))
   ,  ( "tmpdir"                , HasArg (upd . setTmpDir))
+  ,  ( "stubdir"       , HasArg (upd . setStubDir . Just))
 
        ------- Keeping temporary files -------------------------------------
-  ,  ( "keep-hc-file"   , AnySuffix (\_ -> setDynFlag Opt_KeepHcFiles))
-  ,  ( "keep-s-file"    , AnySuffix (\_ -> setDynFlag Opt_KeepSFiles))
+  ,  ( "keep-hc-file"   , AnySuffix (\_ -> do setDynFlag Opt_KeepHcFiles
+                                              setTarget HscC))
+  ,  ( "keep-s-file"    , AnySuffix (\_ -> do setDynFlag Opt_KeepSFiles
+                                              setTarget HscAsm))
   ,  ( "keep-raw-s-file", AnySuffix (\_ -> setDynFlag Opt_KeepRawSFiles))
   ,  ( "keep-tmp-files" , AnySuffix (\_ -> setDynFlag Opt_KeepTmpFiles))
 
@@ -819,6 +857,7 @@ dynamic_flags = [
   ,  ( "package-name"   , HasArg ignorePackage ) -- for compatibility
   ,  ( "package"        , HasArg exposePackage )
   ,  ( "hide-package"   , HasArg hidePackage )
+  ,  ( "hide-all-packages", NoArg (setDynFlag Opt_HideAllPackages) )
   ,  ( "ignore-package" , HasArg ignorePackage )
   ,  ( "syslib"         , HasArg exposePackage )  -- for compatibility
 
@@ -866,15 +905,16 @@ dynamic_flags = [
   ,  ( "dsource-stats",          setDumpFlag Opt_D_source_stats)
   ,  ( "dverbose-core2core",     setDumpFlag Opt_D_verbose_core2core)
   ,  ( "dverbose-stg2stg",       setDumpFlag Opt_D_verbose_stg2stg)
-  ,  ( "ddump-hi-diffs",         setDumpFlag Opt_D_dump_hi_diffs)
+  ,  ( "ddump-hi-diffs",         NoArg (setDynFlag Opt_D_dump_hi_diffs))
   ,  ( "ddump-hi",               setDumpFlag Opt_D_dump_hi)
-  ,  ( "ddump-minimal-imports",  setDumpFlag Opt_D_dump_minimal_imports)
+  ,  ( "ddump-minimal-imports",  NoArg (setDynFlag Opt_D_dump_minimal_imports))
   ,  ( "ddump-vect",            setDumpFlag Opt_D_dump_vect)
   ,  ( "dcore-lint",            NoArg (setDynFlag Opt_DoCoreLinting))
   ,  ( "dstg-lint",             NoArg (setDynFlag Opt_DoStgLinting))
   ,  ( "dcmm-lint",             NoArg (setDynFlag Opt_DoCmmLinting))
   ,  ( "dshow-passes",           NoArg (do unSetDynFlag Opt_RecompChecking
                                           setVerbosity "2") )
+  ,  ( "dfaststring-stats",     NoArg (setDynFlag Opt_D_faststring_stats))
 
        ------ Machine dependant (-m<blah>) stuff ---------------------------
 
@@ -905,6 +945,8 @@ dynamic_flags = [
 
         ------ Compiler flags -----------------------------------------------
 
+  ,  ( "fno-code",     NoArg (do setTarget HscNothing
+                                  unSetDynFlag Opt_WriteIface))
   ,  ( "fasm",         AnySuffix (\_ -> setTarget HscAsm) )
   ,  ( "fvia-c",       NoArg (setTarget HscC) )
   ,  ( "fvia-C",       NoArg (setTarget HscC) )
@@ -944,6 +986,7 @@ fFlags = [
   ( "th",                              Opt_TH ),
   ( "implicit-prelude",                Opt_ImplicitPrelude ),
   ( "scoped-type-variables",           Opt_ScopedTypeVariables ),
+  ( "bang-patterns",                   Opt_BangPatterns ),
   ( "monomorphism-restriction",                Opt_MonomorphismRestriction ),
   ( "implicit-params",                 Opt_ImplicitParams ),
   ( "allow-overlapping-instances",     Opt_AllowOverlappingInstances ),
@@ -961,7 +1004,8 @@ fFlags = [
   ( "case-merge",                      Opt_CaseMerge ),
   ( "unbox-strict-fields",             Opt_UnboxStrictFields ),
   ( "excess-precision",                        Opt_ExcessPrecision ),
-  ( "asm-mangling",                    Opt_DoAsmMangling )
+  ( "asm-mangling",                    Opt_DoAsmMangling ),
+  ( "write-iface",                      Opt_WriteIface )
   ]
 
 glasgowExtsFlags = [ 
@@ -969,7 +1013,8 @@ glasgowExtsFlags = [
   Opt_FFI, 
   Opt_TH, 
   Opt_ImplicitParams, 
-  Opt_ScopedTypeVariables ]
+  Opt_ScopedTypeVariables,
+  Opt_BangPatterns ]
 
 isFFlag f = f `elem` (map fst fFlags)
 getFFlag f = fromJust (lookup f fFlags)
@@ -1039,18 +1084,17 @@ setOptLevel n dflags
 
 setMainIs :: String -> DynP ()
 setMainIs arg
-  | not (null main_mod)                -- The arg looked like "Foo.baz"
+  | not (null main_fn)         -- The arg looked like "Foo.baz"
   = upd $ \d -> d{ mainFunIs = Just main_fn,
-                  mainModIs = Just main_mod }
+                  mainModIs = mkModule main_mod }
 
-  | isUpper (head main_fn)     -- The arg looked like "Foo"
-  = upd $ \d -> d{ mainModIs = Just main_fn }
+  | isUpper (head main_mod)    -- The arg looked like "Foo"
+  = upd $ \d -> d{ mainModIs = mkModule main_mod }
   
   | otherwise                  -- The arg looked like "baz"
-  = upd $ \d -> d{ mainFunIs = Just main_fn }
+  = upd $ \d -> d{ mainFunIs = Just main_mod }
   where
     (main_mod, main_fn) = splitLongestPrefix arg (== '.')
-  
 
 -----------------------------------------------------------------------------
 -- Paths & Libraries
@@ -1222,7 +1266,22 @@ machdepCCOpts dflags
        = ( [], ["-fomit-frame-pointer", "-G0"] )
 
 #elif x86_64_TARGET_ARCH
-       = ( [], ["-fomit-frame-pointer"] )
+       = ( [], ["-fomit-frame-pointer",
+                "-fno-asynchronous-unwind-tables",
+                       -- the unwind tables are unnecessary for HC code,
+                       -- and get in the way of -split-objs.  Another option
+                       -- would be to throw them away in the mangler, but this
+                       -- is easier.
+                "-fno-unit-at-a-time",
+                       -- unit-at-a-time doesn't do us any good, and screws
+                       -- up -split-objs by moving the split markers around.
+                       -- It's only turned on with -O2, but put it here just
+                       -- in case someone uses -optc-O2.
+                "-fno-builtin"
+                       -- calling builtins like strlen() using the FFI can
+                       -- cause gcc to run out of regs, so use the external
+                       -- version.
+               ] )
 
 #elif mips_TARGET_ARCH
        = ( ["-static"], [] )
@@ -1274,6 +1333,7 @@ picCCOpts dflags
 can_split :: Bool
 can_split =  
 #if    defined(i386_TARGET_ARCH)     \
+    || defined(x86_64_TARGET_ARCH)   \
     || defined(alpha_TARGET_ARCH)    \
     || defined(hppa_TARGET_ARCH)     \
     || defined(m68k_TARGET_ARCH)     \