X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FStaticFlagParser.hs;h=56c9cbb4bdb6de4c5074576486cd0c69b44bdf27;hb=a200038f469418fef77d863dc3d1cd0125ec1e82;hp=c0a501e8e31c647fec0e98956ed8ce46b4b7cf9e;hpb=fb9d3922c8ccc9b3f7138a821ffb635e6c65b149;p=ghc-hetmet.git

diff --git a/compiler/main/StaticFlagParser.hs b/compiler/main/StaticFlagParser.hs
index c0a501e..56c9cbb 100644
--- a/compiler/main/StaticFlagParser.hs
+++ b/compiler/main/StaticFlagParser.hs
@@ -16,6 +16,7 @@ module StaticFlagParser (parseStaticFlags) where
 import StaticFlags
 import CmdLineParser
 import Config
+import SrcLoc
 import Util
 import Panic
 
@@ -27,23 +28,39 @@ import Data.List
 -----------------------------------------------------------------------------
 -- Static flags
 
-parseStaticFlags :: [String] -> IO ([String], [String])
+-- | Parses GHC's static flags from a list of command line arguments.
+--
+-- These flags are static in the sense that they can be set only once and they
+-- are global, meaning that they affect every instance of GHC running;
+-- multiple GHC threads will use the same flags.
+--
+-- This function must be called before any session is started, i.e., before
+-- the first call to 'GHC.withGhc'.
+--
+-- Static flags are more of a hack and are static for more or less historical
+-- reasons.  In the long run, most static flags should eventually become
+-- dynamic flags.
+--
+-- XXX: can we add an auto-generated list of static flags here?
+--
+parseStaticFlags :: [Located String] -> IO ([Located String], [Located String])
 parseStaticFlags args = do
   ready <- readIORef v_opt_C_ready
   when ready $ ghcError (ProgramError "Too late for parseStaticFlags: call it before newSession")
 
   (leftover, errs, warns1) <- processArgs static_flags args
-  when (not (null errs)) $ ghcError (UsageError (unlines errs))
+  when (not (null errs)) $ ghcError $ errorsToGhcException errs
 
     -- deal with the way flags: the way (eg. prof) gives rise to
     -- further flags, some of which might be static.
   way_flags <- findBuildTag
+  let way_flags' = map (mkGeneralLocated "in way flags") way_flags
 
     -- if we're unregisterised, add some more flags
   let unreg_flags | cGhcUnregisterised == "YES" = unregFlags
 		  | otherwise = []
 
-  (more_leftover, errs, warns2) <- processArgs static_flags (unreg_flags ++ way_flags)
+  (more_leftover, errs, warns2) <- processArgs static_flags (unreg_flags ++ way_flags')
 
     -- see sanity code in staticOpts
   writeIORef v_opt_C_ready True
@@ -52,16 +69,19 @@ parseStaticFlags args = do
     -- Be careful to do this *after* all processArgs,
     -- because evaluating tablesNextToCode involves looking at the global
     -- static flags.  Those pesky global variables...
-  let cg_flags | tablesNextToCode = ["-optc-DTABLES_NEXT_TO_CODE"]
-	       | otherwise	  = []
+  let cg_flags | tablesNextToCode = map (mkGeneralLocated "in cg_flags")
+                                        ["-optc-DTABLES_NEXT_TO_CODE"]
+               | otherwise        = []
 
     -- HACK: -fexcess-precision is both a static and a dynamic flag.  If
     -- the static flag parser has slurped it, we must return it as a 
     -- leftover too.  ToDo: make -fexcess-precision dynamic only.
-  let excess_prec | opt_SimplExcessPrecision = ["-fexcess-precision"]
-                  | otherwise                = []
+  let excess_prec
+       | opt_SimplExcessPrecision = map (mkGeneralLocated "in excess_prec")
+                                        ["-fexcess-precision"]
+       | otherwise                = []
 
-  when (not (null errs)) $ ghcError (UsageError (unlines errs))
+  when (not (null errs)) $ ghcError $ errorsToGhcException errs
   return (excess_prec ++ cg_flags ++ more_leftover ++ leftover,
           warns1 ++ warns2)
 
@@ -181,8 +201,8 @@ isStaticFlag f =
     "funfolding-keeness-factor"
      ]
 
-unregFlags :: [String]
-unregFlags = 
+unregFlags :: [Located String]
+unregFlags = map (mkGeneralLocated "in unregFlags")
    [ "-optc-DNO_REGS"
    , "-optc-DUSE_MINIINTERPRETER"
    , "-fno-asm-mangling"