diff options
author | Sylvain Henry <sylvain@haskus.fr> | 2020-10-19 10:36:10 +0200 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2020-10-19 18:16:58 -0400 |
commit | 9648d680b4b07d48cf8741e0847abf07b95c7c1d (patch) | |
tree | 5ef1b877e580a6bccde4d74b91abced771778ba3 | |
parent | b5b3e34ec39fc89a0bcd0b60cf9a4962c89ba72f (diff) | |
download | haskell-9648d680b4b07d48cf8741e0847abf07b95c7c1d.tar.gz |
Remove pdocPrec
pdocPrec was only used in GHC.Cmm.DebugBlock.pprUnwindExpr, so remove
it. OutputableP becomes a one-function class which might be better for
performance.
-rw-r--r-- | compiler/GHC/Cmm/DebugBlock.hs | 29 | ||||
-rw-r--r-- | compiler/GHC/Utils/Outputable.hs | 6 |
2 files changed, 17 insertions, 18 deletions
diff --git a/compiler/GHC/Cmm/DebugBlock.hs b/compiler/GHC/Cmm/DebugBlock.hs index d5410b9b6a..3131b83d5a 100644 --- a/compiler/GHC/Cmm/DebugBlock.hs +++ b/compiler/GHC/Cmm/DebugBlock.hs @@ -5,6 +5,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE LambdaCase #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} @@ -520,18 +521,22 @@ data UnwindExpr = UwConst !Int -- ^ literal value deriving (Eq) instance OutputableP env CLabel => OutputableP env UnwindExpr where - pdocPrec _ _ (UwConst i) = ppr i - pdocPrec _ _ (UwReg g 0) = ppr g - pdocPrec p env (UwReg g x) = pdocPrec p env (UwPlus (UwReg g 0) (UwConst x)) - pdocPrec _ env (UwDeref e) = char '*' <> pdocPrec 3 env e - pdocPrec _ env (UwLabel l) = pdocPrec 3 env l - pdocPrec p env (UwPlus e0 e1) | p <= 0 - = pdocPrec 0 env e0 <> char '+' <> pdocPrec 0 env e1 - pdocPrec p env (UwMinus e0 e1) | p <= 0 - = pdocPrec 1 env e0 <> char '-' <> pdocPrec 1 env e1 - pdocPrec p env (UwTimes e0 e1) | p <= 1 - = pdocPrec 2 env e0 <> char '*' <> pdocPrec 2 env e1 - pdocPrec _ env other = parens (pdocPrec 0 env other) + pdoc = pprUnwindExpr 0 + +pprUnwindExpr :: OutputableP env CLabel => Rational -> env -> UnwindExpr -> SDoc +pprUnwindExpr p env = \case + UwConst i -> ppr i + UwReg g 0 -> ppr g + UwReg g x -> pprUnwindExpr p env (UwPlus (UwReg g 0) (UwConst x)) + UwDeref e -> char '*' <> pprUnwindExpr 3 env e + UwLabel l -> pdoc env l + UwPlus e0 e1 + | p <= 0 -> pprUnwindExpr 0 env e0 <> char '+' <> pprUnwindExpr 0 env e1 + UwMinus e0 e1 + | p <= 0 -> pprUnwindExpr 1 env e0 <> char '-' <> pprUnwindExpr 1 env e1 + UwTimes e0 e1 + | p <= 1 -> pprUnwindExpr 2 env e0 <> char '*' <> pprUnwindExpr 2 env e1 + other -> parens (pprUnwindExpr 0 env other) -- | Conversion of Cmm expressions to unwind expressions. We check for -- unsupported operator usages and simplify the expression as far as diff --git a/compiler/GHC/Utils/Outputable.hs b/compiler/GHC/Utils/Outputable.hs index 025f2bdae9..ea9c8daecd 100644 --- a/compiler/GHC/Utils/Outputable.hs +++ b/compiler/GHC/Utils/Outputable.hs @@ -1045,12 +1045,6 @@ instance Outputable Extension where -- See Note [The OutputableP class] class OutputableP env a where pdoc :: env -> a -> SDoc - pdocPrec :: Rational -> env -> a -> SDoc - -- 0 binds least tightly - -- We use Rational because there is always a - -- Rational between any other two Rationals - pdoc = pdocPrec 0 - pdocPrec _ = pdoc -- | Wrapper for types having a Outputable instance when an OutputableP instance -- is required. |