X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FCmdLineOpts.lhs;h=2d4b4e9d78b05484271986419736bdfc5f2d7ac4;hb=153b9cb9b11e05c4edb1b6bc0a7b972660e41f70;hp=c55f322f55e0e8df007f7faf39a218a0e5bd5743;hpb=e753cf6c364d1e5c06a4463b87eadf869f99dbd3;p=ghc-hetmet.git

diff --git a/ghc/compiler/main/CmdLineOpts.lhs b/ghc/compiler/main/CmdLineOpts.lhs
index c55f322..2d4b4e9 100644
--- a/ghc/compiler/main/CmdLineOpts.lhs
+++ b/ghc/compiler/main/CmdLineOpts.lhs
@@ -10,9 +10,10 @@ module CmdLineOpts (
 	SimplifierSwitch(..), 
 	SimplifierMode(..), FloatOutSwitches(..),
 
-	HscLang(..),
+	HscTarget(..),
 	DynFlag(..),	-- needed non-abstractly by DriverFlags
 	DynFlags(..),
+	PackageFlag(..),
 
 	v_Static_hsc_opts,
 
@@ -24,21 +25,11 @@ module CmdLineOpts (
 	dopt_set, dopt_unset,		-- DynFlags -> DynFlag -> DynFlags
 	dopt_CoreToDo,			-- DynFlags -> [CoreToDo]
 	dopt_StgToDo,			-- DynFlags -> [StgToDo]
-	dopt_HscLang,			-- DynFlags -> HscLang
+	dopt_HscTarget,			-- DynFlags -> HscTarget
 	dopt_OutName,			-- DynFlags -> String
 	getOpts,			-- (DynFlags -> [a]) -> IO [a]
-	setLang,
 	getVerbFlag,
-	setOptLevel,
-
-	-- Manipulating the DynFlags state
-	getDynFlags,			-- IO DynFlags
-	setDynFlags,			-- DynFlags -> IO ()
-	updDynFlags, 			-- (DynFlags -> DynFlags) -> IO ()
-	dynFlag,			-- (DynFlags -> a) -> IO a
-	setDynFlag, unSetDynFlag,	-- DynFlag -> IO ()
-	saveDynFlags, 		 	-- IO ()
-	restoreDynFlags,		-- IO DynFlags
+	updOptLevel,
 
 	-- sets of warning opts
 	minusWOpts,
@@ -65,7 +56,8 @@ module CmdLineOpts (
 	opt_Flatten,
 
 	-- optimisation opts
-	opt_NoMethodSharing,
+	opt_NoMethodSharing, 
+	opt_NoStateHack,
 	opt_LiberateCaseThreshold,
 	opt_CprOff,
 	opt_RulesOff,
@@ -83,7 +75,6 @@ module CmdLineOpts (
 
 	-- misc opts
 	opt_ErrorSpans,
-	opt_InPackage,
 	opt_EmitCExternDecls,
 	opt_EnsureSplittableC,
 	opt_GranMacros,
@@ -92,19 +83,23 @@ module CmdLineOpts (
 	opt_OmitBlackHoling,
 	opt_Static,
 	opt_Unregisterised,
-	opt_EmitExternalCore
+	opt_EmitExternalCore,
+	opt_PIC
     ) where
 
 #include "HsVersions.h"
 
+import {-# SOURCE #-} Packages (PackageState)
+import DriverPhases	( HscTarget(..) )
 import Constants	-- Default values for some flags
 import Util
 import FastString	( FastString, mkFastString )
 import Config
 import Maybes		( firstJust )
 
+import Panic		( ghcError, GhcException(UsageError) )
 import GLAEXTS
-import DATA_IOREF	( IORef, readIORef, writeIORef )
+import DATA_IOREF	( IORef, readIORef )
 import UNSAFE_IO	( unsafePerformIO )
 \end{code}
 
@@ -208,7 +203,7 @@ data FloatOutSwitches
 data DynFlag
 
    -- debugging flags
-   = Opt_D_dump_absC
+   = Opt_D_dump_cmm
    | Opt_D_dump_asm
    | Opt_D_dump_cpranal
    | Opt_D_dump_deriv
@@ -218,7 +213,6 @@ data DynFlag
    | Opt_D_dump_inlinings
    | Opt_D_dump_occur_anal
    | Opt_D_dump_parsed
-   | Opt_D_dump_realC
    | Opt_D_dump_rn
    | Opt_D_dump_simpl
    | Opt_D_dump_simpl_iterations
@@ -233,7 +227,7 @@ data DynFlag
    | Opt_D_dump_worker_wrapper
    | Opt_D_dump_rn_trace
    | Opt_D_dump_rn_stats
-   | Opt_D_dump_stix
+   | Opt_D_dump_opt_cmm
    | Opt_D_dump_simpl_stats
    | Opt_D_dump_tc_trace
    | Opt_D_dump_if_trace
@@ -248,11 +242,13 @@ data DynFlag
    | Opt_D_dump_minimal_imports
    | Opt_DoCoreLinting
    | Opt_DoStgLinting
+   | Opt_DoCmmLinting
 
    | Opt_WarnIsError		-- -Werror; makes warnings fatal
    | Opt_WarnDuplicateExports
    | Opt_WarnHiShadows
    | Opt_WarnIncompletePatterns
+   | Opt_WarnIncompletePatternsRecUpd
    | Opt_WarnMissingFields
    | Opt_WarnMissingMethods
    | Opt_WarnMissingSigs
@@ -264,13 +260,14 @@ data DynFlag
    | Opt_WarnUnusedImports
    | Opt_WarnUnusedMatches
    | Opt_WarnDeprecations
-   | Opt_WarnMisc
+   | Opt_WarnDodgyImports
+   | Opt_WarnOrphans
 
    -- language opts
    | Opt_AllowOverlappingInstances
    | Opt_AllowUndecidableInstances
    | Opt_AllowIncoherentInstances
-   | Opt_NoMonomorphismRestriction
+   | Opt_MonomorphismRestriction
    | Opt_GlasgowExts
    | Opt_FFI
    | Opt_PArr			       -- syntactic support for parallel arrays
@@ -278,7 +275,8 @@ data DynFlag
    | Opt_TH
    | Opt_ImplicitParams
    | Opt_Generics
-   | Opt_NoImplicitPrelude 
+   | Opt_ImplicitPrelude 
+   | Opt_ScopedTypeVariables
 
    -- optimisation opts
    | Opt_Strictness
@@ -297,7 +295,7 @@ data DynFlag
 data DynFlags = DynFlags {
   coreToDo   		:: Maybe [CoreToDo], -- reserved for use with -Ofile
   stgToDo    		:: [StgToDo],
-  hscLang    		:: HscLang,
+  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
@@ -308,8 +306,10 @@ data DynFlags = DynFlags {
   ruleCheck		:: Maybe String,
   cppFlag    		:: Bool,	-- preprocess with cpp?
   ppFlag                :: Bool,        -- preprocess with a Haskell Pp?
+  recompFlag		:: Bool,	-- True <=> recompilation checker is on
   stolen_x86_regs	:: Int,		
   cmdlineHcIncludes	:: [String],	-- -#includes
+  importPaths		:: [FilePath],
 
   -- options for particular phases
   opt_L			:: [String],
@@ -323,29 +323,39 @@ data DynFlags = DynFlags {
   opt_i			:: [String],
 #endif
 
+  -- ** Package flags
+  extraPkgConfs		:: [FilePath],
+	-- The -package-conf flags given on the command line, in the order
+	-- they appeared.
+
+  readUserPkgConf	:: Bool,
+	-- Whether or not to read the user package database
+	-- (-no-user-package-conf).
+
+  packageFlags		:: [PackageFlag],
+	-- The -package and -hide-package flags from the command-line
+
+  -- ** Package state
+  pkgState		:: PackageState,
+
   -- hsc dynamic flags
   flags      		:: [DynFlag]
  }
 
-data HscLang
-  = HscC
-  | HscAsm
-  | HscJava
-  | HscILX
-  | HscInterpreted
-  | HscNothing
-    deriving (Eq, Show)
-
-defaultHscLang
-  | cGhcWithNativeCodeGen == "YES" && 
-	(prefixMatch "i386" cTARGETPLATFORM ||
-	 prefixMatch "sparc" cTARGETPLATFORM ||
-	 prefixMatch "powerpc" cTARGETPLATFORM)   =  HscAsm
-  | otherwise					=  HscC
+data PackageFlag
+  = ExposePackage  String
+  | HidePackage    String
+  | IgnorePackage  String
+
+defaultHscTarget
+#if defined(i386_TARGET_ARCH) || defined(sparc_TARGET_ARCH) || defined(powerpc_TARGET_ARCH)
+  | cGhcWithNativeCodeGen == "YES" 	=  HscAsm
+#endif
+  | otherwise				=  HscC
 
 defaultDynFlags = DynFlags {
   coreToDo = Nothing, stgToDo = [], 
-  hscLang = defaultHscLang, 
+  hscTarget = defaultHscTarget, 
   hscOutName = "", 
   hscStubHOutName = "", hscStubCOutName = "",
   extCoreName = "",
@@ -355,8 +365,10 @@ defaultDynFlags = DynFlags {
   ruleCheck		= Nothing,
   cppFlag		= False,
   ppFlag                = False,
+  recompFlag		= True,
   stolen_x86_regs	= 4,
   cmdlineHcIncludes	= [],
+  importPaths		= ["."],
   opt_L			= [],
   opt_P			= [],
   opt_F                 = [],
@@ -367,7 +379,15 @@ defaultDynFlags = DynFlags {
   opt_I                 = [],
   opt_i                 = [],
 #endif
+
+  extraPkgConfs		= [],
+  readUserPkgConf	= True,
+  packageFlags		= [],
+  pkgState		= error "pkgState",
+
   flags = [ 
+	    Opt_ImplicitPrelude,
+	    Opt_MonomorphismRestriction,
 	    Opt_Generics,
 			-- Generating the helper-functions for
 			-- generics is now on by default
@@ -413,8 +433,8 @@ dopt_StgToDo = stgToDo
 dopt_OutName :: DynFlags -> String
 dopt_OutName = hscOutName
 
-dopt_HscLang :: DynFlags -> HscLang
-dopt_HscLang = hscLang
+dopt_HscTarget :: DynFlags -> HscTarget
+dopt_HscTarget = hscTarget
 
 dopt_set :: DynFlags -> DynFlag -> DynFlags
 dopt_set dfs f = dfs{ flags = f : flags dfs }
@@ -422,35 +442,20 @@ dopt_set dfs f = dfs{ flags = f : flags dfs }
 dopt_unset :: DynFlags -> DynFlag -> DynFlags
 dopt_unset dfs f = dfs{ flags = filter (/= f) (flags dfs) }
 
-getOpts :: (DynFlags -> [a]) -> IO [a]
+getOpts :: DynFlags -> (DynFlags -> [a]) -> [a]
 	-- We add to the options from the front, so we need to reverse the list
-getOpts opts = dynFlag opts >>= return . reverse
-
--- we can only switch between HscC, HscAsmm, and HscILX with dynamic flags 
--- (-fvia-C, -fasm, -filx respectively).
-setLang l = updDynFlags (\ dfs -> case hscLang dfs of
-					HscC   -> dfs{ hscLang = l }
-					HscAsm -> dfs{ hscLang = l }
-					HscILX -> dfs{ hscLang = l }
-					_      -> dfs)
+getOpts dflags opts = reverse (opts dflags)
 
-getVerbFlag = do
-   verb <- dynFlag verbosity
-   if verb >= 3  then return  "-v" else return ""
+getVerbFlag dflags 
+  | verbosity dflags >= 3  = "-v" 
+  | otherwise =  ""
 
 -----------------------------------------------------------------------------
 -- Setting the optimisation level
 
-setOptLevel :: Int -> IO ()
-setOptLevel n 
-  = do dflags <- getDynFlags
-       if hscLang dflags == HscInterpreted && n > 0
-	  then putStr "warning: -O conflicts with --interactive; -O ignored.\n"
-	  else updDynFlags (setOptLevel' n)
-
-setOptLevel' n dfs
+updOptLevel n dfs
   = if (n >= 1)
-     then dfs2{ hscLang = HscC, optLevel = n } -- turn on -fvia-C with -O
+     then dfs2{ hscTarget = HscC, optLevel = n } -- turn on -fvia-C with -O
      else dfs2{ optLevel = n }
   where
    dfs1 = foldr (flip dopt_unset) dfs  remove_dopts
@@ -607,51 +612,8 @@ buildCoreToDo dflags = core_todo
 	  MaxSimplifierIterations max_iter
 	]
      ]
-
--- --------------------------------------------------------------------------
--- Mess about with the mutable variables holding the dynamic arguments
-
--- v_InitDynFlags 
---	is the "baseline" dynamic flags, initialised from
--- 	the defaults and command line options, and updated by the
---	':s' command in GHCi.
---
--- v_DynFlags
---	is the dynamic flags for the current compilation.  It is reset
---	to the value of v_InitDynFlags before each compilation, then
---	updated by reading any OPTIONS pragma in the current module.
-
-GLOBAL_VAR(v_InitDynFlags, defaultDynFlags, DynFlags)
-GLOBAL_VAR(v_DynFlags,     defaultDynFlags, DynFlags)
-
-setDynFlags :: DynFlags -> IO ()
-setDynFlags dfs = writeIORef v_DynFlags dfs
-
-saveDynFlags :: IO ()
-saveDynFlags = do dfs <- readIORef v_DynFlags
-		  writeIORef v_InitDynFlags dfs
-
-restoreDynFlags :: IO DynFlags
-restoreDynFlags = do dfs <- readIORef v_InitDynFlags
-		     writeIORef v_DynFlags dfs
-		     return dfs
-
-getDynFlags :: IO DynFlags
-getDynFlags = readIORef v_DynFlags
-
-updDynFlags :: (DynFlags -> DynFlags) -> IO ()
-updDynFlags f = do dfs <- readIORef v_DynFlags
-		   writeIORef v_DynFlags (f dfs)
-
-dynFlag :: (DynFlags -> a) -> IO a
-dynFlag f = do dflags <- readIORef v_DynFlags; return (f dflags)
-
-setDynFlag, unSetDynFlag :: DynFlag -> IO ()
-setDynFlag f   = updDynFlags (\dfs -> dopt_set dfs f)
-unSetDynFlag f = updDynFlags (\dfs -> dopt_unset dfs f)
 \end{code}
 
-
 %************************************************************************
 %*									*
 \subsection{Warnings}
@@ -673,7 +635,7 @@ minusWOpts
 	Opt_WarnUnusedMatches,
 	Opt_WarnUnusedImports,
 	Opt_WarnIncompletePatterns,
-	Opt_WarnMisc
+	Opt_WarnDodgyImports
       ]
 
 minusWallOpts
@@ -681,7 +643,8 @@ minusWallOpts
       [	Opt_WarnTypeDefaults,
 	Opt_WarnNameShadowing,
 	Opt_WarnMissingSigs,
-	Opt_WarnHiShadows
+	Opt_WarnHiShadows,
+	Opt_WarnOrphans
       ]
 \end{code}
 
@@ -697,7 +660,6 @@ minusWallOpts
 GLOBAL_VAR(v_Static_hsc_opts, [], [String])
 
 lookUp	       	 :: FastString -> Bool
-lookup_int     	 :: String -> Maybe Int
 lookup_def_int   :: String -> Int -> Int
 lookup_def_float :: String -> Float -> Float
 lookup_str       :: String -> Maybe String
@@ -707,19 +669,32 @@ packed_static_opts   = map mkFastString unpacked_static_opts
 
 lookUp     sw = sw `elem` packed_static_opts
 	
-lookup_str sw = firstJust (map (startsWith sw) unpacked_static_opts)
-
-lookup_int sw = case (lookup_str sw) of
-		  Nothing -> Nothing
-		  Just xx -> Just (read xx)
+-- (lookup_str "foo") looks for the flag -foo=X or -fooX, 
+-- and returns the string X
+lookup_str sw 
+   = case firstJust (map (startsWith sw) unpacked_static_opts) of
+	Just ('=' : str) -> Just str
+	Just str         -> Just str
+	Nothing		 -> Nothing	
 
 lookup_def_int sw def = case (lookup_str sw) of
 			    Nothing -> def		-- Use default
-		  	    Just xx -> read xx
+		  	    Just xx -> try_read sw xx
 
 lookup_def_float sw def = case (lookup_str sw) of
 			    Nothing -> def		-- Use default
-		  	    Just xx -> read xx
+		  	    Just xx -> try_read sw xx
+
+
+try_read :: Read a => String -> String -> a
+-- (try_read sw str) tries to read s; if it fails, it
+-- bleats about flag sw
+try_read sw str
+  = case reads str of
+	((x,_):_) -> x	-- Be forgiving: ignore trailing goop, and alternative parses
+	[]	  -> ghcError (UsageError ("Malformed argument " ++ str ++ " for flag " ++ sw))
+			-- ToDo: hack alert. We should really parse the arugments
+			-- 	 and announce errors in a more civilised way.
 
 
 {-
@@ -758,7 +733,6 @@ opt_SccProfilingOn		= lookUp  FSLIT("-fscc-profiling")
 opt_DoTickyProfiling		= lookUp  FSLIT("-fticky-ticky")
 
 -- language opts
-opt_AllStrict			= lookUp  FSLIT("-fall-strict")
 opt_DictsStrict			= lookUp  FSLIT("-fdicts-strict")
 opt_IrrefutableTuples		= lookUp  FSLIT("-firrefutable-tuples")
 opt_MaxContextReductionDepth	= lookup_def_int "-fcontext-stack" mAX_CONTEXT_REDUCTION_DEPTH
@@ -767,6 +741,7 @@ opt_SMP				= lookUp  FSLIT("-fsmp")
 opt_Flatten			= lookUp  FSLIT("-fflatten")
 
 -- optimisation opts
+opt_NoStateHack			= lookUp  FSLIT("-fno-state-hack")
 opt_NoMethodSharing		= lookUp  FSLIT("-fno-method-sharing")
 opt_CprOff			= lookUp  FSLIT("-fcpr-off")
 opt_RulesOff			= lookUp  FSLIT("-frules-off")
@@ -774,15 +749,6 @@ opt_RulesOff			= lookUp  FSLIT("-frules-off")
 opt_LiberateCaseThreshold	= lookup_def_int "-fliberate-case-threshold" (10::Int)
 opt_MaxWorkerArgs		= lookup_def_int "-fmax-worker-args" (10::Int)
 
-{-
-   The optional '-inpackage=P' flag tells what package
-   we are compiling this module for.
-   The Prelude, for example is compiled with '-inpackage std'
--}
-opt_InPackage			= case lookup_str "-inpackage=" of
-				    Just p  -> mkFastString p
-				    Nothing -> FSLIT("Main")	-- The package name if none is specified
-
 opt_EmitCExternDecls	        = lookUp  FSLIT("-femit-extern-decls")
 opt_EnsureSplittableC		= lookUp  FSLIT("-fglobalise-toplev-names")
 opt_GranMacros			= lookUp  FSLIT("-fgransim")
@@ -812,6 +778,8 @@ opt_EmitExternalCore		= lookUp  FSLIT("-fext-core")
 
 -- Include full span info in error messages, instead of just the start position.
 opt_ErrorSpans			= lookUp FSLIT("-ferror-spans")
+
+opt_PIC                         = lookUp FSLIT("-fPIC")
 \end{code}
 
 %************************************************************************
@@ -843,18 +811,19 @@ isStaticHscFlag f =
 	"fno-hi-version-check",
 	"dno-black-holing",
 	"fno-method-sharing",
+	"fno-state-hack",
 	"fruntime-types",
 	"fno-pre-inlining",
 	"fexcess-precision",
 	"funfolding-update-in-place",
-	"fno-prune-decls",
 	"static",
 	"funregisterised",
 	"fext-core",
 	"frule-check",
 	"frules-off",
 	"fcpr-off",
-	"ferror-spans"
+	"ferror-spans",
+	"fPIC"
 	]
   || any (flip prefixMatch f) [
 	"fcontext-stack",
@@ -884,10 +853,4 @@ startsWith []     str = Just str
 startsWith (c:cs) (s:ss)
   = if c /= s then Nothing else startsWith cs ss
 startsWith  _	  []  = Nothing
-
-endsWith  :: String -> String -> Maybe String
-endsWith cs ss
-  = case (startsWith (reverse cs) (reverse ss)) of
-      Nothing -> Nothing
-      Just rs -> Just (reverse rs)
 \end{code}