Don't freeze the dynamic flags used for filename generation before the pipeline starts
[ghc-hetmet.git] / compiler / main / DynFlags.hs
index 2d28ae6..f02e676 100644 (file)
@@ -49,16 +49,22 @@ module DynFlags (
 
 #include "HsVersions.h"
 
-import Module          ( Module, mkModule )
+import Module          ( Module, mkModuleName, mkModule )
+import PackageConfig
 import PrelNames       ( mAIN )
-import StaticFlags     ( opt_Static, opt_PIC, 
-                         WayName(..), v_Ways, v_Build_tag, v_RTS_Build_tag )
+#ifdef i386_TARGET_ARCH
+import StaticFlags     ( opt_Static )
+#endif
+import StaticFlags     ( opt_PIC, WayName(..), v_Ways, v_Build_tag,
+                         v_RTS_Build_tag )
 import {-# SOURCE #-} Packages (PackageState)
 import DriverPhases    ( Phase(..), phaseInputExt )
 import Config
 import CmdLineParser
+import Constants       ( mAX_CONTEXT_REDUCTION_DEPTH )
 import Panic           ( panic, GhcException(..) )
-import Util            ( notNull, splitLongestPrefix, split, normalisePath )
+import Util            ( notNull, splitLongestPrefix, normalisePath )
+import Maybes          ( fromJust, orElse )
 import SrcLoc           ( SrcSpan )
 
 import DATA_IOREF      ( readIORef )
@@ -66,8 +72,10 @@ import EXCEPTION     ( throwDyn )
 import Monad           ( when )
 #ifdef mingw32_TARGET_OS
 import Data.List       ( isPrefixOf )
+#else
+import Util            ( split )
 #endif
-import Maybe           ( fromJust )
+
 import Char            ( isDigit, isUpper )
 import Outputable
 import System.IO        ( hPutStrLn, stderr )
@@ -145,10 +153,12 @@ data DynFlag
    | Opt_AllowUndecidableInstances
    | Opt_AllowIncoherentInstances
    | Opt_MonomorphismRestriction
+   | Opt_MonoPatBinds
+   | Opt_ExtendedDefaultRules          -- Use GHC's extended rules for defaulting
    | Opt_GlasgowExts
    | Opt_FFI
-   | Opt_PArr                         -- syntactic support for parallel arrays
-   | Opt_Arrows                               -- Arrow-notation syntax
+   | Opt_PArr                          -- Syntactic support for parallel arrays
+   | Opt_Arrows                                -- Arrow-notation syntax
    | Opt_TH
    | Opt_ImplicitParams
    | Opt_Generics
@@ -168,6 +178,7 @@ data DynFlag
    | Opt_DoEtaReduction
    | Opt_CaseMerge
    | Opt_UnboxStrictFields
+   | Opt_DictsCheap
 
    -- misc opts
    | Opt_Cpp
@@ -208,6 +219,9 @@ data DynFlags = DynFlags {
   importPaths          :: [FilePath],
   mainModIs            :: Module,
   mainFunIs            :: Maybe String,
+  ctxtStkDepth         :: Int,         -- Typechecker context stack depth
+
+  thisPackage          :: PackageId,
 
   -- ways
   wayNames             :: [WayName],   -- way flags from the cmd line
@@ -342,6 +356,9 @@ defaultDynFlags =
        importPaths             = ["."],
        mainModIs               = mAIN,
        mainFunIs               = Nothing,
+       ctxtStkDepth            = mAX_CONTEXT_REDUCTION_DEPTH,
+
+       thisPackage             = mainPackageId,
        
        wayNames                = panic "ways",
        buildTag                = panic "buildTag",
@@ -391,6 +408,10 @@ defaultDynFlags =
            Opt_RecompChecking,
            Opt_ReadUserPackageConf,
     
+           Opt_MonoPatBinds,   -- Experimentally, I'm making this non-standard
+                               -- behaviour the default, to see if anyone notices
+                               -- SLPJ July 06
+
            Opt_ImplicitPrelude,
            Opt_MonomorphismRestriction,
            Opt_Strictness,
@@ -727,7 +748,7 @@ getCoreToDo dflags
 
        ++ 
 
-     if opt_level >= 2 then
+     (if opt_level >= 2 then
           [  CoreLiberateCase,
              CoreDoSimplify (SimplPhase 0) [
                  MaxSimplifierIterations max_iter
@@ -736,8 +757,8 @@ getCoreToDo dflags
                        -- Reason: see Note [Shadowing] in SpecConstr.lhs
             CoreDoSpecConstr
           ]
-     else
-          []
+      else
+          [])
 
        ++
 
@@ -788,7 +809,7 @@ dynamic_flags = [
   ,  ( "cpp"           , NoArg  (setDynFlag Opt_Cpp))
   ,  ( "F"             , NoArg  (setDynFlag Opt_Pp))
   ,  ( "#include"      , HasArg (addCmdlineHCInclude) )
-  ,  ( "v"             , OptPrefix (setVerbosity) )
+  ,  ( "v"             , OptIntSuffix setVerbosity )
 
         ------- Specific phases  --------------------------------------------
   ,  ( "pgmL"           , HasArg (upd . setPgmL) )  
@@ -858,7 +879,7 @@ dynamic_flags = [
         ------- Packages ----------------------------------------------------
   ,  ( "package-conf"   , HasArg extraPkgConf_ )
   ,  ( "no-user-package-conf", NoArg (unSetDynFlag Opt_ReadUserPackageConf) )
-  ,  ( "package-name"   , HasArg ignorePackage ) -- for compatibility
+  ,  ( "package-name"   , HasArg setPackageName )
   ,  ( "package"        , HasArg exposePackage )
   ,  ( "hide-package"   , HasArg hidePackage )
   ,  ( "hide-all-packages", NoArg (setDynFlag Opt_HideAllPackages) )
@@ -917,7 +938,7 @@ dynamic_flags = [
   ,  ( "dstg-lint",             NoArg (setDynFlag Opt_DoStgLinting))
   ,  ( "dcmm-lint",             NoArg (setDynFlag Opt_DoCmmLinting))
   ,  ( "dshow-passes",           NoArg (do unSetDynFlag Opt_RecompChecking
-                                          setVerbosity "2") )
+                                          setVerbosity (Just 2)) )
   ,  ( "dfaststring-stats",     NoArg (setDynFlag Opt_D_faststring_stats))
 
        ------ Machine dependant (-m<blah>) stuff ---------------------------
@@ -958,6 +979,9 @@ dynamic_flags = [
   ,  ( "fglasgow-exts",    NoArg (mapM_ setDynFlag   glasgowExtsFlags) )
   ,  ( "fno-glasgow-exts", NoArg (mapM_ unSetDynFlag glasgowExtsFlags) )
 
+  ,  ( "fcontext-stack"        , OptIntSuffix $ \mb_n -> upd $ \dfs -> 
+                         dfs{ ctxtStkDepth = mb_n `orElse` 3 })
+
        -- the rest of the -f* and -fno-* flags
   ,  ( "fno-",                 PrefixPred (\f -> isFFlag f) (\f -> unSetDynFlag (getFFlag f)) )
   ,  ( "f",            PrefixPred (\f -> isFFlag f) (\f -> setDynFlag (getFFlag f)) )
@@ -991,6 +1015,8 @@ fFlags = [
   ( "scoped-type-variables",           Opt_ScopedTypeVariables ),
   ( "bang-patterns",                   Opt_BangPatterns ),
   ( "monomorphism-restriction",                Opt_MonomorphismRestriction ),
+  ( "mono-pat-binds",                  Opt_MonoPatBinds ),
+  ( "extended-default-rules",          Opt_ExtendedDefaultRules ),
   ( "implicit-params",                 Opt_ImplicitParams ),
   ( "allow-overlapping-instances",     Opt_AllowOverlappingInstances ),
   ( "allow-undecidable-instances",     Opt_AllowUndecidableInstances ),
@@ -1007,6 +1033,7 @@ fFlags = [
   ( "do-eta-reduction",                        Opt_DoEtaReduction ),
   ( "case-merge",                      Opt_CaseMerge ),
   ( "unbox-strict-fields",             Opt_UnboxStrictFields ),
+  ( "dicts-cheap",                     Opt_DictsCheap ),
   ( "excess-precision",                        Opt_ExcessPrecision ),
   ( "asm-mangling",                    Opt_DoAsmMangling )
   ]
@@ -1050,10 +1077,8 @@ setDumpFlag dump_flag
        -- Whenver we -ddump, switch off the recompilation checker,
        -- else you don't see the dump!
 
-setVerbosity "" = upd (\dfs -> dfs{ verbosity = 3 })
-setVerbosity n 
-  | all isDigit n = upd (\dfs -> dfs{ verbosity = read n })
-  | otherwise     = throwDyn (UsageError "can't parse verbosity flag (-v<n>)")
+setVerbosity :: Maybe Int -> DynP ()
+setVerbosity mb_n = upd (\dfs -> dfs{ verbosity = mb_n `orElse` 3 })
 
 addCmdlineHCInclude a = upd (\s -> s{cmdlineHcIncludes =  a : cmdlineHcIncludes s})
 
@@ -1065,6 +1090,13 @@ hidePackage p =
   upd (\s -> s{ packageFlags = HidePackage p : packageFlags s })
 ignorePackage p = 
   upd (\s -> s{ packageFlags = IgnorePackage p : packageFlags s })
+setPackageName p
+  | Nothing <- unpackPackageId pid
+  = throwDyn (CmdLineError ("cannot parse \'" ++ p ++ "\' as a package identifier"))
+  | otherwise
+  = upd (\s -> s{ thisPackage = pid })
+  where
+        pid = stringToPackageId p
 
 -- we can only switch between HscC, HscAsmm, and HscILX with dynamic flags 
 -- (-fvia-C, -fasm, -filx respectively).
@@ -1088,10 +1120,10 @@ setMainIs :: String -> DynP ()
 setMainIs arg
   | not (null main_fn)         -- The arg looked like "Foo.baz"
   = upd $ \d -> d{ mainFunIs = Just main_fn,
-                  mainModIs = mkModule main_mod }
+                  mainModIs = mkModule mainPackageId (mkModuleName main_mod) }
 
   | isUpper (head main_mod)    -- The arg looked like "Foo"
-  = upd $ \d -> d{ mainModIs = mkModule main_mod }
+  = upd $ \d -> d{ mainModIs = mkModule mainPackageId (mkModuleName main_mod) }
   
   | otherwise                  -- The arg looked like "baz"
   = upd $ \d -> d{ mainFunIs = Just main_mod }
@@ -1256,6 +1288,13 @@ machdepCCOpts dflags
                        -- -fomit-frame-pointer, so we disable it first here.
                        "-mno-omit-leaf-frame-pointer",
 #endif
+#ifdef HAVE_GCC_HAS_NO_UNIT_AT_A_TIME
+                       "-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.
+#endif
                        "-fomit-frame-pointer",
                        -- we want -fno-builtin, because when gcc inlines
                        -- built-in functions like memcpy() it tends to