Commit 37f9861f authored by Ian Lynagh's avatar Ian Lynagh
Browse files

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.
parent 1eda228c
...@@ -95,12 +95,15 @@ module DynFlags ( ...@@ -95,12 +95,15 @@ module DynFlags (
getStgToDo, getStgToDo,
-- * Compiler configuration suitable for display to the user -- * Compiler configuration suitable for display to the user
compilerInfo compilerInfo,
#ifdef GHCI #ifdef GHCI
-- Only in stage 2 can we be sure that the RTS -- Only in stage 2 can we be sure that the RTS
-- exposes the appropriate runtime boolean -- exposes the appropriate runtime boolean
, rtsIsProfiled rtsIsProfiled,
#endif #endif
-- ** Only for use in the tracing functions in Outputable
tracingDynFlags,
) where ) where
#include "HsVersions.h" #include "HsVersions.h"
...@@ -969,6 +972,16 @@ defaultDynFlags mySettings = ...@@ -969,6 +972,16 @@ defaultDynFlags mySettings =
llvmVersion = panic "defaultDynFlags: No llvmVersion" 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 FatalMessager = String -> IO ()
type LogAction = DynFlags -> Severity -> SrcSpan -> PprStyle -> MsgDoc -> IO () type LogAction = DynFlags -> Severity -> SrcSpan -> PprStyle -> MsgDoc -> IO ()
......
...@@ -2,3 +2,5 @@ ...@@ -2,3 +2,5 @@
module DynFlags where module DynFlags where
data DynFlags data DynFlags
tracingDynFlags :: DynFlags
...@@ -71,7 +71,7 @@ module Outputable ( ...@@ -71,7 +71,7 @@ module Outputable (
pprDebugAndThen, pprDebugAndThen,
) where ) where
import {-# SOURCE #-} DynFlags( DynFlags ) import {-# SOURCE #-} DynFlags( DynFlags, tracingDynFlags )
import {-# SOURCE #-} Module( Module, ModuleName, moduleName ) import {-# SOURCE #-} Module( Module, ModuleName, moduleName )
import {-# SOURCE #-} Name( Name, nameModule ) import {-# SOURCE #-} Name( Name, nameModule )
...@@ -953,14 +953,6 @@ assertPprPanic file line msg ...@@ -953,14 +953,6 @@ assertPprPanic file line msg
, text "line", int line ] , text "line", int line ]
, msg ] , 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 :: DynFlags -> (String -> a) -> String -> SDoc -> a
pprDebugAndThen dflags cont heading pretty_msg pprDebugAndThen dflags cont heading pretty_msg
= cont (show (runSDoc doc (initSDocContext dflags PprDebug))) = cont (show (runSDoc doc (initSDocContext dflags PprDebug)))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment