X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Futils%2FOutputable.lhs;h=622138c17d1dd71deb6450618cd3c2412f93105e;hb=c74c72f60dcc4cbea519826e98ec90ad8016b49d;hp=bdad4d3eb100a0b1d245dc40900557b0658f5d4f;hpb=d436c70d43fb905c63220040168295e473f4b90a;p=ghc-hetmet.git diff --git a/compiler/utils/Outputable.lhs b/compiler/utils/Outputable.lhs index bdad4d3..622138c 100644 --- a/compiler/utils/Outputable.lhs +++ b/compiler/utils/Outputable.lhs @@ -29,7 +29,7 @@ module Outputable ( ($$), ($+$), vcat, sep, cat, fsep, fcat, - hang, punctuate, + hang, punctuate, ppWhen, ppUnless, speakNth, speakNTimes, speakN, speakNOf, plural, -- * Converting 'SDoc' into strings and outputing it @@ -71,12 +71,11 @@ import FastString import FastTypes import qualified Pretty import Pretty ( Doc, Mode(..) ) -import Char ( isAlpha ) import Panic -import Data.Word ( Word32 ) +import Data.Char +import Data.Word import System.IO ( Handle, stderr, stdout, hFlush ) -import Data.Char ( ord ) import System.FilePath \end{code} @@ -229,9 +228,9 @@ pprDeeperList f ds (PprUser q (PartWay n)) pprDeeperList f ds other_sty = f ds other_sty -pprSetDepth :: Int -> SDoc -> SDoc -pprSetDepth n d (PprUser q _) = d (PprUser q (PartWay n)) -pprSetDepth _n d other_sty = d other_sty +pprSetDepth :: Depth -> SDoc -> SDoc +pprSetDepth depth doc (PprUser q _) = doc (PprUser q depth) +pprSetDepth _depth doc other_sty = doc other_sty getPprStyle :: (PprStyle -> SDoc) -> SDoc getPprStyle df sty = df sty sty @@ -473,6 +472,13 @@ punctuate p (d:ds) = go d ds where go d [] = [d] go d (e:es) = (d <> p) : go e es + +ppWhen, ppUnless :: Bool -> SDoc -> SDoc +ppWhen True doc = doc +ppWhen False _ = empty + +ppUnless True _ = empty +ppUnless False doc = doc \end{code} @@ -496,9 +502,15 @@ instance Outputable Bool where instance Outputable Int where ppr n = int n +instance Outputable Word16 where + ppr n = integer $ fromIntegral n + instance Outputable Word32 where ppr n = integer $ fromIntegral n +instance Outputable Word where + ppr n = integer $ fromIntegral n + instance Outputable () where ppr _ = text "()"