    {-# LANGUAGE LambdaCase #-}

    {-
       these are needed for the Outputable instance for GenTickish,
       since we need XTickishId to be Outputable. This should immediately
       resolve to something like Id.
     -}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE UndecidableInstances #-}

    {-# OPTIONS_GHC -fno-warn-orphans #-}

    {-
    (c) The University of Glasgow 2006
    (c) The AQUA Project, Glasgow University, 1996-1998

    Printing of Core syntax
    -}

    module GHC.Core.Ppr (
            pprCoreExpr, pprParendExpr,
            pprCoreBinding, pprCoreBindings, pprCoreAlt,
            pprCoreBindingWithSize, pprCoreBindingsWithSize,
            pprCoreBinder, pprCoreBinders,
            pprRules, pprOptCo
        ) where

    import GHC.Prelude

    import GHC.Core
    import GHC.Core.Stats (exprStats)
    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.Data.FastString
    import GHC.Types.SrcLoc ( pprUserRealSpan )
    import GHC.Types.Tickish

    {-
    ************************************************************************
    *                                                                      *
    \subsection{Public interfaces for Core printing (excluding instances)}
    *                                                                      *
    ************************************************************************

    @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 :: forall b. OutputableBndr b => [Bind b] -> SDoc
    pprCoreBindings = forall a. OutputableBndr a => Annotation a -> [Bind a] -> SDoc
    pprTopBinds forall b. Expr b -> SDoc
    noAnn
    pprCoreBinding :: forall b. OutputableBndr b => Bind b -> SDoc
    pprCoreBinding  = forall a. OutputableBndr a => Annotation a -> Bind a -> SDoc
    pprTopBind forall b. Expr b -> SDoc
    noAnn

    pprCoreBindingsWithSize :: [CoreBind] -> SDoc
    pprCoreBindingWithSize  :: CoreBind  -> SDoc

    pprCoreBindingsWithSize :: [CoreBind] -> SDoc
    pprCoreBindingsWithSize = forall a. OutputableBndr a => Annotation a -> [Bind a] -> SDoc
    pprTopBinds CoreExpr -> SDoc
    sizeAnn
    pprCoreBindingWithSize :: CoreBind -> SDoc
    pprCoreBindingWithSize = forall a. OutputableBndr a => Annotation a -> Bind a -> SDoc
    pprTopBind CoreExpr -> SDoc
    sizeAnn

    instance OutputableBndr b => Outputable (Bind b) where
        ppr :: Bind b -> SDoc
    ppr Bind b
    bind = forall a. OutputableBndr a => Annotation a -> Bind a -> SDoc
    ppr_bind forall b. Expr b -> SDoc
    noAnn Bind b
    bind

    instance OutputableBndr b => Outputable (Expr b) where
        ppr :: Expr b -> SDoc
    ppr Expr b
    expr = 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 = forall b. OutputableBndr b => Alt b -> SDoc
    pprCoreAlt Alt b
    expr

    {-
    ************************************************************************
    *                                                                      *
    \subsection{The guts}
    *                                                                      *
    ************************************************************************
    -}

    -- | A function to produce an annotation for a given right-hand-side
    type Annotation b = Expr b -> SDoc

    -- | Annotate with the size of the right-hand-side
    sizeAnn :: CoreExpr -> SDoc
    sizeAnn :: CoreExpr -> SDoc
    sizeAnn CoreExpr
    e = String -> SDoc
    text String
    "-- RHS size:" SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr (CoreExpr -> CoreStats
    exprStats CoreExpr
    e)

    -- | No annotation
    noAnn :: Expr b -> SDoc
    noAnn :: forall b. Expr b -> SDoc
    noAnn Expr b
    _ = SDoc
    empty

    pprTopBinds :: OutputableBndr a
                => Annotation a -- ^ generate an annotation to place before the
                                -- binding
                -> [Bind a]     -- ^ bindings to show
                -> SDoc         -- ^ the pretty result
    pprTopBinds :: forall a. OutputableBndr a => Annotation a -> [Bind a] -> SDoc
    pprTopBinds Annotation a
    ann [Bind a]
    binds = [SDoc] -> SDoc
    vcat (forall a b. (a -> b) -> [a] -> [b]
    map (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)
     = forall b. OutputableBndr b => Annotation b -> (b, Expr b) -> SDoc
    ppr_binding Annotation a
    ann (a
    binder,Expr a
    expr) SDoc -> SDoc -> SDoc
    $$ SDoc
    blankLine

    pprTopBind Annotation a
    _ (Rec [])
      = String -> SDoc
    text String
    "Rec { }"
    pprTopBind Annotation a
    ann (Rec ((a, Expr a)
    b:[(a, Expr a)]
    bs))
      = [SDoc] -> SDoc
    vcat [String -> SDoc
    text String
    "Rec {",
              forall b. OutputableBndr b => Annotation b -> (b, Expr b) -> SDoc
    ppr_binding Annotation a
    ann (a, Expr a)
    b,
              [SDoc] -> SDoc
    vcat [SDoc
    blankLine SDoc -> SDoc -> 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
    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) = 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
    vcat (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 = forall b. OutputableBndr b => Annotation b -> (b, Expr b) -> SDoc
    ppr_binding Annotation b
    ann (b, Expr b)
    bind SDoc -> SDoc -> SDoc
    <> SDoc
    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
    vcat [ Annotation b
    ann Expr b
    expr
             , (SDocContext -> Bool) -> SDoc -> SDoc
    ppUnlessOption SDocContext -> Bool
    sdocSuppressTypeSignatures
                 (forall a. OutputableBndr a => BindingSite -> a -> SDoc
    pprBndr BindingSite
    LetBind b
    val_bdr)
             , SDoc
    pp_bind
             ]
      where
        pp_val_bdr :: SDoc
    pp_val_bdr = forall a. OutputableBndr a => a -> SDoc
    pprPrefixOcc b
    val_bdr

        pp_bind :: SDoc
    pp_bind = case 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
    equals SDoc -> SDoc -> SDoc
    <+> forall b. OutputableBndr b => Expr b -> SDoc
    pprCoreExpr Expr b
    expr)

          -- For a join point of join arity n, we want to print j = \x1 ... xn -> e
          -- as "j x1 ... xn = e" to differentiate when a join point returns a
          -- lambda (the first rendering looks like a nullary join point returning
          -- an n-argument function).
        pp_join_bind :: ArityInfo -> SDoc
    pp_join_bind ArityInfo
    join_arity
          | [b]
    bndrs forall a. [a] -> ArityInfo -> Bool
    `lengthAtLeast` ArityInfo
    join_arity
          = SDoc -> ArityInfo -> SDoc -> SDoc
    hang (SDoc
    pp_val_bdr SDoc -> SDoc -> SDoc
    <+> [SDoc] -> SDoc
    sep (forall a b. (a -> b) -> [a] -> [b]
    map (forall a. OutputableBndr a => BindingSite -> a -> SDoc
    pprBndr BindingSite
    LambdaBind) [b]
    lhs_bndrs))
               ArityInfo
    2 (SDoc
    equals SDoc -> SDoc -> SDoc
    <+> forall b. OutputableBndr b => Expr b -> SDoc
    pprCoreExpr Expr b
    rhs)
          | Bool
    otherwise -- Yikes!  A join-binding with too few lambda
                      -- Lint will complain, but we don't want to crash
                      -- the pretty-printer else we can't see what's wrong
                      -- So refer to printing  j = e
          = SDoc
    pp_normal_bind
          where
            ([b]
    bndrs, Expr b
    body) = forall b. Expr b -> ([b], Expr b)
    collectBinders Expr b
    expr
            lhs_bndrs :: [b]
    lhs_bndrs = forall a. ArityInfo -> [a] -> [a]
    take ArityInfo
    join_arity [b]
    bndrs
            rhs :: Expr b
    rhs       = forall b. [b] -> Expr b -> Expr b
    mkLams (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 = forall b. OutputableBndr b => (SDoc -> SDoc) -> Expr b -> SDoc
    ppr_expr SDoc -> SDoc
    parens Expr b
    expr
    pprCoreExpr :: forall b. OutputableBndr b => Expr b -> SDoc
    pprCoreExpr   Expr b
    expr = 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
    -- Print a coercion optionally; i.e. honouring -dsuppress-coercions
    pprOptCo :: Coercion -> SDoc
    pprOptCo Coercion
    co = forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
    sdocOption SDocContext -> Bool
    sdocSuppressCoercions forall a b. (a -> b) -> a -> b
    $ \case
                  Bool
    True  -> SDoc -> SDoc
    angleBrackets (String -> SDoc
    text String
    "Co:" SDoc -> SDoc -> SDoc
    <> ArityInfo -> SDoc
    int (Coercion -> ArityInfo
    coercionSize Coercion
    co))
                  Bool
    False -> SDoc -> SDoc
    parens forall a b. (a -> b) -> a -> b
    $ [SDoc] -> SDoc
    sep [forall a. Outputable a => a -> SDoc
    ppr Coercion
    co, SDoc
    dcolon SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr (Coercion -> Type
    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
    text String
    "jump") SDoc -> SDoc -> SDoc
    <+> SDoc
    pp_id)
      | Bool
    otherwise   = SDoc
    pp_id
      where
        pp_id :: SDoc
    pp_id = forall a. Outputable a => a -> SDoc
    ppr Id
    id  -- We could use pprPrefixOcc to print (+) etc, but this is
                        -- Core where we don't print things infix anyway, so doing
                        -- so just adds extra redundant parens

    ppr_expr :: OutputableBndr b => (SDoc -> SDoc) -> Expr b -> SDoc
            -- The function adds parens in context that need
            -- an atomic value (e.g. function args)

    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 Type
    ty)     = SDoc -> SDoc
    add_par (String -> SDoc
    text String
    "TYPE:" SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr Type
    ty)       -- Weird
    ppr_expr SDoc -> SDoc
    add_par (Coercion Coercion
    co) = SDoc -> SDoc
    add_par (String -> SDoc
    text String
    "CO:" SDoc -> SDoc -> 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 forall a b. (a -> b) -> a -> b
    $ [SDoc] -> SDoc
    sep [forall b. OutputableBndr b => Expr b -> SDoc
    pprParendExpr Expr b
    expr, String -> SDoc
    text String
    "`cast`" SDoc -> SDoc -> SDoc
    <+> 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) = forall b. Expr b -> ([b], Expr b)
    collectBinders Expr b
    expr
        in
        SDoc -> SDoc
    add_par forall a b. (a -> b) -> a -> b
    $
        SDoc -> ArityInfo -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "\\" SDoc -> SDoc -> SDoc
    <+> [SDoc] -> SDoc
    sep (forall a b. (a -> b) -> [a] -> [b]
    map (forall a. OutputableBndr a => BindingSite -> a -> SDoc
    pprBndr BindingSite
    LambdaBind) [b]
    bndrs) SDoc -> SDoc -> SDoc
    <+> SDoc
    arrow)
             ArityInfo
    2 (forall b. OutputableBndr b => Expr b -> SDoc
    pprCoreExpr Expr b
    body)

    ppr_expr SDoc -> SDoc
    add_par expr :: Expr b
    expr@(App {})
      = forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
    sdocOption SDocContext -> Bool
    sdocSuppressTypeApplications forall a b. (a -> b) -> a -> b
    $ \Bool
    supp_ty_app ->
        case 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
    sep (forall a b. (a -> b) -> [a] -> [b]
    map forall b. OutputableBndr b => Expr b -> SDoc
    pprArg [Expr b]
    args)
            val_args :: [Expr b]
    val_args    = forall a. (a -> Bool) -> [a] -> [a]
    dropWhile forall b. Expr b -> Bool
    isTypeArg [Expr b]
    args   -- Drop the type arguments for tuples
            pp_tup_args :: SDoc
    pp_tup_args = forall a. (a -> SDoc) -> [a] -> SDoc
    pprWithCommas 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
              | forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Expr b]
    args' = 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
                            -- Notice that we print the *worker*
                            -- for tuples in paren'd format.
                       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 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 (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 Type
    ty [Alt AltCon
    con [b]
    args Expr b
    rhs])
      = forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
    sdocOption SDocContext -> Bool
    sdocPrintCaseAsLet forall a b. (a -> b) -> a -> b
    $ \case
          Bool
    True -> SDoc -> SDoc
    add_par forall a b. (a -> b) -> a -> b
    $  -- See Note [Print case as let]
                   [SDoc] -> SDoc
    sep [ [SDoc] -> SDoc
    sep [ String -> SDoc
    text String
    "let! {"
                               SDoc -> SDoc -> SDoc
    <+> forall a. OutputableBndr a => AltCon -> [a] -> SDoc
    ppr_case_pat AltCon
    con [b]
    args
                               SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "~"
                               SDoc -> SDoc -> SDoc
    <+> b -> SDoc
    ppr_bndr b
    var
                             , String -> SDoc
    text String
    "<-" SDoc -> SDoc -> SDoc
    <+> forall b. OutputableBndr b => (SDoc -> SDoc) -> Expr b -> SDoc
    ppr_expr forall a. a -> a
    id Expr b
    expr
                               SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "} in" ]
                       , forall b. OutputableBndr b => Expr b -> SDoc
    pprCoreExpr Expr b
    rhs
                       ]
          Bool
    False -> SDoc -> SDoc
    add_par forall a b. (a -> b) -> a -> b
    $
                    [SDoc] -> SDoc
    sep [[SDoc] -> SDoc
    sep [[SDoc] -> SDoc
    sep [ String -> SDoc
    text String
    "case" SDoc -> SDoc -> SDoc
    <+> forall b. OutputableBndr b => Expr b -> SDoc
    pprCoreExpr Expr b
    expr
                                  , SDoc -> SDoc
    whenPprDebug (String -> SDoc
    text String
    "return" SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr Type
    ty)
                                  , String -> SDoc
    text String
    "of" SDoc -> SDoc -> SDoc
    <+> b -> SDoc
    ppr_bndr b
    var
                                  ]
                             , Char -> SDoc
    char Char
    '{' SDoc -> SDoc -> SDoc
    <+> forall a. OutputableBndr a => AltCon -> [a] -> SDoc
    ppr_case_pat AltCon
    con [b]
    args SDoc -> SDoc -> SDoc
    <+> SDoc
    arrow
                             ]
                         , forall b. OutputableBndr b => Expr b -> SDoc
    pprCoreExpr Expr b
    rhs
                         , Char -> SDoc
    char Char
    '}'
                         ]
      where
        ppr_bndr :: b -> SDoc
    ppr_bndr = forall a. OutputableBndr a => BindingSite -> a -> SDoc
    pprBndr BindingSite
    CaseBind

    ppr_expr SDoc -> SDoc
    add_par (Case Expr b
    expr b
    var Type
    ty [Alt b]
    alts)
      = SDoc -> SDoc
    add_par forall a b. (a -> b) -> a -> b
    $
        [SDoc] -> SDoc
    sep [[SDoc] -> SDoc
    sep [String -> SDoc
    text String
    "case"
                    SDoc -> SDoc -> SDoc
    <+> forall b. OutputableBndr b => Expr b -> SDoc
    pprCoreExpr Expr b
    expr
                    SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    whenPprDebug (String -> SDoc
    text String
    "return" SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr Type
    ty),
                  String -> SDoc
    text String
    "of" SDoc -> SDoc -> SDoc
    <+> b -> SDoc
    ppr_bndr b
    var SDoc -> SDoc -> SDoc
    <+> Char -> SDoc
    char Char
    '{'],
             ArityInfo -> SDoc -> SDoc
    nest ArityInfo
    2 ([SDoc] -> SDoc
    vcat (SDoc -> [SDoc] -> [SDoc]
    punctuate SDoc
    semi (forall a b. (a -> b) -> [a] -> [b]
    map forall b. OutputableBndr b => Alt b -> SDoc
    pprCoreAlt [Alt b]
    alts))),
             Char -> SDoc
    char Char
    '}'
        ]
      where
        ppr_bndr :: b -> SDoc
    ppr_bndr = forall a. OutputableBndr a => BindingSite -> a -> SDoc
    pprBndr BindingSite
    CaseBind

    -- special cases: let ... in let ...
    -- ("disgusting" SLPJ)

    {-
    ppr_expr add_par (Let bind@(NonRec val_bdr rhs@(Let _ _)) body)
      = add_par $
        vcat [
          hsep [text "let {", (pprBndr LetBind val_bdr $$ ppr val_bndr), equals],
          nest 2 (pprCoreExpr rhs),
          text "} in",
          pprCoreExpr body ]

    ppr_expr add_par (Let bind@(NonRec val_bdr rhs) expr@(Let _ _))
      = add_par
        (hang (text "let {")
              2 (hsep [ppr_binding (val_bdr,rhs),
                       text "} in"])
         $$
         pprCoreExpr expr)
    -}

    -- General case (recursive case, too)
    ppr_expr SDoc -> SDoc
    add_par (Let Bind b
    bind Expr b
    expr)
      = SDoc -> SDoc
    add_par forall a b. (a -> b) -> a -> b
    $
        [SDoc] -> SDoc
    sep [SDoc -> ArityInfo -> SDoc -> SDoc
    hang (forall b. OutputableBndr b => Bind b -> SDoc
    keyword Bind b
    bind SDoc -> SDoc -> SDoc
    <+> Char -> SDoc
    char Char
    '{') ArityInfo
    2 (forall a. OutputableBndr a => Annotation a -> Bind a -> SDoc
    ppr_bind forall b. Expr b -> SDoc
    noAnn Bind b
    bind SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "} in"),
             forall b. OutputableBndr b => Expr b -> SDoc
    pprCoreExpr Expr b
    expr]
      where
        keyword :: Bind a -> SDoc
    keyword (NonRec a
    b Expr a
    _)
         | forall a. Maybe a -> Bool
    isJust (forall a. OutputableBndr a => a -> Maybe ArityInfo
    bndrIsJoin_maybe a
    b) = String -> SDoc
    text String
    "join"
         | Bool
    otherwise                   = String -> SDoc
    text String
    "let"
        keyword (Rec [(a, Expr a)]
    pairs)
         | ((a
    b,Expr a
    _):[(a, Expr a)]
    _) <- [(a, Expr a)]
    pairs
         , forall a. Maybe a -> Bool
    isJust (forall a. OutputableBndr a => a -> Maybe ArityInfo
    bndrIsJoin_maybe a
    b) = String -> SDoc
    text String
    "joinrec"
         | Bool
    otherwise                   = String -> SDoc
    text String
    "letrec"

    ppr_expr SDoc -> SDoc
    add_par (Tick CoreTickish
    tickish Expr b
    expr)
      = forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
    sdocOption SDocContext -> Bool
    sdocSuppressTicks forall a b. (a -> b) -> a -> b
    $ \case
          Bool
    True  -> forall b. OutputableBndr b => (SDoc -> SDoc) -> Expr b -> SDoc
    ppr_expr SDoc -> SDoc
    add_par Expr b
    expr
          Bool
    False -> SDoc -> SDoc
    add_par ([SDoc] -> SDoc
    sep [forall a. Outputable a => a -> SDoc
    ppr CoreTickish
    tickish, 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 (forall a. OutputableBndr a => AltCon -> [a] -> SDoc
    ppr_case_pat AltCon
    con [a]
    args SDoc -> SDoc -> SDoc
    <+> SDoc
    arrow) ArityInfo
    2 (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 (forall a. (a -> SDoc) -> [a] -> SDoc
    pprWithCommas a -> SDoc
    ppr_bndr [a]
    args)
      where
        ppr_bndr :: a -> SDoc
    ppr_bndr = 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
      = forall a. Outputable a => a -> SDoc
    ppr AltCon
    con SDoc -> SDoc -> SDoc
    <+> ([SDoc] -> SDoc
    fsep (forall a b. (a -> b) -> [a] -> [b]
    map a -> SDoc
    ppr_bndr [a]
    args))
      where
        ppr_bndr :: a -> SDoc
    ppr_bndr = forall a. OutputableBndr a => BindingSite -> a -> SDoc
    pprBndr BindingSite
    CasePatBind

    -- | Pretty print the argument in a function application.
    pprArg :: OutputableBndr a => Expr a -> SDoc
    pprArg :: forall b. OutputableBndr b => Expr b -> SDoc
    pprArg (Type Type
    ty)
     = (SDocContext -> Bool) -> SDoc -> SDoc
    ppUnlessOption SDocContext -> Bool
    sdocSuppressTypeApplications
          (String -> SDoc
    text String
    "@" SDoc -> SDoc -> SDoc
    <> Type -> SDoc
    pprParendType Type
    ty)
    pprArg (Coercion Coercion
    co) = String -> SDoc
    text String
    "@~" SDoc -> SDoc -> SDoc
    <> Coercion -> SDoc
    pprOptCo Coercion
    co
    pprArg Expr a
    expr          = forall b. OutputableBndr b => Expr b -> SDoc
    pprParendExpr Expr a
    expr

    {-
    Note [Print case as let]
    ~~~~~~~~~~~~~~~~~~~~~~~~
    Single-branch case expressions are very common:
       case x of y { I# x' ->
       case p of q { I# p' -> ... } }
    These are, in effect, just strict let's, with pattern matching.
    With -dppr-case-as-let we print them as such:
       let! { I# x' ~ y <- x } in
       let! { I# p' ~ q <- p } in ...

    Other printing bits-and-bobs used with the general @pprCoreBinding@
    and @pprCoreExpr@ functions.

    Note [Binding-site specific printing]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    pprCoreBinder and pprTypedLamBinder receive a BindingSite argument to adjust
    the information printed.

    Let-bound binders are printed with their full type and idInfo.

    Case-bound variables (both the case binder and pattern variables) are printed
    without a type and without their unfolding.

    Furthermore, a dead case-binder is completely ignored, while otherwise, dead
    binders are printed as "_".
    -}

    -- These instances are sadly orphans

    instance OutputableBndr Var where
      pprBndr :: BindingSite -> Id -> SDoc
    pprBndr = BindingSite -> Id -> SDoc
    pprCoreBinder
      pprInfixOcc :: Id -> SDoc
    pprInfixOcc  = forall a. (Outputable a, NamedThing a) => a -> SDoc
    pprInfixName  forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Id -> Name
    varName
      pprPrefixOcc :: Id -> SDoc
    pprPrefixOcc = forall a. NamedThing a => a -> SDoc
    pprPrefixName 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 = forall a. Outputable a => a -> SDoc
    ppr TaggedBndr b
    b   -- Simple
      pprInfixOcc :: TaggedBndr b -> SDoc
    pprInfixOcc  TaggedBndr b
    b = forall a. Outputable a => a -> SDoc
    ppr TaggedBndr b
    b
      pprPrefixOcc :: TaggedBndr b -> SDoc
    pprPrefixOcc TaggedBndr b
    b = 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

    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
    $$
                         Id -> IdInfo -> SDoc
    ppIdInfo Id
    binder (HasDebugCallStack => Id -> IdInfo
    idInfo Id
    binder)

    -- Lambda bound type variables are preceded by "@"
    pprCoreBinder BindingSite
    bind_site Id
    bndr
      = (Bool -> SDoc) -> SDoc
    getPprDebug forall a b. (a -> b) -> a -> b
    $ \Bool
    debug ->
        BindingSite -> Bool -> Id -> SDoc
    pprTypedLamBinder BindingSite
    bind_site Bool
    debug Id
    bndr

    pprCoreBinders :: [Var] -> SDoc
    -- Print as lambda-binders, i.e. with their type
    pprCoreBinders :: [Id] -> SDoc
    pprCoreBinders [Id]
    vs = [SDoc] -> SDoc
    sep (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
    text String
    "@" SDoc -> SDoc -> SDoc
    <> forall a. Outputable a => a -> SDoc
    ppr Id
    binder    -- NB: don't print kind
      | Bool
    otherwise      = Id -> SDoc
    pprIdBndr Id
    binder

    pprTypedLamBinder :: BindingSite -> Bool -> Var -> SDoc
    -- For lambda and case binders, show the unfolding info (usually none)
    pprTypedLamBinder :: BindingSite -> Bool -> Id -> SDoc
    pprTypedLamBinder BindingSite
    bind_site Bool
    debug_on Id
    var
      = forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
    sdocOption SDocContext -> Bool
    sdocSuppressTypeSignatures forall a b. (a -> b) -> a -> b
    $ \Bool
    suppress_sigs ->
        case () of
        ()
    _
          | Bool -> Bool
    not Bool
    debug_on            -- Show case-bound wild binders only if debug is on
          , BindingSite
    CaseBind <- BindingSite
    bind_site
          , Id -> Bool
    isDeadBinder Id
    var        -> SDoc
    empty

          | Bool -> Bool
    not Bool
    debug_on            -- Even dead binders can be one-shot
          , Id -> Bool
    isDeadBinder Id
    var        -> Char -> SDoc
    char Char
    '_' SDoc -> SDoc -> SDoc
    <+> Bool -> SDoc -> SDoc
    ppWhen (Id -> Bool
    isId Id
    var)
                                                    (IdInfo -> SDoc
    pprIdBndrInfo (HasDebugCallStack => Id -> IdInfo
    idInfo Id
    var))

          | Bool -> Bool
    not Bool
    debug_on            -- No parens, no kind info
          , 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
    parens (Id -> SDoc
    pprKindedTyVarBndr Id
    var)

          | Bool
    otherwise    -> SDoc -> SDoc
    parens (SDoc -> ArityInfo -> SDoc -> SDoc
    hang (Id -> SDoc
    pprIdBndr Id
    var)
                                       ArityInfo
    2 ([SDoc] -> SDoc
    vcat [ SDoc
    dcolon SDoc -> SDoc -> SDoc
    <+> Type -> SDoc
    pprType (Id -> Type
    idType Id
    var)
                                               , SDoc
    pp_unf]))
      where
        unf_info :: Unfolding
    unf_info = IdInfo -> Unfolding
    unfoldingInfo (HasDebugCallStack => Id -> IdInfo
    idInfo Id
    var)
        pp_unf :: SDoc
    pp_unf | Unfolding -> Bool
    hasSomeUnfolding Unfolding
    unf_info = String -> SDoc
    text String
    "Unf=" SDoc -> SDoc -> SDoc
    <> forall a. Outputable a => a -> SDoc
    ppr Unfolding
    unf_info
               | Bool
    otherwise                 = SDoc
    empty

    pprTypedLetBinder :: Var -> SDoc
    -- Print binder with a type or kind signature (not paren'd)
    pprTypedLetBinder :: Id -> SDoc
    pprTypedLetBinder Id
    binder
      = forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
    sdocOption SDocContext -> Bool
    sdocSuppressTypeSignatures 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
    <+> Type -> SDoc
    pprType (Id -> Type
    idType Id
    binder))

    pprKindedTyVarBndr :: TyVar -> SDoc
    -- Print a type variable binder with its kind (but not if *)
    pprKindedTyVarBndr :: Id -> SDoc
    pprKindedTyVarBndr Id
    tyvar
      = String -> SDoc
    text String
    "@" SDoc -> SDoc -> SDoc
    <> Id -> SDoc
    pprTyVar Id
    tyvar

    -- pprIdBndr does *not* print the type
    -- When printing any Id binder in debug mode, we print its inline pragma and one-shot-ness
    pprIdBndr :: Id -> SDoc
    pprIdBndr :: Id -> SDoc
    pprIdBndr Id
    id = forall a. OutputableBndr a => a -> SDoc
    pprPrefixOcc Id
    id SDoc -> SDoc -> SDoc
    <+> IdInfo -> SDoc
    pprIdBndrInfo (HasDebugCallStack => Id -> IdInfo
    idInfo Id
    id)

    pprIdBndrInfo :: IdInfo -> SDoc
    pprIdBndrInfo :: IdInfo -> SDoc
    pprIdBndrInfo IdInfo
    info
      = (SDocContext -> Bool) -> SDoc -> SDoc
    ppUnlessOption SDocContext -> Bool
    sdocSuppressIdInfo
          (IdInfo
    info seq :: forall a b. a -> b -> b
    `seq` SDoc
    doc) -- The seq is useful for poking on black holes
      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 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
    text String
    "InlPrag=" SDoc -> SDoc -> SDoc
    <> InlinePragma -> SDoc
    pprInlineDebug InlinePragma
    prag_info)
              , (Bool
    has_occ,  String -> SDoc
    text String
    "Occ=" SDoc -> SDoc -> SDoc
    <> forall a. Outputable a => a -> SDoc
    ppr OccInfo
    occ_info)
              , (Bool
    has_dmd,  String -> SDoc
    text String
    "Dmd=" SDoc -> SDoc -> SDoc
    <> forall a. Outputable a => a -> SDoc
    ppr Demand
    dmd_info)
              , (Bool
    has_lbv , String -> SDoc
    text String
    "OS=" SDoc -> SDoc -> 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
    text String
    "InlPrag=" SDoc -> SDoc -> SDoc
    <> InlinePragma -> SDoc
    pprInlineDebug InlinePragma
    prag_info)
        , (Bool
    has_occ,          String -> SDoc
    text String
    "Occ=" SDoc -> SDoc -> SDoc
    <> forall a. Outputable a => a -> SDoc
    ppr OccInfo
    occ_info)
        , (Bool
    has_dmd,          String -> SDoc
    text String
    "Dmd=" SDoc -> SDoc -> SDoc
    <> forall a. Outputable a => a -> SDoc
    ppr Demand
    dmd_info)
        , (Bool
    has_lbv ,         String -> SDoc
    text String
    "OS=" SDoc -> SDoc -> SDoc
    <> forall a. Outputable a => a -> SDoc
    ppr OneShotInfo
    lbv_info)
        , (Bool
    has_arity,        String -> SDoc
    text String
    "Arity=" SDoc -> SDoc -> SDoc
    <> ArityInfo -> SDoc
    int ArityInfo
    arity)
        , (Bool
    has_called_arity, String -> SDoc
    text String
    "CallArity=" SDoc -> SDoc -> SDoc
    <> ArityInfo -> SDoc
    int ArityInfo
    called_arity)
        , (Bool
    has_caf_info,     String -> SDoc
    text String
    "Caf=" SDoc -> SDoc -> SDoc
    <> forall a. Outputable a => a -> SDoc
    ppr CafInfo
    caf_info)
        , (Bool
    has_str_info,     String -> SDoc
    text String
    "Str=" SDoc -> SDoc -> SDoc
    <> StrictSig -> SDoc
    pprStrictness StrictSig
    str_info)
        , (Bool
    has_unf,          String -> SDoc
    text String
    "Unf=" SDoc -> SDoc -> SDoc
    <> forall a. Outputable a => a -> SDoc
    ppr Unfolding
    unf_info)
        , (Bool
    has_rules,        String -> SDoc
    text String
    "RULES:" SDoc -> SDoc -> SDoc
    <+> [SDoc] -> SDoc
    vcat (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 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 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 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 :: StrictSig
    str_info = IdInfo -> StrictSig
    strictnessInfo IdInfo
    info
          has_str_info :: Bool
    has_str_info = Bool -> Bool
    not (StrictSig -> Bool
    isTopSig StrictSig
    str_info)

          unf_info :: Unfolding
    unf_info = IdInfo -> Unfolding
    unfoldingInfo 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 (forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [CoreRule]
    rules)

    {-
    -----------------------------------------------------
    --      IdDetails and IdInfo
    -----------------------------------------------------
    -}

    ppIdInfo :: Id -> IdInfo -> SDoc
    ppIdInfo :: Id -> IdInfo -> SDoc
    ppIdInfo Id
    id IdInfo
    info
      = (SDocContext -> Bool) -> SDoc -> SDoc
    ppUnlessOption SDocContext -> Bool
    sdocSuppressIdInfo forall a b. (a -> b) -> a -> b
    $
        [(Bool, SDoc)] -> SDoc
    showAttributes
        [ (Bool
    True, SDoc
    pp_scope SDoc -> SDoc -> SDoc
    <> forall a. Outputable a => a -> SDoc
    ppr (Id -> IdDetails
    idDetails Id
    id))
        , (Bool
    has_arity,        String -> SDoc
    text String
    "Arity=" SDoc -> SDoc -> SDoc
    <> ArityInfo -> SDoc
    int ArityInfo
    arity)
        , (Bool
    has_called_arity, String -> SDoc
    text String
    "CallArity=" SDoc -> SDoc -> SDoc
    <> ArityInfo -> SDoc
    int ArityInfo
    called_arity)
        , (Bool
    has_caf_info,     String -> SDoc
    text String
    "Caf=" SDoc -> SDoc -> SDoc
    <> forall a. Outputable a => a -> SDoc
    ppr CafInfo
    caf_info)
        , (Bool
    has_str_info,     String -> SDoc
    text String
    "Str=" SDoc -> SDoc -> SDoc
    <> StrictSig -> SDoc
    pprStrictness StrictSig
    str_info)
        , (Bool
    has_cpr_info,     String -> SDoc
    text String
    "Cpr=" SDoc -> SDoc -> SDoc
    <> forall a. Outputable a => a -> SDoc
    ppr CprSig
    cpr_info)
        , (Bool
    has_unf,          String -> SDoc
    text String
    "Unf=" SDoc -> SDoc -> SDoc
    <> forall a. Outputable a => a -> SDoc
    ppr Unfolding
    unf_info)
        , (Bool -> Bool
    not (forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [CoreRule]
    rules), String -> SDoc
    text String
    "RULES:" SDoc -> SDoc -> SDoc
    <+> [SDoc] -> SDoc
    vcat (forall a b. (a -> b) -> [a] -> [b]
    map CoreRule -> SDoc
    pprRule [CoreRule]
    rules))
        ]   -- Inline pragma, occ, demand, one-shot info
            -- printed out with all binders (when debug is on);
            -- see GHC.Core.Ppr.pprIdBndr
      where
        pp_scope :: SDoc
    pp_scope | Id -> Bool
    isGlobalId Id
    id   = String -> SDoc
    text String
    "GblId"
                 | Id -> Bool
    isExportedId Id
    id = String -> SDoc
    text String
    "LclIdX"
                 | Bool
    otherwise       = String -> SDoc
    text String
    "LclId"

        arity :: ArityInfo
    arity = IdInfo -> ArityInfo
    arityInfo IdInfo
    info
        has_arity :: Bool
    has_arity = ArityInfo
    arity 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 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 :: StrictSig
    str_info = IdInfo -> StrictSig
    strictnessInfo IdInfo
    info
        has_str_info :: Bool
    has_str_info = Bool -> Bool
    not (StrictSig -> Bool
    isTopSig StrictSig
    str_info)

        cpr_info :: CprSig
    cpr_info = IdInfo -> CprSig
    cprInfo IdInfo
    info
        has_cpr_info :: Bool
    has_cpr_info = CprSig
    cpr_info forall a. Eq a => a -> a -> Bool
    /= CprSig
    topCprSig

        unf_info :: Unfolding
    unf_info = IdInfo -> Unfolding
    unfoldingInfo 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
      | forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [SDoc]
    docs = SDoc
    empty
      | Bool
    otherwise = SDoc -> SDoc
    brackets ([SDoc] -> SDoc
    sep (SDoc -> [SDoc] -> [SDoc]
    punctuate SDoc
    comma [SDoc]
    docs))
      where
        docs :: [SDoc]
    docs = [SDoc
    d | (Bool
    True,SDoc
    d) <- [(Bool, SDoc)]
    stuff]

    {-
    -----------------------------------------------------
    --      Unfolding and UnfoldingGuidance
    -----------------------------------------------------
    -}

    instance Outputable UnfoldingGuidance where
        ppr :: UnfoldingGuidance -> SDoc
    ppr UnfoldingGuidance
    UnfNever  = String -> SDoc
    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
    text String
    "ALWAYS_IF" SDoc -> SDoc -> SDoc
    <>
            SDoc -> SDoc
    parens (String -> SDoc
    text String
    "arity="     SDoc -> SDoc -> SDoc
    <> ArityInfo -> SDoc
    int ArityInfo
    arity    SDoc -> SDoc -> SDoc
    <> SDoc
    comma SDoc -> SDoc -> SDoc
    <>
                    String -> SDoc
    text String
    "unsat_ok="  SDoc -> SDoc -> SDoc
    <> forall a. Outputable a => a -> SDoc
    ppr Bool
    unsat_ok SDoc -> SDoc -> SDoc
    <> SDoc
    comma SDoc -> SDoc -> SDoc
    <>
                    String -> SDoc
    text String
    "boring_ok=" SDoc -> SDoc -> 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
    hsep [ String -> SDoc
    text String
    "IF_ARGS",
                   SDoc -> SDoc
    brackets ([SDoc] -> SDoc
    hsep (forall a b. (a -> b) -> [a] -> [b]
    map ArityInfo -> SDoc
    int [ArityInfo]
    cs)),
                   ArityInfo -> SDoc
    int ArityInfo
    size,
                   ArityInfo -> SDoc
    int ArityInfo
    discount ]

    instance Outputable UnfoldingSource where
      ppr :: UnfoldingSource -> SDoc
    ppr UnfoldingSource
    InlineCompulsory  = String -> SDoc
    text String
    "Compulsory"
      ppr UnfoldingSource
    InlineStable      = String -> SDoc
    text String
    "InlineStable"
      ppr UnfoldingSource
    InlineRhs         = String -> SDoc
    text String
    "<vanilla>"

    instance Outputable Unfolding where
      ppr :: Unfolding -> SDoc
    ppr Unfolding
    NoUnfolding                = String -> SDoc
    text String
    "No unfolding"
      ppr Unfolding
    BootUnfolding              = String -> SDoc
    text String
    "No unfolding (from boot)"
      ppr (OtherCon [AltCon]
    cs)              = String -> SDoc
    text String
    "OtherCon" SDoc -> SDoc -> 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
    text String
    "DFun:" SDoc -> SDoc -> SDoc
    <+> PtrString -> SDoc
    ptext (String -> PtrString
    sLit String
    "\\")
                    SDoc -> SDoc -> SDoc
    <+> [SDoc] -> SDoc
    sep (forall a b. (a -> b) -> [a] -> [b]
    map (forall a. OutputableBndr a => BindingSite -> a -> SDoc
    pprBndr BindingSite
    LambdaBind) [Id]
    bndrs) SDoc -> SDoc -> SDoc
    <+> SDoc
    arrow)
                ArityInfo
    2 (forall a. Outputable a => a -> SDoc
    ppr DataCon
    con SDoc -> SDoc -> SDoc
    <+> [SDoc] -> SDoc
    sep (forall a b. (a -> b) -> [a] -> [b]
    map 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_is_value :: Unfolding -> Bool
    uf_is_value=Bool
    hnf
                         , uf_is_conlike :: Unfolding -> Bool
    uf_is_conlike=Bool
    conlike, uf_is_work_free :: Unfolding -> Bool
    uf_is_work_free=Bool
    wf
                         , uf_expandable :: Unfolding -> Bool
    uf_expandable=Bool
    exp, uf_guidance :: Unfolding -> UnfoldingGuidance
    uf_guidance=UnfoldingGuidance
    g })
            = String -> SDoc
    text String
    "Unf" SDoc -> SDoc -> SDoc
    <> SDoc -> SDoc
    braces (SDoc
    pp_info SDoc -> SDoc -> SDoc
    $$ SDoc
    pp_rhs)
        where
          pp_info :: SDoc
    pp_info = [SDoc] -> SDoc
    fsep forall a b. (a -> b) -> a -> b
    $ SDoc -> [SDoc] -> [SDoc]
    punctuate SDoc
    comma
                    [ String -> SDoc
    text String
    "Src="        SDoc -> SDoc -> SDoc
    <> forall a. Outputable a => a -> SDoc
    ppr UnfoldingSource
    src
                    , String -> SDoc
    text String
    "TopLvl="     SDoc -> SDoc -> SDoc
    <> forall a. Outputable a => a -> SDoc
    ppr Bool
    top
                    , String -> SDoc
    text String
    "Value="      SDoc -> SDoc -> SDoc
    <> forall a. Outputable a => a -> SDoc
    ppr Bool
    hnf
                    , String -> SDoc
    text String
    "ConLike="    SDoc -> SDoc -> SDoc
    <> forall a. Outputable a => a -> SDoc
    ppr Bool
    conlike
                    , String -> SDoc
    text String
    "WorkFree="   SDoc -> SDoc -> SDoc
    <> forall a. Outputable a => a -> SDoc
    ppr Bool
    wf
                    , String -> SDoc
    text String
    "Expandable=" SDoc -> SDoc -> SDoc
    <> forall a. Outputable a => a -> SDoc
    ppr Bool
    exp
                    , String -> SDoc
    text String
    "Guidance="   SDoc -> SDoc -> SDoc
    <> forall a. Outputable a => a -> SDoc
    ppr UnfoldingGuidance
    g ]
          pp_tmpl :: SDoc
    pp_tmpl = (SDocContext -> Bool) -> SDoc -> SDoc
    ppUnlessOption SDocContext -> Bool
    sdocSuppressUnfoldings
                      (String -> SDoc
    text String
    "Tmpl=" SDoc -> SDoc -> SDoc
    <+> 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
    empty
                -- Don't print the RHS or we get a quadratic
                -- blowup in the size of the printout!

    {-
    -----------------------------------------------------
    --      Rules
    -----------------------------------------------------
    -}

    instance Outputable CoreRule where
       ppr :: CoreRule -> SDoc
    ppr = CoreRule -> SDoc
    pprRule

    pprRules :: [CoreRule] -> SDoc
    pprRules :: [CoreRule] -> SDoc
    pprRules [CoreRule]
    rules = [SDoc] -> SDoc
    vcat (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
    text String
    "Built in rule for" SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr Name
    fn SDoc -> SDoc -> SDoc
    <> SDoc
    colon SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    doubleQuotes (RuleName -> SDoc
    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
    doubleQuotes (RuleName -> SDoc
    ftext RuleName
    name) SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr Activation
    act)
           ArityInfo
    4 ([SDoc] -> SDoc
    sep [String -> SDoc
    text String
    "forall" SDoc -> SDoc -> SDoc
    <+> [Id] -> SDoc
    pprCoreBinders [Id]
    tpl_vars SDoc -> SDoc -> SDoc
    <> SDoc
    dot,
                   ArityInfo -> SDoc -> SDoc
    nest ArityInfo
    2 (forall a. Outputable a => a -> SDoc
    ppr Name
    fn SDoc -> SDoc -> SDoc
    <+> [SDoc] -> SDoc
    sep (forall a b. (a -> b) -> [a] -> [b]
    map forall b. OutputableBndr b => Expr b -> SDoc
    pprArg [CoreExpr]
    tpl_args)),
                   ArityInfo -> SDoc -> SDoc
    nest ArityInfo
    2 (String -> SDoc
    text String
    "=" SDoc -> SDoc -> SDoc
    <+> forall b. OutputableBndr b => Expr b -> SDoc
    pprCoreExpr CoreExpr
    rhs)
                ])

    {-
    -----------------------------------------------------
    --      Tickish
    -----------------------------------------------------
    -}

    instance Outputable (XTickishId pass) => Outputable (GenTickish pass) where
      ppr :: GenTickish pass -> SDoc
    ppr (HpcTick Module
    modl ArityInfo
    ix) =
          [SDoc] -> SDoc
    hcat [String -> SDoc
    text String
    "hpc<",
                forall a. Outputable a => a -> SDoc
    ppr Module
    modl, SDoc
    comma,
                forall a. Outputable a => a -> SDoc
    ppr ArityInfo
    ix,
                String -> SDoc
    text String
    ">"]
      ppr (Breakpoint XBreakpoint pass
    _ext ArityInfo
    ix [XTickishId pass]
    vars) =
          [SDoc] -> SDoc
    hcat [String -> SDoc
    text String
    "break<",
                forall a. Outputable a => a -> SDoc
    ppr ArityInfo
    ix,
                String -> SDoc
    text String
    ">",
                SDoc -> SDoc
    parens ([SDoc] -> SDoc
    hcat (SDoc -> [SDoc] -> [SDoc]
    punctuate SDoc
    comma (forall a b. (a -> b) -> [a] -> [b]
    map 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
    hcat [String -> SDoc
    text String
    "scctick<", forall a. Outputable a => a -> SDoc
    ppr CostCentre
    cc, Char -> SDoc
    char Char
    '>']
             (Bool
    True,Bool
    False) -> [SDoc] -> SDoc
    hcat [String -> SDoc
    text String
    "tick<",    forall a. Outputable a => a -> SDoc
    ppr CostCentre
    cc, Char -> SDoc
    char Char
    '>']
             (Bool, Bool)
    _            -> [SDoc] -> SDoc
    hcat [String -> SDoc
    text String
    "scc<",     forall a. Outputable a => a -> SDoc
    ppr CostCentre
    cc, Char -> SDoc
    char Char
    '>']
      ppr (SourceNote RealSrcSpan
    span String
    _) =
          [SDoc] -> SDoc
    hcat [ String -> SDoc
    text String
    "src<", Bool -> RealSrcSpan -> SDoc
    pprUserRealSpan Bool
    True RealSrcSpan
    span, Char -> SDoc
    char Char
    '>']