[commit: ghc] master: Make tracingDynFlags slightly more defined (37f9861)
Ian Lynagh
igloo at earth.li
Wed Jun 13 17:16:55 CEST 2012
Repository : ssh://darcs.haskell.org//srv/darcs/ghc
On branch : master
http://hackage.haskell.org/trac/ghc/changeset/37f9861ff65552c2bb6a85c3b27e0228275bc0b6
>---------------------------------------------------------------
commit 37f9861ff65552c2bb6a85c3b27e0228275bc0b6
Author: Ian Lynagh <igloo at earth.li>
Date: Tue Jun 12 23:29:53 2012 +0100
Make tracingDynFlags slightly more defined
In particular, fields like 'flags' are now set to the default,
so at least they will work to some extent.
>---------------------------------------------------------------
compiler/main/DynFlags.hs | 17 +++++++++++++++--
compiler/main/DynFlags.hs-boot | 2 ++
compiler/utils/Outputable.lhs | 10 +---------
3 files changed, 18 insertions(+), 11 deletions(-)
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 8bbf364..b832480 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -95,12 +95,15 @@ module DynFlags (
getStgToDo,
-- * Compiler configuration suitable for display to the user
- compilerInfo
+ compilerInfo,
+
#ifdef GHCI
-- Only in stage 2 can we be sure that the RTS
-- exposes the appropriate runtime boolean
- , rtsIsProfiled
+ rtsIsProfiled,
#endif
+ -- ** Only for use in the tracing functions in Outputable
+ tracingDynFlags,
) where
#include "HsVersions.h"
@@ -969,6 +972,16 @@ defaultDynFlags mySettings =
llvmVersion = panic "defaultDynFlags: No llvmVersion"
}
+-- Do not use tracingDynFlags!
+-- tracingDynFlags is a hack, necessary because we need to be able to
+-- show SDocs when tracing, but we don't always have DynFlags available.
+-- Do not use it if you can help it. It will not reflect options set
+-- by the commandline flags, and all fields may be either wrong or
+-- undefined.
+tracingDynFlags :: DynFlags
+tracingDynFlags = defaultDynFlags tracingSettings
+ where tracingSettings = panic "Settings not defined in tracingDynFlags"
+
type FatalMessager = String -> IO ()
type LogAction = DynFlags -> Severity -> SrcSpan -> PprStyle -> MsgDoc -> IO ()
diff --git a/compiler/main/DynFlags.hs-boot b/compiler/main/DynFlags.hs-boot
index f7d17f4..7530192 100644
--- a/compiler/main/DynFlags.hs-boot
+++ b/compiler/main/DynFlags.hs-boot
@@ -2,3 +2,5 @@
module DynFlags where
data DynFlags
+tracingDynFlags :: DynFlags
+
diff --git a/compiler/utils/Outputable.lhs b/compiler/utils/Outputable.lhs
index b402747..696d803 100644
--- a/compiler/utils/Outputable.lhs
+++ b/compiler/utils/Outputable.lhs
@@ -71,7 +71,7 @@ module Outputable (
pprDebugAndThen,
) where
-import {-# SOURCE #-} DynFlags( DynFlags )
+import {-# SOURCE #-} DynFlags( DynFlags, tracingDynFlags )
import {-# SOURCE #-} Module( Module, ModuleName, moduleName )
import {-# SOURCE #-} Name( Name, nameModule )
@@ -953,14 +953,6 @@ assertPprPanic file line msg
, text "line", int line ]
, msg ]
--- tracingDynFlags is a hack, necessary because we need to be able to
--- show SDocs when tracing, but we don't always have DynFlags available.
--- Do not use it if you can help it. It will not reflect options set
--- by the commandline flags, it may hav the wrong target platform, etc.
--- Currently it just panics if you try to use it.
-tracingDynFlags :: DynFlags
-tracingDynFlags = panic "tracingDynFlags used"
-
pprDebugAndThen :: DynFlags -> (String -> a) -> String -> SDoc -> a
pprDebugAndThen dflags cont heading pretty_msg
= cont (show (runSDoc doc (initSDocContext dflags PprDebug)))
More information about the Cvs-ghc
mailing list