summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSylvain Henry <sylvain@haskus.fr>2020-10-19 10:36:10 +0200
committerMarge Bot <ben+marge-bot@smart-cactus.org>2020-10-19 18:16:58 -0400
commit9648d680b4b07d48cf8741e0847abf07b95c7c1d (patch)
tree5ef1b877e580a6bccde4d74b91abced771778ba3
parentb5b3e34ec39fc89a0bcd0b60cf9a4962c89ba72f (diff)
downloadhaskell-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.hs29
-rw-r--r--compiler/GHC/Utils/Outputable.hs6
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.