X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FDynFlags.hs;h=a5269c0dedeaa6a4acd1602fd78fbeedac3dbe1f;hb=6debd2c1e919c5e855a7e88dd8ba124d17d475cc;hp=731ac29b498b5cc4adafced3bf759628bd8b1399;hpb=10ffe4f78dc4bd53d5bc2da1deb8a67669ccb476;p=ghc-hetmet.git

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 731ac29..a5269c0 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -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 )
@@ -210,6 +218,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
@@ -344,6 +355,9 @@ defaultDynFlags =
 	importPaths		= ["."],
 	mainModIs		= mAIN,
 	mainFunIs		= Nothing,
+	ctxtStkDepth		= mAX_CONTEXT_REDUCTION_DEPTH,
+
+	thisPackage		= mainPackageId,
 	
 	wayNames		= panic "ways",
 	buildTag		= panic "buildTag",
@@ -794,7 +808,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) )  
@@ -864,7 +878,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) )
@@ -923,7 +937,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 ---------------------------
@@ -964,6 +978,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)) )
@@ -1058,10 +1075,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})
 
@@ -1073,6 +1088,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).
@@ -1096,10 +1118,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 }