[commit: ghc] wip/annotate-core: Use NamedThing rather than just outputablebndr (1a9aae8)
git at git.haskell.org
git at git.haskell.org
Thu Jul 27 09:55:49 UTC 2017
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/annotate-core
Link : http://ghc.haskell.org/trac/ghc/changeset/1a9aae88ec8f57393db4992748a7de08c54cfe61/ghc
>---------------------------------------------------------------
commit 1a9aae88ec8f57393db4992748a7de08c54cfe61
Author: Matthew Pickering <matthewtpickering at gmail.com>
Date: Thu Jul 27 09:55:21 2017 +0000
Use NamedThing rather than just outputablebndr
>---------------------------------------------------------------
1a9aae88ec8f57393db4992748a7de08c54cfe61
compiler/coreSyn/CoreSyn.hs | 3 +++
compiler/coreSyn/PprCore.hs | 30 +++++++++++++++---------------
compiler/utils/OutputableAnnotation.hs | 11 ++++++-----
3 files changed, 24 insertions(+), 20 deletions(-)
diff --git a/compiler/coreSyn/CoreSyn.hs b/compiler/coreSyn/CoreSyn.hs
index 41202c3..230c7f2 100644
--- a/compiler/coreSyn/CoreSyn.hs
+++ b/compiler/coreSyn/CoreSyn.hs
@@ -1762,6 +1762,9 @@ type TaggedAlt t = Alt (TaggedBndr t)
instance Outputable b => Outputable (TaggedBndr b) where
ppr (TB b l) = char '<' <> ppr b <> comma <> ppr l <> char '>'
+instance NamedThing (TaggedBndr b) where
+ getName (TB v _) = getName v
+
deTagExpr :: TaggedExpr t -> CoreExpr
deTagExpr (Var v) = Var v
deTagExpr (Lit l) = Lit l
diff --git a/compiler/coreSyn/PprCore.hs b/compiler/coreSyn/PprCore.hs
index 70ae2e1..d4ae498 100644
--- a/compiler/coreSyn/PprCore.hs
+++ b/compiler/coreSyn/PprCore.hs
@@ -18,7 +18,7 @@ module PprCore (
import CoreSyn
import CoreStats (exprStats)
import Literal( pprLiteral )
-import Name( pprInfixName, pprPrefixName )
+import Name( pprInfixName, pprPrefixName, NamedThing)
import Var
import Id
import IdInfo
@@ -46,10 +46,10 @@ import SrcLoc ( pprUserRealSpan )
@pprParendCoreExpr@ puts parens around non-atomic Core expressions.
-}
-pprCoreBindings :: OutputableBndr b => [Bind b] -> SDoc
-pprCoreBinding :: OutputableBndr b => Bind b -> SDoc
-pprCoreExpr :: OutputableBndr b => Expr b -> SDoc
-pprParendExpr :: OutputableBndr b => Expr b -> SDoc
+pprCoreBindings :: (OutputableBndr b, NamedThing b) => [Bind b] -> SDoc
+pprCoreBinding :: (OutputableBndr b, NamedThing b) => Bind b -> SDoc
+pprCoreExpr :: (OutputableBndr b, NamedThing b) => Expr b -> SDoc
+pprParendExpr :: (OutputableBndr b, NamedThing b) => Expr b -> SDoc
pprCoreBindings = pprTopBinds noAnn
pprCoreBinding = pprTopBind noAnn
@@ -60,10 +60,10 @@ pprCoreBindingWithSize :: CoreBind -> SDoc
pprCoreBindingsWithSize = pprTopBinds sizeAnn
pprCoreBindingWithSize = pprTopBind sizeAnn
-instance OutputableBndr b => Outputable (Bind b) where
+instance (OutputableBndr b, NamedThing b) => Outputable (Bind b) where
ppr bind = ppr_bind noAnn bind
-instance OutputableBndr b => Outputable (Expr b) where
+instance (OutputableBndr b, NamedThing b) => Outputable (Expr b) where
ppr expr = pprCoreExpr expr
pprCoreBindingsWithAnn :: [CoreBind] -> SDoc
@@ -91,14 +91,14 @@ realAnn e = addAnn (PCoreExpr e) (ppr e)
noAnn :: Expr b -> SDoc
noAnn _ = empty
-pprTopBinds :: OutputableBndr a
+pprTopBinds :: (OutputableBndr a, NamedThing a)
=> Annotation a -- ^ generate an annotation to place before the
-- binding
-> [Bind a] -- ^ bindings to show
-> SDoc -- ^ the pretty result
pprTopBinds ann binds = vcat (map (pprTopBind ann) binds)
-pprTopBind :: OutputableBndr a => Annotation a -> Bind a -> SDoc
+pprTopBind :: (OutputableBndr a, NamedThing a) => Annotation a -> Bind a -> SDoc
pprTopBind ann b@(NonRec binder expr)
= addAnn (PBind b) (ppr_binding ann (binder,expr)) $$ blankLine
@@ -111,14 +111,14 @@ pprTopBind ann (Rec (b:bs))
text "end Rec }",
blankLine]
-ppr_bind :: OutputableBndr b => Annotation b -> Bind b -> SDoc
+ppr_bind :: (OutputableBndr b, NamedThing b) => Annotation b -> Bind b -> SDoc
ppr_bind ann (NonRec val_bdr expr) = ppr_binding ann (val_bdr, expr)
ppr_bind ann (Rec binds) = vcat (map pp binds)
where
pp bind = ppr_binding ann bind <> semi
-ppr_binding :: OutputableBndr b => Annotation b -> (b, Expr b) -> SDoc
+ppr_binding :: (OutputableBndr b, NamedThing b) => Annotation b -> (b, Expr b) -> SDoc
ppr_binding ann (val_bdr, expr)
= ann expr $$ (pprBndr LetBind val_bdr) $$ pp_bind
where
@@ -152,7 +152,7 @@ pprOptCo co = sdocWithDynFlags $ \dflags ->
then angleBrackets (text "Co:" <> int (coercionSize co))
else parens (sep [ppr co, dcolon <+> ppr (coercionType co)])
-ppr_expr :: OutputableBndr b => (SDoc -> SDoc) -> Expr b -> SDoc
+ppr_expr :: (OutputableBndr b, NamedThing b) => (SDoc -> SDoc) -> Expr b -> SDoc
-- The function adds parens in context that need
-- an atomic value (e.g. function args)
@@ -287,11 +287,11 @@ ppr_expr add_par (Tick tickish expr)
then ppr_expr add_par expr
else add_par (sep [ppr tickish, pprCoreExpr expr])
-pprCoreAlt :: OutputableBndr a => (AltCon, [a] , Expr a) -> SDoc
+pprCoreAlt :: (OutputableBndr a, NamedThing a) => (AltCon, [a] , Expr a) -> SDoc
pprCoreAlt (con, args, rhs)
= hang (ppr_case_pat con args <+> arrow) 2 (pprCoreExpr rhs)
-ppr_case_pat :: OutputableBndr a => AltCon -> [a] -> SDoc
+ppr_case_pat :: (OutputableBndr a, NamedThing a) => AltCon -> [a] -> SDoc
ppr_case_pat (DataAlt dc) args
| Just sort <- tyConTuple_maybe tc
= tupleParens sort (pprWithCommas ppr_bndr args)
@@ -306,7 +306,7 @@ ppr_case_pat con args
-- | Pretty print the argument in a function application.
-pprArg :: OutputableBndr a => Expr a -> SDoc
+pprArg :: (OutputableBndr a, NamedThing a) => Expr a -> SDoc
pprArg (Type ty)
= sdocWithDynFlags $ \dflags ->
if gopt Opt_SuppressTypeApplications dflags
diff --git a/compiler/utils/OutputableAnnotation.hs b/compiler/utils/OutputableAnnotation.hs
index 71b9c69..12a7bba 100644
--- a/compiler/utils/OutputableAnnotation.hs
+++ b/compiler/utils/OutputableAnnotation.hs
@@ -3,18 +3,19 @@ module OutputableAnnotation (PExpr(..), BindType(..), varBinder, varReference) w
import CoreSyn
import Outputable ( OutputableBndr(..))
+import Name (NamedThing)
data PExpr where
- PCoreExpr :: OutputableBndr a => Expr a -> PExpr
- PBind :: OutputableBndr a => Bind a -> PExpr
- PVar :: OutputableBndr a => BindType -> a -> PExpr
+ PCoreExpr :: (OutputableBndr a, NamedThing a) => Expr a -> PExpr
+ PBind :: (OutputableBndr a, NamedThing a) => Bind a -> PExpr
+ PVar :: (OutputableBndr a, NamedThing a) => BindType -> a -> PExpr
data BindType = Binder | Reference
-varBinder :: OutputableBndr a => a -> PExpr
+varBinder :: (OutputableBndr a, NamedThing a) => a -> PExpr
varBinder a = PVar Binder a
-varReference :: OutputableBndr a => a -> PExpr
+varReference :: (OutputableBndr a, NamedThing a) => a -> PExpr
varReference a = PVar Reference a
More information about the ghc-commits
mailing list