diff options
Diffstat (limited to 'compiler/utils')
| -rw-r--r-- | compiler/utils/GraphOps.hs | 8 | ||||
| -rw-r--r-- | compiler/utils/ListSetOps.lhs | 7 | ||||
| -rw-r--r-- | compiler/utils/Outputable.lhs | 10 |
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" |