summaryrefslogtreecommitdiff
path: root/compiler/GHC/Cmm/Dataflow
diff options
context:
space:
mode:
authorSylvain Henry <sylvain@haskus.fr>2020-09-02 19:42:01 +0200
committerMarge Bot <ben+marge-bot@smart-cactus.org>2020-09-17 20:04:08 -0400
commitca48076ae866665913b9c81cbc0c76f0afef7a00 (patch)
tree52ad46e313b99fc564bd77de2efeb0bfb8babb47 /compiler/GHC/Cmm/Dataflow
parent9dec8600ad4734607bea2b4dc3b40a5af788996b (diff)
downloadhaskell-ca48076ae866665913b9c81cbc0c76f0afef7a00.tar.gz
Introduce OutputableP
Some types need a Platform value to be pretty-printed: CLabel, Cmm types, instructions, etc. Before this patch they had an Outputable instance and the Platform value was obtained via sdocWithDynFlags. It meant that the *renderer* of the SDoc was responsible of passing the appropriate Platform value (e.g. via the DynFlags given to showSDoc). It put the burden of passing the Platform value on the renderer while the generator of the SDoc knows the Platform it is generating the SDoc for and there is no point passing a different Platform at rendering time. With this patch, we introduce a new OutputableP class: class OutputableP a where pdoc :: Platform -> a -> SDoc With this class we still have some polymorphism as we have with `ppr` (i.e. we can use `pdoc` on a variety of types instead of having a dedicated `pprXXX` function for each XXX type). One step closer removing `sdocWithDynFlags` (#10143) and supporting several platforms (#14335).
Diffstat (limited to 'compiler/GHC/Cmm/Dataflow')
-rw-r--r--compiler/GHC/Cmm/Dataflow/Label.hs6
1 files changed, 6 insertions, 0 deletions
diff --git a/compiler/GHC/Cmm/Dataflow/Label.hs b/compiler/GHC/Cmm/Dataflow/Label.hs
index a63cc63ed8..e01f301627 100644
--- a/compiler/GHC/Cmm/Dataflow/Label.hs
+++ b/compiler/GHC/Cmm/Dataflow/Label.hs
@@ -43,6 +43,9 @@ instance Uniquable Label where
instance Outputable Label where
ppr label = ppr (getUnique label)
+instance OutputableP Label where
+ pdoc _ l = ppr l
+
-----------------------------------------------------------------------------
-- LabelSet
@@ -128,6 +131,9 @@ instance Outputable LabelSet where
instance Outputable a => Outputable (LabelMap a) where
ppr = ppr . mapToList
+instance OutputableP a => OutputableP (LabelMap a) where
+ pdoc platform = pdoc platform . mapToList
+
instance TrieMap LabelMap where
type Key LabelMap = Label
emptyTM = mapEmpty