More DynFlags + SDocsdoc

3 files changed, 17 insertions, 8 deletions

diff --git a/compiler/utils/GraphOps.hs b/compiler/utils/GraphOps.hs
index 1fa4199aa2..55c22ade2a 100644
--- a/compiler/utils/GraphOps.hs
+++ b/compiler/utils/GraphOps.hs
@@ -21,6 +21,7 @@ where
 
 import GraphBase
 
+import DynFlags
 import Outputable
 import Unique
 import UniqSet
@@ -510,12 +511,13 @@ scanGraph match graph
 --
 validateGraph
 	:: (Uniquable k, Outputable k, Eq color)
-	=> SDoc				-- ^ extra debugging info to display on error
+	=> DynFlags
+	-> SDoc				-- ^ extra debugging info to display on error
 	-> Bool				-- ^ whether this graph is supposed to be colored.
 	-> Graph k cls color		-- ^ graph to validate
 	-> Graph k cls color		-- ^ validated graph
 
-validateGraph doc isColored graph
+validateGraph dflags doc isColored graph
 
 	-- Check that all edges point to valid nodes.
   	| edges		<- unionManyUniqSets
@@ -525,7 +527,7 @@ validateGraph doc isColored graph
 	, nodes		<- mkUniqSet $ map nodeId $ eltsUFM $ graphMap graph
 	, badEdges 	<- minusUniqSet edges nodes
 	, not $ isEmptyUniqSet badEdges
-	= pprPanic "GraphOps.validateGraph"
+	= pprPanic dflags "GraphOps.validateGraph"
 		(  text "Graph has edges that point to non-existant nodes"
 		$$ text "  bad edges: " <> vcat (map ppr $ uniqSetToList badEdges)
 		$$ doc )
diff --git a/compiler/utils/ListSetOps.lhs b/compiler/utils/ListSetOps.lhs
index 83334fbb28..5cc53488da 100644
--- a/compiler/utils/ListSetOps.lhs
+++ b/compiler/utils/ListSetOps.lhs
@@ -25,6 +25,7 @@ import Outputable
 import Unique
 import UniqFM
 import Util
+import DynFlags
 
 import Data.List
 \end{code}
@@ -43,10 +44,10 @@ insertList :: Eq a => a -> [a] -> [a]
 insertList x xs | isIn "insert" x xs = xs
                 | otherwise          = x : xs
 
-unionLists :: (Outputable a, Eq a) => [a] -> [a] -> [a]
+unionLists :: (Outputable a, Eq a) => DynFlags -> [a] -> [a] -> [a]
 -- Assumes that the arguments contain no duplicates
-unionLists xs ys 
-  = WARN(length xs > 100 || length ys > 100, ppr xs $$ ppr ys)
+unionLists dflags xs ys
+  = WARN(dflags, length xs > 100 || length ys > 100, ppr xs $$ ppr ys)
     [x | x <- xs, isn'tIn "unionLists" x ys] ++ ys
 
 minusList :: (Eq a) => [a] -> [a] -> [a]
diff --git a/compiler/utils/Outputable.lhs b/compiler/utils/Outputable.lhs
index 3fd0915a22..12540dbc39 100644
--- a/compiler/utils/Outputable.lhs
+++ b/compiler/utils/Outputable.lhs
@@ -16,6 +16,7 @@ module Outputable (
 
         -- * Pretty printing combinators
 	SDoc, runSDoc, initSDocContext,
+	sdocWithDynFlags,
 	docToSDoc,
 	interppSP, interpp'SP, pprQuotedList, pprWithCommas, quotedListWithOr,
 	empty, nest,
@@ -246,6 +247,11 @@ initSDocContext' dflags sty = SDC
   , sdocDynFlags = dflags
   }
 
+sdocWithDynFlags :: (DynFlags -> SDoc) -> SDoc
+sdocWithDynFlags f = SDoc (\sdc -> case f (sdocDynFlags sdc) of
+                                   SDoc mkDoc ->
+                                       mkDoc sdc)
+
 withPprStyle :: PprStyle -> SDoc -> SDoc
 withPprStyle sty d = SDoc $ \ctxt -> runSDoc d ctxt{sdocStyle=sty}
 
@@ -873,9 +879,9 @@ plural _   = char 's'
 
 \begin{code}
 
-pprPanic :: String -> SDoc -> a
+pprPanic :: DynFlags -> String -> SDoc -> a
 -- ^ Throw an exception saying "bug in GHC"
-pprPanic    = pprAndThen panic
+pprPanic _ = pprAndThen panic
 
 pprSorry :: String -> SDoc -> a
 -- ^ Throw an exceptio saying "this isn't finished yet"