X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FDynFlags.hs;h=724367b127d05d78b8448c929e6ce3079a201b5f;hb=53a5d0b0186379be1fb378b1ed591ff5f359178c;hp=d93e9443e2e9ba8978cc30049df482b058252346;hpb=fb38b8bab2b531ca7ac4ea28ad5b259a00e3759b;p=ghc-hetmet.git

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index d93e944..724367b 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -39,13 +39,14 @@ module DynFlags (
 	getVerbFlag,
 	updOptLevel,
 	setTmpDir,
+	setPackageName,
 	
 	-- parsing DynFlags
 	parseDynamicFlags,
         allFlags,
 
 	-- misc stuff
-	machdepCCOpts, picCCOpts,
+	machdepCCOpts, picCCOpts
   ) where
 
 #include "HsVersions.h"
@@ -68,21 +69,25 @@ import UniqFM           ( UniqFM )
 import Util		( notNull, splitLongestPrefix, normalisePath )
 import Maybes		( fromJust, orElse )
 import SrcLoc           ( SrcSpan )
+import Outputable
+import {-# SOURCE #-} ErrUtils ( Severity(..), Message, mkLocMessage )
 
-import DATA_IOREF	( readIORef )
-import EXCEPTION	( throwDyn )
-import Monad		( when )
+import Data.IORef	( readIORef )
+import Control.Exception ( throwDyn )
+import Control.Monad	( when )
 #ifdef mingw32_TARGET_OS
 import Data.List	( isPrefixOf )
 #else
 import Util		( split )
 #endif
 
-import Char		( isDigit, isUpper )
-import Outputable
+import Data.Char	( isDigit, isUpper )
 import System.IO        ( hPutStrLn, stderr )
-import {-# SOURCE #-} ErrUtils ( Severity(..), Message, mkLocMessage )
 
+#ifdef GHCI
+import Breakpoints      ( BkptHandler )
+import Module           ( ModuleName )
+#endif
 -- -----------------------------------------------------------------------------
 -- DynFlags
 
@@ -120,6 +125,7 @@ data DynFlag
    | Opt_D_dump_splices
    | Opt_D_dump_BCOs
    | Opt_D_dump_vect
+   | Opt_D_dump_hpc
    | Opt_D_source_stats
    | Opt_D_verbose_core2core
    | Opt_D_verbose_stg2stg
@@ -195,7 +201,12 @@ data DynFlag
    | Opt_SplitObjs
    | Opt_StgStats
    | Opt_HideAllPackages
+#if defined(GHCI) && defined(DEBUGGER)
+   | Opt_Debugging
+#endif
    | Opt_PrintBindResult
+   | Opt_Haddock
+   | Opt_Hpc_No_Auto
 
    -- keeping stuff
    | Opt_KeepHiDiffs
@@ -253,6 +264,8 @@ data DynFlags = DynFlags {
   ghcUsagePath          :: FilePath,    -- Filled in by SysTools
   ghciUsagePath         :: FilePath,    -- ditto
 
+  hpcDir		:: String,	-- ^ path to store the .mix files
+
   -- options for particular phases
   opt_L			:: [String],
   opt_P			:: [String],
@@ -298,6 +311,11 @@ data DynFlags = DynFlags {
   
   -- message output
   log_action            :: Severity -> SrcSpan -> PprStyle -> Message -> IO ()
+
+#ifdef GHCI
+  -- breakpoint handling
+ ,bkptHandler           :: Maybe (BkptHandler Module)
+#endif
  }
 
 data HscTarget
@@ -390,6 +408,8 @@ defaultDynFlags =
 	cmdlineFrameworks	= [],
 	tmpDir			= cDEFAULT_TMPDIR,
 	
+        hpcDir		        = ".hpc",
+
 	opt_L			= [],
 	opt_P			= [],
 	opt_F			= [],
@@ -404,7 +424,9 @@ defaultDynFlags =
 	packageFlags		= [],
         pkgDatabase             = Nothing,
         pkgState                = panic "no package state yet: call GHC.setSessionDynFlags",
-	
+#ifdef GHCI
+        bkptHandler             = Nothing,
+#endif
 	flags = [ 
     	    Opt_ReadUserPackageConf,
     
@@ -531,9 +553,7 @@ data Option
 updOptLevel :: Int -> DynFlags -> DynFlags
 -- Set dynflags appropriate to the optimisation level
 updOptLevel n dfs
-  = if (n >= 1)
-     then dfs2{ hscTarget = HscC, optLevel = n } -- turn on -fvia-C with -O
-     else dfs2{ optLevel = n }
+  = dfs2{ optLevel = n }
   where
    dfs1 = foldr (flip dopt_unset) dfs  remove_dopts
    dfs2 = foldr (flip dopt_set)   dfs1 extra_dopts
@@ -812,7 +832,6 @@ dynamic_flags = [
   ,  ( "F"		, NoArg  (setDynFlag Opt_Pp))
   ,  ( "#include"	, HasArg (addCmdlineHCInclude) )
   ,  ( "v"		, OptIntSuffix setVerbosity )
-
         ------- Specific phases  --------------------------------------------
   ,  ( "pgmL"           , HasArg (upd . setPgmL) )  
   ,  ( "pgmP"           , HasArg (upd . setPgmP) )  
@@ -873,6 +892,8 @@ dynamic_flags = [
 	------- Miscellaneous ----------------------------------------------
   ,  ( "no-hs-main"     , NoArg (setDynFlag Opt_NoHsMain))
   ,  ( "main-is"   	, SepArg setMainIs )
+  ,  ( "haddock"	, NoArg (setDynFlag Opt_Haddock) )
+  ,  ( "hpcdir"		, SepArg setOptHpcDir )
 
 	------- recompilation checker (DEPRECATED, use -fforce-recomp) -----
   ,  ( "recomp"		, NoArg (unSetDynFlag Opt_ForceRecomp) )
@@ -881,7 +902,7 @@ dynamic_flags = [
         ------- Packages ----------------------------------------------------
   ,  ( "package-conf"   , HasArg extraPkgConf_ )
   ,  ( "no-user-package-conf", NoArg (unSetDynFlag Opt_ReadUserPackageConf) )
-  ,  ( "package-name"   , HasArg setPackageName )
+  ,  ( "package-name"   , HasArg (upd . setPackageName) )
   ,  ( "package"        , HasArg exposePackage )
   ,  ( "hide-package"   , HasArg hidePackage )
   ,  ( "hide-all-packages", NoArg (setDynFlag Opt_HideAllPackages) )
@@ -936,6 +957,8 @@ dynamic_flags = [
   ,  ( "ddump-hi",               setDumpFlag Opt_D_dump_hi)
   ,  ( "ddump-minimal-imports",  NoArg (setDynFlag Opt_D_dump_minimal_imports))
   ,  ( "ddump-vect",         	 setDumpFlag Opt_D_dump_vect)
+  ,  ( "ddump-hpc",         	 setDumpFlag Opt_D_dump_hpc)
+  
   ,  ( "dcore-lint",       	 NoArg (setDynFlag Opt_DoCoreLinting))
   ,  ( "dstg-lint",        	 NoArg (setDynFlag Opt_DoStgLinting))
   ,  ( "dcmm-lint",		 NoArg (setDynFlag Opt_DoCmmLinting))
@@ -1039,7 +1062,11 @@ fFlags = [
   ( "excess-precision",			Opt_ExcessPrecision ),
   ( "asm-mangling",			Opt_DoAsmMangling ),
   ( "print-bind-result",		Opt_PrintBindResult ),
-  ( "force-recomp",			Opt_ForceRecomp )
+#if defined(GHCI) && defined(DEBUGGER)
+  ( "debugging",                        Opt_Debugging),
+#endif
+  ( "force-recomp",			Opt_ForceRecomp ),
+  ( "hpc-no-auto",			Opt_Hpc_No_Auto )
   ]
 
 
@@ -1095,11 +1122,12 @@ 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 })
+  = \s -> s{ thisPackage = pid }
   where
         pid = stringToPackageId p
 
@@ -1241,6 +1269,12 @@ setTmpDir dir dflags = dflags{ tmpDir = canonicalise dir }
 #endif
 
 -----------------------------------------------------------------------------
+-- Hpc stuff
+
+setOptHpcDir :: String -> DynP ()
+setOptHpcDir arg  = upd $ \ d -> d{hpcDir = arg}
+
+-----------------------------------------------------------------------------
 -- Via-C compilation stuff
 
 machdepCCOpts :: DynFlags -> ([String], -- flags for all C compilations
@@ -1330,9 +1364,6 @@ machdepCCOpts dflags
 			-- version.
 		] )
 
-#elif mips_TARGET_ARCH
-	= ( ["-static"], [] )
-
 #elif sparc_TARGET_ARCH
 	= ( [], ["-w"] )
 	-- For now, to suppress the gcc warning "call-clobbered