{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module GHC.Core.Ppr (
pprCoreExpr, pprParendExpr,
pprCoreBinding, pprCoreBindings, pprCoreAlt,
pprCoreBindingWithSize, pprCoreBindingsWithSize,
pprCoreBinder, pprCoreBinders, pprId, pprIds,
pprRule, pprRules, pprOptCo,
pprOcc, pprOccWithTick
) where
import GHC.Prelude
import GHC.Core
import GHC.Core.Stats (exprStats)
import GHC.Types.Fixity (LexicalFixity(..))
import GHC.Types.Literal( pprLiteral )
import GHC.Types.Name( pprInfixName, pprPrefixName )
import GHC.Types.Var
import GHC.Types.Id
import GHC.Types.Id.Info
import GHC.Types.Demand
import GHC.Types.Cpr
import GHC.Core.DataCon
import GHC.Core.TyCon
import GHC.Core.TyCo.Ppr
import GHC.Core.Coercion
import GHC.Types.Basic
import GHC.Data.Maybe
import GHC.Utils.Misc
import GHC.Utils.Outputable
import GHC.Types.SrcLoc ( pprUserRealSpan )
import GHC.Types.Tickish
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 :: forall b. OutputableBndr b => [Bind b] -> SDoc
pprCoreBindings = Annotation b -> [Bind b] -> SDoc
forall a. OutputableBndr a => Annotation a -> [Bind a] -> SDoc
pprTopBinds Annotation b
forall b. Expr b -> SDoc
noAnn
pprCoreBinding :: forall b. OutputableBndr b => Bind b -> SDoc
pprCoreBinding = Annotation b -> Bind b -> SDoc
forall a. OutputableBndr a => Annotation a -> Bind a -> SDoc
pprTopBind Annotation b
forall b. Expr b -> SDoc
noAnn
pprCoreBindingsWithSize :: [CoreBind] -> SDoc
pprCoreBindingWithSize :: CoreBind -> SDoc
pprCoreBindingsWithSize :: [CoreBind] -> SDoc
pprCoreBindingsWithSize = Annotation Id -> [CoreBind] -> SDoc
forall a. OutputableBndr a => Annotation a -> [Bind a] -> SDoc
pprTopBinds Annotation Id
sizeAnn
pprCoreBindingWithSize :: CoreBind -> SDoc
pprCoreBindingWithSize = Annotation Id -> CoreBind -> SDoc
forall a. OutputableBndr a => Annotation a -> Bind a -> SDoc
pprTopBind Annotation Id
sizeAnn
instance OutputableBndr b => Outputable (Bind b) where
ppr :: Bind b -> SDoc
ppr Bind b
bind = Annotation b -> Bind b -> SDoc
forall a. OutputableBndr a => Annotation a -> Bind a -> SDoc
ppr_bind Annotation b
forall b. Expr b -> SDoc
noAnn Bind b
bind
instance OutputableBndr b => Outputable (Expr b) where
ppr :: Expr b -> SDoc
ppr Expr b
expr = Expr b -> SDoc
forall b. OutputableBndr b => Expr b -> SDoc
pprCoreExpr Expr b
expr
instance OutputableBndr b => Outputable (Alt b) where
ppr :: Alt b -> SDoc
ppr Alt b
expr = Alt b -> SDoc
forall b. OutputableBndr b => Alt b -> SDoc
pprCoreAlt Alt b
expr
type Annotation b = Expr b -> SDoc
sizeAnn :: CoreExpr -> SDoc
sizeAnn :: Annotation Id
sizeAnn CoreExpr
e = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"-- RHS size:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> CoreStats -> SDoc
forall a. Outputable a => a -> SDoc
ppr (CoreExpr -> CoreStats
exprStats CoreExpr
e)
noAnn :: Expr b -> SDoc
noAnn :: forall b. Expr b -> SDoc
noAnn Expr b
_ = SDoc
forall doc. IsOutput doc => doc
empty
pprTopBinds :: OutputableBndr a
=> Annotation a
-> [Bind a]
-> SDoc
pprTopBinds :: forall a. OutputableBndr a => Annotation a -> [Bind a] -> SDoc
pprTopBinds Annotation a
ann [Bind a]
binds = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((Bind a -> SDoc) -> [Bind a] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (Annotation a -> Bind a -> SDoc
forall a. OutputableBndr a => Annotation a -> Bind a -> SDoc
pprTopBind Annotation a
ann) [Bind a]
binds)
pprTopBind :: OutputableBndr a => Annotation a -> Bind a -> SDoc
pprTopBind :: forall a. OutputableBndr a => Annotation a -> Bind a -> SDoc
pprTopBind Annotation a
ann (NonRec a
binder Expr a
expr)
= Annotation a -> (a, Expr a) -> SDoc
forall b. OutputableBndr b => Annotation b -> (b, Expr b) -> SDoc
ppr_binding Annotation a
ann (a
binder,Expr a
expr) SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ SDoc
blankLine
pprTopBind Annotation a
_ (Rec [])
= String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Rec { }"
pprTopBind Annotation a
ann (Rec ((a, Expr a)
b:[(a, Expr a)]
bs))
= [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Rec {",
Annotation a -> (a, Expr a) -> SDoc
forall b. OutputableBndr b => Annotation b -> (b, Expr b) -> SDoc
ppr_binding Annotation a
ann (a, Expr a)
b,
[SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [SDoc
blankLine SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Annotation a -> (a, Expr a) -> SDoc
forall b. OutputableBndr b => Annotation b -> (b, Expr b) -> SDoc
ppr_binding Annotation a
ann (a, Expr a)
b | (a, Expr a)
b <- [(a, Expr a)]
bs],
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"end Rec }",
SDoc
blankLine]
ppr_bind :: OutputableBndr b => Annotation b -> Bind b -> SDoc
ppr_bind :: forall a. OutputableBndr a => Annotation a -> Bind a -> SDoc
ppr_bind Annotation b
ann (NonRec b
val_bdr Expr b
expr) = Annotation b -> (b, Expr b) -> SDoc
forall b. OutputableBndr b => Annotation b -> (b, Expr b) -> SDoc
ppr_binding Annotation b
ann (b
val_bdr, Expr b
expr)
ppr_bind Annotation b
ann (Rec [(b, Expr b)]
binds) = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat (((b, Expr b) -> SDoc) -> [(b, Expr b)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (b, Expr b) -> SDoc
pp [(b, Expr b)]
binds)
where
pp :: (b, Expr b) -> SDoc
pp (b, Expr b)
bind = Annotation b -> (b, Expr b) -> SDoc
forall b. OutputableBndr b => Annotation b -> (b, Expr b) -> SDoc
ppr_binding Annotation b
ann (b, Expr b)
bind SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
semi
ppr_binding :: OutputableBndr b => Annotation b -> (b, Expr b) -> SDoc
ppr_binding :: forall b. OutputableBndr b => Annotation b -> (b, Expr b) -> SDoc
ppr_binding Annotation b
ann (b
val_bdr, Expr b
expr)
= [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ Annotation b
ann Expr b
expr
, (SDocContext -> Bool) -> SDoc -> SDoc
forall doc. IsLine doc => (SDocContext -> Bool) -> doc -> doc
ppUnlessOption SDocContext -> Bool
sdocSuppressTypeSignatures
(BindingSite -> b -> SDoc
forall a. OutputableBndr a => BindingSite -> a -> SDoc
pprBndr BindingSite
LetBind b
val_bdr)
, SDoc
pp_bind
]
where
pp_val_bdr :: SDoc
pp_val_bdr = b -> SDoc
forall a. OutputableBndr a => a -> SDoc
pprPrefixOcc b
val_bdr
pp_bind :: SDoc
pp_bind = case b -> Maybe ArityInfo
forall a. OutputableBndr a => a -> Maybe ArityInfo
bndrIsJoin_maybe b
val_bdr of
Maybe ArityInfo
Nothing -> SDoc
pp_normal_bind
Just ArityInfo
ar -> ArityInfo -> SDoc
pp_join_bind ArityInfo
ar
pp_normal_bind :: SDoc
pp_normal_bind = SDoc -> ArityInfo -> SDoc -> SDoc
hang SDoc
pp_val_bdr ArityInfo
2 (SDoc
forall doc. IsLine doc => doc
equals SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Annotation b
forall b. OutputableBndr b => Expr b -> SDoc
pprCoreExpr Expr b
expr)
pp_join_bind :: ArityInfo -> SDoc
pp_join_bind ArityInfo
join_arity
| [b]
bndrs [b] -> ArityInfo -> Bool
forall a. [a] -> ArityInfo -> Bool
`lengthAtLeast` ArityInfo
join_arity
= SDoc -> ArityInfo -> SDoc -> SDoc
hang (SDoc
pp_val_bdr SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep ((b -> SDoc) -> [b] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (BindingSite -> b -> SDoc
forall a. OutputableBndr a => BindingSite -> a -> SDoc
pprBndr BindingSite
LambdaBind) [b]
lhs_bndrs))
ArityInfo
2 (SDoc
forall doc. IsLine doc => doc
equals SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Annotation b
forall b. OutputableBndr b => Expr b -> SDoc
pprCoreExpr Expr b
rhs)
| Bool
otherwise
= SDoc
pp_normal_bind
where
([b]
bndrs, Expr b
body) = Expr b -> ([b], Expr b)
forall b. Expr b -> ([b], Expr b)
collectBinders Expr b
expr
lhs_bndrs :: [b]
lhs_bndrs = ArityInfo -> [b] -> [b]
forall a. ArityInfo -> [a] -> [a]
take ArityInfo
join_arity [b]
bndrs
rhs :: Expr b
rhs = [b] -> Expr b -> Expr b
forall b. [b] -> Expr b -> Expr b
mkLams (ArityInfo -> [b] -> [b]
forall a. ArityInfo -> [a] -> [a]
drop ArityInfo
join_arity [b]
bndrs) Expr b
body
pprParendExpr :: forall b. OutputableBndr b => Expr b -> SDoc
pprParendExpr Expr b
expr = (SDoc -> SDoc) -> Expr b -> SDoc
forall b. OutputableBndr b => (SDoc -> SDoc) -> Expr b -> SDoc
ppr_expr SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens Expr b
expr
pprCoreExpr :: forall b. OutputableBndr b => Expr b -> SDoc
pprCoreExpr Expr b
expr = (SDoc -> SDoc) -> Expr b -> SDoc
forall b. OutputableBndr b => (SDoc -> SDoc) -> Expr b -> SDoc
ppr_expr SDoc -> SDoc
noParens Expr b
expr
noParens :: SDoc -> SDoc
noParens :: SDoc -> SDoc
noParens SDoc
pp = SDoc
pp
pprOptCo :: Coercion -> SDoc
pprOptCo :: Coercion -> SDoc
pprOptCo Coercion
co = (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocSuppressCoercions ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \case
Bool
True -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
angleBrackets (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Co:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> ArityInfo -> SDoc
forall doc. IsLine doc => ArityInfo -> doc
int (Coercion -> ArityInfo
coercionSize Coercion
co)) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
co_type
Bool
False -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [Coercion -> SDoc
forall a. Outputable a => a -> SDoc
ppr Coercion
co, SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
co_type]
where
co_type :: SDoc
co_type = (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocSuppressCoercionTypes ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \case
Bool
True -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"..."
Bool
False -> Kind -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Coercion -> Kind
coercionType Coercion
co)
ppr_id_occ :: (SDoc -> SDoc) -> Id -> SDoc
ppr_id_occ :: (SDoc -> SDoc) -> Id -> SDoc
ppr_id_occ SDoc -> SDoc
add_par Id
id
| Id -> Bool
isJoinId Id
id = SDoc -> SDoc
add_par ((String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"jump") SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
pp_id)
| Bool
otherwise = SDoc
pp_id
where
pp_id :: SDoc
pp_id = Id -> SDoc
forall a. Outputable a => a -> SDoc
ppr Id
id
ppr_expr :: OutputableBndr b => (SDoc -> SDoc) -> Expr b -> SDoc
ppr_expr :: forall b. OutputableBndr b => (SDoc -> SDoc) -> Expr b -> SDoc
ppr_expr SDoc -> SDoc
add_par (Var Id
id) = (SDoc -> SDoc) -> Id -> SDoc
ppr_id_occ SDoc -> SDoc
add_par Id
id
ppr_expr SDoc -> SDoc
add_par (Type Kind
ty) = SDoc -> SDoc
add_par (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"TYPE:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Kind -> SDoc
forall a. Outputable a => a -> SDoc
ppr Kind
ty)
ppr_expr SDoc -> SDoc
add_par (Coercion Coercion
co) = SDoc -> SDoc
add_par (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"CO:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Coercion -> SDoc
forall a. Outputable a => a -> SDoc
ppr Coercion
co)
ppr_expr SDoc -> SDoc
add_par (Lit Literal
lit) = (SDoc -> SDoc) -> Literal -> SDoc
pprLiteral SDoc -> SDoc
add_par Literal
lit
ppr_expr SDoc -> SDoc
add_par (Cast Expr b
expr Coercion
co)
= SDoc -> SDoc
add_par (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [Expr b -> SDoc
forall b. OutputableBndr b => Expr b -> SDoc
pprParendExpr Expr b
expr, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"`cast`" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Coercion -> SDoc
pprOptCo Coercion
co]
ppr_expr SDoc -> SDoc
add_par expr :: Expr b
expr@(Lam b
_ Expr b
_)
= let
([b]
bndrs, Expr b
body) = Expr b -> ([b], Expr b)
forall b. Expr b -> ([b], Expr b)
collectBinders Expr b
expr
in
SDoc -> SDoc
add_par (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
SDoc -> ArityInfo -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"\\" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep ((b -> SDoc) -> [b] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (BindingSite -> b -> SDoc
forall a. OutputableBndr a => BindingSite -> a -> SDoc
pprBndr BindingSite
LambdaBind) [b]
bndrs) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
arrow)
ArityInfo
2 (Expr b -> SDoc
forall b. OutputableBndr b => Expr b -> SDoc
pprCoreExpr Expr b
body)
ppr_expr SDoc -> SDoc
add_par expr :: Expr b
expr@(App {})
= (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocSuppressTypeApplications ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Bool
supp_ty_app ->
case Expr b -> (Expr b, [Expr b])
forall b. Expr b -> (Expr b, [Expr b])
collectArgs Expr b
expr of { (Expr b
fun, [Expr b]
args) ->
let
pp_args :: SDoc
pp_args = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep ((Expr b -> SDoc) -> [Expr b] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map Expr b -> SDoc
forall b. OutputableBndr b => Expr b -> SDoc
pprArg [Expr b]
args)
val_args :: [Expr b]
val_args = (Expr b -> Bool) -> [Expr b] -> [Expr b]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Expr b -> Bool
forall b. Expr b -> Bool
isTypeArg [Expr b]
args
pp_tup_args :: SDoc
pp_tup_args = (Expr b -> SDoc) -> [Expr b] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas Expr b -> SDoc
forall b. OutputableBndr b => Expr b -> SDoc
pprCoreExpr [Expr b]
val_args
args' :: [Expr b]
args'
| Bool
supp_ty_app = [Expr b]
val_args
| Bool
otherwise = [Expr b]
args
parens :: SDoc -> SDoc
parens
| [Expr b] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Expr b]
args' = SDoc -> SDoc
forall a. a -> a
id
| Bool
otherwise = SDoc -> SDoc
add_par
in
case Expr b
fun of
Var Id
f -> case Id -> Maybe DataCon
isDataConWorkId_maybe Id
f of
Just DataCon
dc | Bool
saturated
, Just TupleSort
sort <- TyCon -> Maybe TupleSort
tyConTuple_maybe TyCon
tc
-> TupleSort -> SDoc -> SDoc
tupleParens TupleSort
sort SDoc
pp_tup_args
where
tc :: TyCon
tc = DataCon -> TyCon
dataConTyCon DataCon
dc
saturated :: Bool
saturated = [Expr b]
val_args [Expr b] -> ArityInfo -> Bool
forall a. [a] -> ArityInfo -> Bool
`lengthIs` Id -> ArityInfo
idArity Id
f
Maybe DataCon
_ -> SDoc -> SDoc
parens (SDoc -> ArityInfo -> SDoc -> SDoc
hang SDoc
fun_doc ArityInfo
2 SDoc
pp_args)
where
fun_doc :: SDoc
fun_doc = (SDoc -> SDoc) -> Id -> SDoc
ppr_id_occ SDoc -> SDoc
noParens Id
f
Expr b
_ -> SDoc -> SDoc
parens (SDoc -> ArityInfo -> SDoc -> SDoc
hang (Expr b -> SDoc
forall b. OutputableBndr b => Expr b -> SDoc
pprParendExpr Expr b
fun) ArityInfo
2 SDoc
pp_args)
}
ppr_expr SDoc -> SDoc
add_par (Case Expr b
expr b
var Kind
ty [Alt AltCon
con [b]
args Expr b
rhs])
= (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocPrintCaseAsLet ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \case
Bool
True -> SDoc -> SDoc
add_par (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
[SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"let! {"
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> AltCon -> [b] -> SDoc
forall a. OutputableBndr a => AltCon -> [a] -> SDoc
ppr_case_pat AltCon
con [b]
args
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"~"
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> b -> SDoc
ppr_bndr b
var
, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"<-" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> (SDoc -> SDoc) -> Expr b -> SDoc
forall b. OutputableBndr b => (SDoc -> SDoc) -> Expr b -> SDoc
ppr_expr SDoc -> SDoc
forall a. a -> a
id Expr b
expr
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"} in" ]
, Expr b -> SDoc
forall b. OutputableBndr b => Expr b -> SDoc
pprCoreExpr Expr b
rhs
]
Bool
False -> SDoc -> SDoc
add_par (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
[SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [[SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [[SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"case" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Expr b -> SDoc
forall b. OutputableBndr b => Expr b -> SDoc
pprCoreExpr Expr b
expr
, SDoc -> SDoc
forall doc. IsOutput doc => doc -> doc
whenPprDebug (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"return" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Kind -> SDoc
forall a. Outputable a => a -> SDoc
ppr Kind
ty)
, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"of" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> b -> SDoc
ppr_bndr b
var
]
, Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'{' SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> AltCon -> [b] -> SDoc
forall a. OutputableBndr a => AltCon -> [a] -> SDoc
ppr_case_pat AltCon
con [b]
args SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
arrow
]
, Expr b -> SDoc
forall b. OutputableBndr b => Expr b -> SDoc
pprCoreExpr Expr b
rhs
, Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'}'
]
where
ppr_bndr :: b -> SDoc
ppr_bndr = BindingSite -> b -> SDoc
forall a. OutputableBndr a => BindingSite -> a -> SDoc
pprBndr BindingSite
CaseBind
ppr_expr SDoc -> SDoc
add_par (Case Expr b
expr b
var Kind
ty [Alt b]
alts)
= SDoc -> SDoc
add_par (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
[SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [[SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"case"
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Expr b -> SDoc
forall b. OutputableBndr b => Expr b -> SDoc
pprCoreExpr Expr b
expr
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
forall doc. IsOutput doc => doc -> doc
whenPprDebug (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"return" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Kind -> SDoc
forall a. Outputable a => a -> SDoc
ppr Kind
ty),
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"of" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> b -> SDoc
ppr_bndr b
var SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'{'],
ArityInfo -> SDoc -> SDoc
nest ArityInfo
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat (SDoc -> [SDoc] -> [SDoc]
forall doc. IsLine doc => doc -> [doc] -> [doc]
punctuate SDoc
forall doc. IsLine doc => doc
semi ((Alt b -> SDoc) -> [Alt b] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map Alt b -> SDoc
forall b. OutputableBndr b => Alt b -> SDoc
pprCoreAlt [Alt b]
alts))),
Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'}'
]
where
ppr_bndr :: b -> SDoc
ppr_bndr = BindingSite -> b -> SDoc
forall a. OutputableBndr a => BindingSite -> a -> SDoc
pprBndr BindingSite
CaseBind
ppr_expr SDoc -> SDoc
add_par (Let Bind b
bind Expr b
expr)
= SDoc -> SDoc
add_par (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
[SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [SDoc -> ArityInfo -> SDoc -> SDoc
hang (Bind b -> SDoc
forall {a} {doc}. (OutputableBndr a, IsLine doc) => Bind a -> doc
keyword Bind b
bind SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'{') ArityInfo
2 ((Expr b -> SDoc) -> Bind b -> SDoc
forall a. OutputableBndr a => Annotation a -> Bind a -> SDoc
ppr_bind Expr b -> SDoc
forall b. Expr b -> SDoc
noAnn Bind b
bind SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"} in"),
Expr b -> SDoc
forall b. OutputableBndr b => Expr b -> SDoc
pprCoreExpr Expr b
expr]
where
keyword :: Bind a -> doc
keyword (NonRec a
b Expr a
_)
| Maybe ArityInfo -> Bool
forall a. Maybe a -> Bool
isJust (a -> Maybe ArityInfo
forall a. OutputableBndr a => a -> Maybe ArityInfo
bndrIsJoin_maybe a
b) = String -> doc
forall doc. IsLine doc => String -> doc
text String
"join"
| Bool
otherwise = String -> doc
forall doc. IsLine doc => String -> doc
text String
"let"
keyword (Rec [(a, Expr a)]
pairs)
| ((a
b,Expr a
_):[(a, Expr a)]
_) <- [(a, Expr a)]
pairs
, Maybe ArityInfo -> Bool
forall a. Maybe a -> Bool
isJust (a -> Maybe ArityInfo
forall a. OutputableBndr a => a -> Maybe ArityInfo
bndrIsJoin_maybe a
b) = String -> doc
forall doc. IsLine doc => String -> doc
text String
"joinrec"
| Bool
otherwise = String -> doc
forall doc. IsLine doc => String -> doc
text String
"letrec"
ppr_expr SDoc -> SDoc
add_par (Tick CoreTickish
tickish Expr b
expr)
= (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocSuppressTicks ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \case
Bool
True
| Bool -> Bool
not (CoreTickish -> Bool
forall (pass :: TickishPass). GenTickish pass -> Bool
tickishIsCode CoreTickish
tickish) -> (SDoc -> SDoc) -> Expr b -> SDoc
forall b. OutputableBndr b => (SDoc -> SDoc) -> Expr b -> SDoc
ppr_expr SDoc -> SDoc
add_par Expr b
expr
Bool
_ -> SDoc -> SDoc
add_par ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [CoreTickish -> SDoc
forall a. Outputable a => a -> SDoc
ppr CoreTickish
tickish, Expr b -> SDoc
forall b. OutputableBndr b => Expr b -> SDoc
pprCoreExpr Expr b
expr])
pprCoreAlt :: OutputableBndr a => Alt a -> SDoc
pprCoreAlt :: forall b. OutputableBndr b => Alt b -> SDoc
pprCoreAlt (Alt AltCon
con [a]
args Expr a
rhs)
= SDoc -> ArityInfo -> SDoc -> SDoc
hang (AltCon -> [a] -> SDoc
forall a. OutputableBndr a => AltCon -> [a] -> SDoc
ppr_case_pat AltCon
con [a]
args SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
arrow) ArityInfo
2 (Expr a -> SDoc
forall b. OutputableBndr b => Expr b -> SDoc
pprCoreExpr Expr a
rhs)
ppr_case_pat :: OutputableBndr a => AltCon -> [a] -> SDoc
ppr_case_pat :: forall a. OutputableBndr a => AltCon -> [a] -> SDoc
ppr_case_pat (DataAlt DataCon
dc) [a]
args
| Just TupleSort
sort <- TyCon -> Maybe TupleSort
tyConTuple_maybe TyCon
tc
= TupleSort -> SDoc -> SDoc
tupleParens TupleSort
sort ((a -> SDoc) -> [a] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas a -> SDoc
ppr_bndr [a]
args)
where
ppr_bndr :: a -> SDoc
ppr_bndr = BindingSite -> a -> SDoc
forall a. OutputableBndr a => BindingSite -> a -> SDoc
pprBndr BindingSite
CasePatBind
tc :: TyCon
tc = DataCon -> TyCon
dataConTyCon DataCon
dc
ppr_case_pat AltCon
con [a]
args
= AltCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr AltCon
con SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
fsep ((a -> SDoc) -> [a] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map a -> SDoc
ppr_bndr [a]
args))
where
ppr_bndr :: a -> SDoc
ppr_bndr = BindingSite -> a -> SDoc
forall a. OutputableBndr a => BindingSite -> a -> SDoc
pprBndr BindingSite
CasePatBind
pprArg :: OutputableBndr a => Expr a -> SDoc
pprArg :: forall b. OutputableBndr b => Expr b -> SDoc
pprArg (Type Kind
ty)
= (SDocContext -> Bool) -> SDoc -> SDoc
forall doc. IsLine doc => (SDocContext -> Bool) -> doc -> doc
ppUnlessOption SDocContext -> Bool
sdocSuppressTypeApplications
(String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"@" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Kind -> SDoc
pprParendType Kind
ty)
pprArg (Coercion Coercion
co) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"@~" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Coercion -> SDoc
pprOptCo Coercion
co
pprArg Expr a
expr = Expr a -> SDoc
forall b. OutputableBndr b => Expr b -> SDoc
pprParendExpr Expr a
expr
instance OutputableBndr Var where
pprBndr :: BindingSite -> Id -> SDoc
pprBndr = BindingSite -> Id -> SDoc
pprCoreBinder
pprInfixOcc :: Id -> SDoc
pprInfixOcc = Name -> SDoc
forall a. (Outputable a, NamedThing a) => a -> SDoc
pprInfixName (Name -> SDoc) -> (Id -> Name) -> Id -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Id -> Name
varName
pprPrefixOcc :: Id -> SDoc
pprPrefixOcc = Name -> SDoc
forall a. NamedThing a => a -> SDoc
pprPrefixName (Name -> SDoc) -> (Id -> Name) -> Id -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Id -> Name
varName
bndrIsJoin_maybe :: Id -> Maybe ArityInfo
bndrIsJoin_maybe = Id -> Maybe ArityInfo
isJoinId_maybe
instance Outputable b => OutputableBndr (TaggedBndr b) where
pprBndr :: BindingSite -> TaggedBndr b -> SDoc
pprBndr BindingSite
_ TaggedBndr b
b = TaggedBndr b -> SDoc
forall a. Outputable a => a -> SDoc
ppr TaggedBndr b
b
pprInfixOcc :: TaggedBndr b -> SDoc
pprInfixOcc TaggedBndr b
b = TaggedBndr b -> SDoc
forall a. Outputable a => a -> SDoc
ppr TaggedBndr b
b
pprPrefixOcc :: TaggedBndr b -> SDoc
pprPrefixOcc TaggedBndr b
b = TaggedBndr b -> SDoc
forall a. Outputable a => a -> SDoc
ppr TaggedBndr b
b
bndrIsJoin_maybe :: TaggedBndr b -> Maybe ArityInfo
bndrIsJoin_maybe (TB Id
b b
_) = Id -> Maybe ArityInfo
isJoinId_maybe Id
b
pprOcc :: OutputableBndr a => LexicalFixity -> a -> SDoc
pprOcc :: forall a. OutputableBndr a => LexicalFixity -> a -> SDoc
pprOcc LexicalFixity
Infix = a -> SDoc
forall a. OutputableBndr a => a -> SDoc
pprInfixOcc
pprOcc LexicalFixity
Prefix = a -> SDoc
forall a. OutputableBndr a => a -> SDoc
pprPrefixOcc
pprOccWithTick :: OutputableBndr a => LexicalFixity -> PromotionFlag -> a -> SDoc
pprOccWithTick :: forall a.
OutputableBndr a =>
LexicalFixity -> PromotionFlag -> a -> SDoc
pprOccWithTick LexicalFixity
fixity PromotionFlag
prom a
op
| PromotionFlag -> Bool
isPromoted PromotionFlag
prom
= SDoc -> SDoc
quote (LexicalFixity -> a -> SDoc
forall a. OutputableBndr a => LexicalFixity -> a -> SDoc
pprOcc LexicalFixity
fixity a
op)
| Bool
otherwise
= LexicalFixity -> a -> SDoc
forall a. OutputableBndr a => LexicalFixity -> a -> SDoc
pprOcc LexicalFixity
fixity a
op
pprCoreBinder :: BindingSite -> Var -> SDoc
pprCoreBinder :: BindingSite -> Id -> SDoc
pprCoreBinder BindingSite
LetBind Id
binder
| Id -> Bool
isTyVar Id
binder = Id -> SDoc
pprKindedTyVarBndr Id
binder
| Bool
otherwise = Id -> SDoc
pprTypedLetBinder Id
binder SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
Id -> IdInfo -> SDoc
ppIdInfo Id
binder ((() :: Constraint) => Id -> IdInfo
Id -> IdInfo
idInfo Id
binder)
pprCoreBinder BindingSite
bind_site Id
bndr
= (Bool -> SDoc) -> SDoc
forall doc. IsOutput doc => (Bool -> doc) -> doc
getPprDebug ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Bool
debug ->
BindingSite -> Bool -> Id -> SDoc
pprTypedLamBinder BindingSite
bind_site Bool
debug Id
bndr
pprCoreBinders :: [Var] -> SDoc
pprCoreBinders :: [Id] -> SDoc
pprCoreBinders [Id]
vs = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep ((Id -> SDoc) -> [Id] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (BindingSite -> Id -> SDoc
pprCoreBinder BindingSite
LambdaBind) [Id]
vs)
pprUntypedBinder :: Var -> SDoc
pprUntypedBinder :: Id -> SDoc
pprUntypedBinder Id
binder
| Id -> Bool
isTyVar Id
binder = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"@" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Id -> SDoc
forall a. Outputable a => a -> SDoc
ppr Id
binder
| Bool
otherwise = Id -> SDoc
pprIdBndr Id
binder
pprTypedLamBinder :: BindingSite -> Bool -> Var -> SDoc
pprTypedLamBinder :: BindingSite -> Bool -> Id -> SDoc
pprTypedLamBinder BindingSite
bind_site Bool
debug_on Id
var
= (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocSuppressTypeSignatures ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Bool
suppress_sigs ->
case () of
()
_
| Bool -> Bool
not Bool
debug_on
, BindingSite
CaseBind <- BindingSite
bind_site
, Id -> Bool
isDeadBinder Id
var -> SDoc
forall doc. IsOutput doc => doc
empty
| Bool -> Bool
not Bool
debug_on
, Id -> Bool
isDeadBinder Id
var -> Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'_' SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Bool -> SDoc -> SDoc
forall doc. IsOutput doc => Bool -> doc -> doc
ppWhen (Id -> Bool
isId Id
var)
(IdInfo -> SDoc
pprIdBndrInfo ((() :: Constraint) => Id -> IdInfo
Id -> IdInfo
idInfo Id
var))
| Bool -> Bool
not Bool
debug_on
, BindingSite
CaseBind <- BindingSite
bind_site -> Id -> SDoc
pprUntypedBinder Id
var
| Bool -> Bool
not Bool
debug_on
, BindingSite
CasePatBind <- BindingSite
bind_site -> Id -> SDoc
pprUntypedBinder Id
var
| Bool
suppress_sigs -> Id -> SDoc
pprUntypedBinder Id
var
| Id -> Bool
isTyVar Id
var -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (Id -> SDoc
pprKindedTyVarBndr Id
var)
| Bool
otherwise -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (SDoc -> ArityInfo -> SDoc -> SDoc
hang (Id -> SDoc
pprIdBndr Id
var)
ArityInfo
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Kind -> SDoc
pprType (Id -> Kind
idType Id
var)
, SDoc
pp_unf]))
where
unf_info :: Unfolding
unf_info = IdInfo -> Unfolding
realUnfoldingInfo ((() :: Constraint) => Id -> IdInfo
Id -> IdInfo
idInfo Id
var)
pp_unf :: SDoc
pp_unf | Unfolding -> Bool
hasSomeUnfolding Unfolding
unf_info = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Unf=" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Unfolding -> SDoc
forall a. Outputable a => a -> SDoc
ppr Unfolding
unf_info
| Bool
otherwise = SDoc
forall doc. IsOutput doc => doc
empty
pprTypedLetBinder :: Var -> SDoc
pprTypedLetBinder :: Id -> SDoc
pprTypedLetBinder Id
binder
= (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocSuppressTypeSignatures ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Bool
suppress_sigs ->
case () of
()
_
| Id -> Bool
isTyVar Id
binder -> Id -> SDoc
pprKindedTyVarBndr Id
binder
| Bool
suppress_sigs -> Id -> SDoc
pprIdBndr Id
binder
| Bool
otherwise -> SDoc -> ArityInfo -> SDoc -> SDoc
hang (Id -> SDoc
pprIdBndr Id
binder) ArityInfo
2 (SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Kind -> SDoc
pprType (Id -> Kind
idType Id
binder))
pprKindedTyVarBndr :: TyVar -> SDoc
pprKindedTyVarBndr :: Id -> SDoc
pprKindedTyVarBndr Id
tyvar
= String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"@" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Id -> SDoc
pprTyVar Id
tyvar
pprId :: Id -> SDoc
pprId :: Id -> SDoc
pprId Id
x = Id -> SDoc
forall a. Outputable a => a -> SDoc
ppr Id
x SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Kind -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Id -> Kind
idType Id
x)
pprIds :: [Id] -> SDoc
pprIds :: [Id] -> SDoc
pprIds [Id]
xs = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep ((Id -> SDoc) -> [Id] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map Id -> SDoc
pprId [Id]
xs)
pprIdBndr :: Id -> SDoc
pprIdBndr :: Id -> SDoc
pprIdBndr Id
id = Id -> SDoc
forall a. OutputableBndr a => a -> SDoc
pprPrefixOcc Id
id SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> IdInfo -> SDoc
pprIdBndrInfo ((() :: Constraint) => Id -> IdInfo
Id -> IdInfo
idInfo Id
id)
pprIdBndrInfo :: IdInfo -> SDoc
pprIdBndrInfo :: IdInfo -> SDoc
pprIdBndrInfo IdInfo
info
= (SDocContext -> Bool) -> SDoc -> SDoc
forall doc. IsLine doc => (SDocContext -> Bool) -> doc -> doc
ppUnlessOption SDocContext -> Bool
sdocSuppressIdInfo
(IdInfo
info IdInfo -> SDoc -> SDoc
forall a b. a -> b -> b
`seq` SDoc
doc)
where
prag_info :: InlinePragma
prag_info = IdInfo -> InlinePragma
inlinePragInfo IdInfo
info
occ_info :: OccInfo
occ_info = IdInfo -> OccInfo
occInfo IdInfo
info
dmd_info :: Demand
dmd_info = IdInfo -> Demand
demandInfo IdInfo
info
lbv_info :: OneShotInfo
lbv_info = IdInfo -> OneShotInfo
oneShotInfo IdInfo
info
has_prag :: Bool
has_prag = Bool -> Bool
not (InlinePragma -> Bool
isDefaultInlinePragma InlinePragma
prag_info)
has_occ :: Bool
has_occ = Bool -> Bool
not (OccInfo -> Bool
isNoOccInfo OccInfo
occ_info)
has_dmd :: Bool
has_dmd = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Demand -> Bool
isTopDmd Demand
dmd_info
has_lbv :: Bool
has_lbv = Bool -> Bool
not (OneShotInfo -> Bool
hasNoOneShotInfo OneShotInfo
lbv_info)
doc :: SDoc
doc = [(Bool, SDoc)] -> SDoc
showAttributes
[ (Bool
has_prag, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"InlPrag=" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> InlinePragma -> SDoc
pprInlineDebug InlinePragma
prag_info)
, (Bool
has_occ, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Occ=" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> OccInfo -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccInfo
occ_info)
, (Bool
has_dmd, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Dmd=" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Demand -> SDoc
forall a. Outputable a => a -> SDoc
ppr Demand
dmd_info)
, (Bool
has_lbv , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"OS=" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> OneShotInfo -> SDoc
forall a. Outputable a => a -> SDoc
ppr OneShotInfo
lbv_info)
]
instance Outputable IdInfo where
ppr :: IdInfo -> SDoc
ppr IdInfo
info = [(Bool, SDoc)] -> SDoc
showAttributes
[ (Bool
has_prag, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"InlPrag=" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> InlinePragma -> SDoc
pprInlineDebug InlinePragma
prag_info)
, (Bool
has_occ, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Occ=" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> OccInfo -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccInfo
occ_info)
, (Bool
has_dmd, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Dmd=" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Demand -> SDoc
forall a. Outputable a => a -> SDoc
ppr Demand
dmd_info)
, (Bool
has_lbv , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"OS=" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> OneShotInfo -> SDoc
forall a. Outputable a => a -> SDoc
ppr OneShotInfo
lbv_info)
, (Bool
has_arity, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Arity=" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> ArityInfo -> SDoc
forall doc. IsLine doc => ArityInfo -> doc
int ArityInfo
arity)
, (Bool
has_called_arity, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"CallArity=" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> ArityInfo -> SDoc
forall doc. IsLine doc => ArityInfo -> doc
int ArityInfo
called_arity)
, (Bool
has_caf_info, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Caf=" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> CafInfo -> SDoc
forall a. Outputable a => a -> SDoc
ppr CafInfo
caf_info)
, (Bool
has_str_info, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Str=" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> DmdSig -> SDoc
pprStrictness DmdSig
str_info)
, (Bool
has_unf, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Unf=" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Unfolding -> SDoc
forall a. Outputable a => a -> SDoc
ppr Unfolding
unf_info)
, (Bool
has_rules, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"RULES:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((CoreRule -> SDoc) -> [CoreRule] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map CoreRule -> SDoc
pprRule [CoreRule]
rules))
]
where
prag_info :: InlinePragma
prag_info = IdInfo -> InlinePragma
inlinePragInfo IdInfo
info
has_prag :: Bool
has_prag = Bool -> Bool
not (InlinePragma -> Bool
isDefaultInlinePragma InlinePragma
prag_info)
occ_info :: OccInfo
occ_info = IdInfo -> OccInfo
occInfo IdInfo
info
has_occ :: Bool
has_occ = Bool -> Bool
not (OccInfo -> Bool
isManyOccs OccInfo
occ_info)
dmd_info :: Demand
dmd_info = IdInfo -> Demand
demandInfo IdInfo
info
has_dmd :: Bool
has_dmd = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Demand -> Bool
isTopDmd Demand
dmd_info
lbv_info :: OneShotInfo
lbv_info = IdInfo -> OneShotInfo
oneShotInfo IdInfo
info
has_lbv :: Bool
has_lbv = Bool -> Bool
not (OneShotInfo -> Bool
hasNoOneShotInfo OneShotInfo
lbv_info)
arity :: ArityInfo
arity = IdInfo -> ArityInfo
arityInfo IdInfo
info
has_arity :: Bool
has_arity = ArityInfo
arity ArityInfo -> ArityInfo -> Bool
forall a. Eq a => a -> a -> Bool
/= ArityInfo
0
called_arity :: ArityInfo
called_arity = IdInfo -> ArityInfo
callArityInfo IdInfo
info
has_called_arity :: Bool
has_called_arity = ArityInfo
called_arity ArityInfo -> ArityInfo -> Bool
forall a. Eq a => a -> a -> Bool
/= ArityInfo
0
caf_info :: CafInfo
caf_info = IdInfo -> CafInfo
cafInfo IdInfo
info
has_caf_info :: Bool
has_caf_info = Bool -> Bool
not (CafInfo -> Bool
mayHaveCafRefs CafInfo
caf_info)
str_info :: DmdSig
str_info = IdInfo -> DmdSig
dmdSigInfo IdInfo
info
has_str_info :: Bool
has_str_info = Bool -> Bool
not (DmdSig -> Bool
isNopSig DmdSig
str_info)
unf_info :: Unfolding
unf_info = IdInfo -> Unfolding
realUnfoldingInfo IdInfo
info
has_unf :: Bool
has_unf = Unfolding -> Bool
hasSomeUnfolding Unfolding
unf_info
rules :: [CoreRule]
rules = RuleInfo -> [CoreRule]
ruleInfoRules (IdInfo -> RuleInfo
ruleInfo IdInfo
info)
has_rules :: Bool
has_rules = Bool -> Bool
not ([CoreRule] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CoreRule]
rules)
ppIdInfo :: Id -> IdInfo -> SDoc
ppIdInfo :: Id -> IdInfo -> SDoc
ppIdInfo Id
id IdInfo
info
= (SDocContext -> Bool) -> SDoc -> SDoc
forall doc. IsLine doc => (SDocContext -> Bool) -> doc -> doc
ppUnlessOption SDocContext -> Bool
sdocSuppressIdInfo (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
[(Bool, SDoc)] -> SDoc
showAttributes
[ (Bool
True, SDoc
pp_scope SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> IdDetails -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Id -> IdDetails
idDetails Id
id))
, (Bool
has_arity, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Arity=" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> ArityInfo -> SDoc
forall doc. IsLine doc => ArityInfo -> doc
int ArityInfo
arity)
, (Bool
has_called_arity, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"CallArity=" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> ArityInfo -> SDoc
forall doc. IsLine doc => ArityInfo -> doc
int ArityInfo
called_arity)
, (Bool
has_caf_info, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Caf=" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> CafInfo -> SDoc
forall a. Outputable a => a -> SDoc
ppr CafInfo
caf_info)
, (Bool
has_str_info, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Str=" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> DmdSig -> SDoc
pprStrictness DmdSig
str_info)
, (Bool
has_cpr_info, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Cpr=" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> CprSig -> SDoc
forall a. Outputable a => a -> SDoc
ppr CprSig
cpr_info)
, (Bool
has_unf, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Unf=" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Unfolding -> SDoc
forall a. Outputable a => a -> SDoc
ppr Unfolding
unf_info)
, (Bool -> Bool
not ([CoreRule] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CoreRule]
rules), String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"RULES:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((CoreRule -> SDoc) -> [CoreRule] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map CoreRule -> SDoc
pprRule [CoreRule]
rules))
]
where
pp_scope :: SDoc
pp_scope | Id -> Bool
isGlobalId Id
id = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"GblId"
| Id -> Bool
isExportedId Id
id = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"LclIdX"
| Bool
otherwise = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"LclId"
arity :: ArityInfo
arity = IdInfo -> ArityInfo
arityInfo IdInfo
info
has_arity :: Bool
has_arity = ArityInfo
arity ArityInfo -> ArityInfo -> Bool
forall a. Eq a => a -> a -> Bool
/= ArityInfo
0
called_arity :: ArityInfo
called_arity = IdInfo -> ArityInfo
callArityInfo IdInfo
info
has_called_arity :: Bool
has_called_arity = ArityInfo
called_arity ArityInfo -> ArityInfo -> Bool
forall a. Eq a => a -> a -> Bool
/= ArityInfo
0
caf_info :: CafInfo
caf_info = IdInfo -> CafInfo
cafInfo IdInfo
info
has_caf_info :: Bool
has_caf_info = Bool -> Bool
not (CafInfo -> Bool
mayHaveCafRefs CafInfo
caf_info)
str_info :: DmdSig
str_info = IdInfo -> DmdSig
dmdSigInfo IdInfo
info
has_str_info :: Bool
has_str_info = Bool -> Bool
not (DmdSig -> Bool
isNopSig DmdSig
str_info)
cpr_info :: CprSig
cpr_info = IdInfo -> CprSig
cprSigInfo IdInfo
info
has_cpr_info :: Bool
has_cpr_info = CprSig
cpr_info CprSig -> CprSig -> Bool
forall a. Eq a => a -> a -> Bool
/= CprSig
topCprSig
unf_info :: Unfolding
unf_info = IdInfo -> Unfolding
realUnfoldingInfo IdInfo
info
has_unf :: Bool
has_unf = Unfolding -> Bool
hasSomeUnfolding Unfolding
unf_info
rules :: [CoreRule]
rules = RuleInfo -> [CoreRule]
ruleInfoRules (IdInfo -> RuleInfo
ruleInfo IdInfo
info)
showAttributes :: [(Bool,SDoc)] -> SDoc
showAttributes :: [(Bool, SDoc)] -> SDoc
showAttributes [(Bool, SDoc)]
stuff
| [SDoc] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SDoc]
docs = SDoc
forall doc. IsOutput doc => doc
empty
| Bool
otherwise = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
brackets ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep (SDoc -> [SDoc] -> [SDoc]
forall doc. IsLine doc => doc -> [doc] -> [doc]
punctuate SDoc
forall doc. IsLine doc => doc
comma [SDoc]
docs))
where
docs :: [SDoc]
docs = [SDoc
d | (Bool
True,SDoc
d) <- [(Bool, SDoc)]
stuff]
instance Outputable UnfoldingGuidance where
ppr :: UnfoldingGuidance -> SDoc
ppr UnfoldingGuidance
UnfNever = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"NEVER"
ppr (UnfWhen { ug_arity :: UnfoldingGuidance -> ArityInfo
ug_arity = ArityInfo
arity, ug_unsat_ok :: UnfoldingGuidance -> Bool
ug_unsat_ok = Bool
unsat_ok, ug_boring_ok :: UnfoldingGuidance -> Bool
ug_boring_ok = Bool
boring_ok })
= String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"ALWAYS_IF" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<>
SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"arity=" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> ArityInfo -> SDoc
forall doc. IsLine doc => ArityInfo -> doc
int ArityInfo
arity SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<>
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"unsat_ok=" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Bool -> SDoc
forall a. Outputable a => a -> SDoc
ppr Bool
unsat_ok SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<>
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"boring_ok=" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Bool -> SDoc
forall a. Outputable a => a -> SDoc
ppr Bool
boring_ok)
ppr (UnfIfGoodArgs { ug_args :: UnfoldingGuidance -> [ArityInfo]
ug_args = [ArityInfo]
cs, ug_size :: UnfoldingGuidance -> ArityInfo
ug_size = ArityInfo
size, ug_res :: UnfoldingGuidance -> ArityInfo
ug_res = ArityInfo
discount })
= [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"IF_ARGS",
SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
brackets ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep ((ArityInfo -> SDoc) -> [ArityInfo] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map ArityInfo -> SDoc
forall doc. IsLine doc => ArityInfo -> doc
int [ArityInfo]
cs)),
ArityInfo -> SDoc
forall doc. IsLine doc => ArityInfo -> doc
int ArityInfo
size,
ArityInfo -> SDoc
forall doc. IsLine doc => ArityInfo -> doc
int ArityInfo
discount ]
instance Outputable Unfolding where
ppr :: Unfolding -> SDoc
ppr Unfolding
NoUnfolding = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"No unfolding"
ppr Unfolding
BootUnfolding = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"No unfolding (from boot)"
ppr (OtherCon [AltCon]
cs) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"OtherCon" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [AltCon] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [AltCon]
cs
ppr (DFunUnfolding { df_bndrs :: Unfolding -> [Id]
df_bndrs = [Id]
bndrs, df_con :: Unfolding -> DataCon
df_con = DataCon
con, df_args :: Unfolding -> [CoreExpr]
df_args = [CoreExpr]
args })
= SDoc -> ArityInfo -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"DFun:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'\\'
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep ((Id -> SDoc) -> [Id] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (BindingSite -> Id -> SDoc
forall a. OutputableBndr a => BindingSite -> a -> SDoc
pprBndr BindingSite
LambdaBind) [Id]
bndrs) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
arrow)
ArityInfo
2 (DataCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr DataCon
con SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep (Annotation Id -> [CoreExpr] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map Annotation Id
forall a. Outputable a => a -> SDoc
ppr [CoreExpr]
args))
ppr (CoreUnfolding { uf_src :: Unfolding -> UnfoldingSource
uf_src = UnfoldingSource
src
, uf_tmpl :: Unfolding -> CoreExpr
uf_tmpl=CoreExpr
rhs, uf_is_top :: Unfolding -> Bool
uf_is_top=Bool
top
, uf_cache :: Unfolding -> UnfoldingCache
uf_cache=UnfoldingCache
cache, uf_guidance :: Unfolding -> UnfoldingGuidance
uf_guidance=UnfoldingGuidance
g })
= String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Unf" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
braces (SDoc
pp_info SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ SDoc
pp_rhs)
where
pp_info :: SDoc
pp_info = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
fsep ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> [SDoc] -> [SDoc]
forall doc. IsLine doc => doc -> [doc] -> [doc]
punctuate SDoc
forall doc. IsLine doc => doc
comma
[ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Src=" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> UnfoldingSource -> SDoc
forall a. Outputable a => a -> SDoc
ppr UnfoldingSource
src
, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"TopLvl=" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Bool -> SDoc
forall a. Outputable a => a -> SDoc
ppr Bool
top
, UnfoldingCache -> SDoc
forall a. Outputable a => a -> SDoc
ppr UnfoldingCache
cache
, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Guidance=" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> UnfoldingGuidance -> SDoc
forall a. Outputable a => a -> SDoc
ppr UnfoldingGuidance
g ]
pp_tmpl :: SDoc
pp_tmpl = (SDocContext -> Bool) -> SDoc -> SDoc
forall doc. IsLine doc => (SDocContext -> Bool) -> doc -> doc
ppUnlessOption SDocContext -> Bool
sdocSuppressUnfoldings
(String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Tmpl=" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Annotation Id
forall a. Outputable a => a -> SDoc
ppr CoreExpr
rhs)
pp_rhs :: SDoc
pp_rhs | UnfoldingSource -> Bool
isStableSource UnfoldingSource
src = SDoc
pp_tmpl
| Bool
otherwise = SDoc
forall doc. IsOutput doc => doc
empty
instance Outputable UnfoldingCache where
ppr :: UnfoldingCache -> SDoc
ppr (UnfoldingCache { uf_is_value :: UnfoldingCache -> Bool
uf_is_value = Bool
hnf, uf_is_conlike :: UnfoldingCache -> Bool
uf_is_conlike = Bool
conlike
, uf_is_work_free :: UnfoldingCache -> Bool
uf_is_work_free = Bool
wf, uf_expandable :: UnfoldingCache -> Bool
uf_expandable = Bool
exp })
= [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
fsep ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> [SDoc] -> [SDoc]
forall doc. IsLine doc => doc -> [doc] -> [doc]
punctuate SDoc
forall doc. IsLine doc => doc
comma
[ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Value=" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Bool -> SDoc
forall a. Outputable a => a -> SDoc
ppr Bool
hnf
, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"ConLike=" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Bool -> SDoc
forall a. Outputable a => a -> SDoc
ppr Bool
conlike
, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"WorkFree=" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Bool -> SDoc
forall a. Outputable a => a -> SDoc
ppr Bool
wf
, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Expandable=" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Bool -> SDoc
forall a. Outputable a => a -> SDoc
ppr Bool
exp ]
instance Outputable CoreRule where
ppr :: CoreRule -> SDoc
ppr = CoreRule -> SDoc
pprRule
pprRules :: [CoreRule] -> SDoc
pprRules :: [CoreRule] -> SDoc
pprRules [CoreRule]
rules = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((CoreRule -> SDoc) -> [CoreRule] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map CoreRule -> SDoc
pprRule [CoreRule]
rules)
pprRule :: CoreRule -> SDoc
pprRule :: CoreRule -> SDoc
pprRule (BuiltinRule { ru_fn :: CoreRule -> Name
ru_fn = Name
fn, ru_name :: CoreRule -> RuleName
ru_name = RuleName
name})
= String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Built in rule for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
fn SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
doubleQuotes (RuleName -> SDoc
forall doc. IsLine doc => RuleName -> doc
ftext RuleName
name)
pprRule (Rule { ru_name :: CoreRule -> RuleName
ru_name = RuleName
name, ru_act :: CoreRule -> Activation
ru_act = Activation
act, ru_fn :: CoreRule -> Name
ru_fn = Name
fn,
ru_bndrs :: CoreRule -> [Id]
ru_bndrs = [Id]
tpl_vars, ru_args :: CoreRule -> [CoreExpr]
ru_args = [CoreExpr]
tpl_args,
ru_rhs :: CoreRule -> CoreExpr
ru_rhs = CoreExpr
rhs })
= SDoc -> ArityInfo -> SDoc -> SDoc
hang (SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
doubleQuotes (RuleName -> SDoc
forall doc. IsLine doc => RuleName -> doc
ftext RuleName
name) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Activation -> SDoc
forall a. Outputable a => a -> SDoc
ppr Activation
act)
ArityInfo
4 ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"forall" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Id] -> SDoc
pprCoreBinders [Id]
tpl_vars SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
dot,
ArityInfo -> SDoc -> SDoc
nest ArityInfo
2 (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
fn SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep (Annotation Id -> [CoreExpr] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map Annotation Id
forall b. OutputableBndr b => Expr b -> SDoc
pprArg [CoreExpr]
tpl_args)),
ArityInfo -> SDoc -> SDoc
nest ArityInfo
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"=" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Annotation Id
forall b. OutputableBndr b => Expr b -> SDoc
pprCoreExpr CoreExpr
rhs)
])
instance Outputable (XTickishId pass) => Outputable (GenTickish pass) where
ppr :: GenTickish pass -> SDoc
ppr (HpcTick Module
modl ArityInfo
ix) =
[SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hcat [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"hpc<",
Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
modl, SDoc
forall doc. IsLine doc => doc
comma,
ArityInfo -> SDoc
forall a. Outputable a => a -> SDoc
ppr ArityInfo
ix,
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
">"]
ppr (Breakpoint XBreakpoint pass
_ext ArityInfo
ix [XTickishId pass]
vars) =
[SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hcat [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"break<",
ArityInfo -> SDoc
forall a. Outputable a => a -> SDoc
ppr ArityInfo
ix,
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
">",
SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hcat (SDoc -> [SDoc] -> [SDoc]
forall doc. IsLine doc => doc -> [doc] -> [doc]
punctuate SDoc
forall doc. IsLine doc => doc
comma ((XTickishId pass -> SDoc) -> [XTickishId pass] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map XTickishId pass -> SDoc
forall a. Outputable a => a -> SDoc
ppr [XTickishId pass]
vars)))]
ppr (ProfNote { profNoteCC :: forall (pass :: TickishPass). GenTickish pass -> CostCentre
profNoteCC = CostCentre
cc,
profNoteCount :: forall (pass :: TickishPass). GenTickish pass -> Bool
profNoteCount = Bool
tick,
profNoteScope :: forall (pass :: TickishPass). GenTickish pass -> Bool
profNoteScope = Bool
scope }) =
case (Bool
tick,Bool
scope) of
(Bool
True,Bool
True) -> [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hcat [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"scctick<", CostCentre -> SDoc
forall a. Outputable a => a -> SDoc
ppr CostCentre
cc, Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'>']
(Bool
True,Bool
False) -> [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hcat [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"tick<", CostCentre -> SDoc
forall a. Outputable a => a -> SDoc
ppr CostCentre
cc, Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'>']
(Bool, Bool)
_ -> [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hcat [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"scc<", CostCentre -> SDoc
forall a. Outputable a => a -> SDoc
ppr CostCentre
cc, Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'>']
ppr (SourceNote RealSrcSpan
span String
_) =
[SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"src<", Bool -> RealSrcSpan -> SDoc
pprUserRealSpan Bool
True RealSrcSpan
span, Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'>']