[project @ 2005-10-25 12:48:35 by simonmar]
[ghc-hetmet.git] / ghc / compiler / main / DynFlags.hs
index e138f47..52e5542 100644 (file)
@@ -56,12 +56,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
@@ -167,6 +174,7 @@ data DynFlag
    | Opt_NoHsMain
    | Opt_SplitObjs
    | Opt_StgStats
+   | Opt_HideAllPackages
 
    -- keeping stuff
    | Opt_KeepHiDiffs
@@ -176,7 +184,7 @@ data DynFlag
    | Opt_KeepTmpFiles
 
    deriving (Eq)
-
 data DynFlags = DynFlags {
   ghcMode              :: GhcMode,
   ghcLink              :: GhcLink,
@@ -238,7 +246,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.
@@ -246,11 +254,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
@@ -291,9 +302,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
@@ -393,7 +402,13 @@ defaultDynFlags =
            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))
       }
 
 {- 
@@ -600,7 +615,6 @@ getCoreToDo dflags
            MaxSimplifierIterations max_iter
        ]
       ]
-
      else {- opt_level >= 1 -} [ 
 
        -- initial simplify: mk specialiser happy: minimum effort please
@@ -818,6 +832,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
 
@@ -865,7 +880,7 @@ 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-vect",            setDumpFlag Opt_D_dump_vect)
@@ -904,6 +919,7 @@ dynamic_flags = [
 
         ------ Compiler flags -----------------------------------------------
 
+  ,  ( "fno-code",     NoArg (setTarget HscNothing))
   ,  ( "fasm",         AnySuffix (\_ -> setTarget HscAsm) )
   ,  ( "fvia-c",       NoArg (setTarget HscC) )
   ,  ( "fvia-C",       NoArg (setTarget HscC) )
@@ -1038,18 +1054,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 }
 
-  | 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 = Just 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
@@ -1092,20 +1107,20 @@ splitPathList s = filter notNull (splitUp s)
      -- that this will cause too much breakage for users & ':' will
      -- work fine even with DOS paths, if you're not insisting on being silly.
      -- So, use either.
-    splitUp []         = []
-    splitUp (x:':':div:xs) 
-      | div `elem` dir_markers = do
-          let (p,rs) = findNextPath xs
-          in ((x:':':div:p): splitUp rs)
+    splitUp []             = []
+    splitUp (x:':':div:xs) | div `elem` dir_markers
+                          = ((x:':':div:p): splitUp rs)
+                          where
+                             (p,rs) = findNextPath xs
          -- we used to check for existence of the path here, but that
          -- required the IO monad to be threaded through the command-line
          -- parser which is quite inconvenient.  The 
-    splitUp xs = do
-      let (p,rs) = findNextPath xs
-      return (cons p (splitUp rs))
+    splitUp xs = cons p (splitUp rs)
+              where
+                (p,rs) = findNextPath xs
     
-    cons "" xs = xs
-    cons x  xs = x:xs
+                cons "" xs = xs
+                cons x  xs = x:xs
 
     -- will be called either when we've consumed nought or the
     -- "<Drive>:/" part of a DOS path, so splitting is just a Q of
@@ -1221,7 +1236,13 @@ 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.
+               ] )
 
 #elif mips_TARGET_ARCH
        = ( ["-static"], [] )
@@ -1273,6 +1294,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)     \