    {-# LANGUAGE CPP #-}

    {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}

    -- | Provides factilities for pretty-printing 'Nabla's in a way appropriate for
    -- user facing pattern match warnings.
    module GHC.HsToCore.Pmc.Ppr (
            pprUncovered
        ) where

    #include "HsVersions.h"

    import GHC.Prelude

    import GHC.Types.Basic
    import GHC.Types.Id
    import GHC.Types.Var.Env
    import GHC.Types.Unique.DFM
    import GHC.Core.ConLike
    import GHC.Core.DataCon
    import GHC.Builtin.Types
    import GHC.Utils.Outputable
    import GHC.Utils.Panic
    import Control.Monad.Trans.RWS.CPS
    import GHC.Utils.Misc
    import GHC.Data.Maybe
    import Data.List.NonEmpty (NonEmpty, nonEmpty, toList)

    import GHC.HsToCore.Pmc.Types
    import GHC.HsToCore.Pmc.Solver

    -- | Pretty-print the guts of an uncovered value vector abstraction, i.e., its
    -- components and refutable shapes associated to any mentioned variables.
    --
    -- Example for @([Just p, q], [p :-> [3,4], q :-> [0,5]])@:
    --
    -- @
    -- (Just p) q
    --     where p is not one of {3, 4}
    --           q is not one of {0, 5}
    -- @
    --
    -- When the set of refutable shapes contains more than 3 elements, the
    -- additional elements are indicated by "...".
    pprUncovered :: Nabla -> [Id] -> SDoc
    pprUncovered :: Nabla -> [Id] -> SDoc
    pprUncovered Nabla
    nabla [Id]
    vas
      | UniqDFM Id (SDoc, [PmAltCon]) -> Bool
    forall key elt. UniqDFM key elt -> Bool
    isNullUDFM UniqDFM Id (SDoc, [PmAltCon])
    refuts = [SDoc] -> SDoc
    fsep [SDoc]
    vec -- there are no refutations
      | Bool
    otherwise         = SDoc -> Int -> SDoc -> SDoc
    hang ([SDoc] -> SDoc
    fsep [SDoc]
    vec) Int
    4 (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
                              String -> SDoc
    text String
    "where" SDoc -> SDoc -> SDoc
    <+> [SDoc] -> SDoc
    vcat (((Unique, (SDoc, [PmAltCon])) -> SDoc)
    -> [(Unique, (SDoc, [PmAltCon]))] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map ((SDoc, [PmAltCon]) -> SDoc
    pprRefutableShapes ((SDoc, [PmAltCon]) -> SDoc)
    -> ((Unique, (SDoc, [PmAltCon])) -> (SDoc, [PmAltCon]))
    -> (Unique, (SDoc, [PmAltCon]))
    -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Unique, (SDoc, [PmAltCon])) -> (SDoc, [PmAltCon])
    forall a b. (a, b) -> b
    snd) (UniqDFM Id (SDoc, [PmAltCon]) -> [(Unique, (SDoc, [PmAltCon]))]
    forall key elt. UniqDFM key elt -> [(Unique, elt)]
    udfmToList UniqDFM Id (SDoc, [PmAltCon])
    refuts))
      where
        init_prec :: PprPrec
    init_prec
          -- No outer parentheses when it's a unary pattern by assuming lowest
          -- precedence
          | [Id
    _] <- [Id]
    vas   = PprPrec
    topPrec
          | Bool
    otherwise    = PprPrec
    appPrec
        ppr_action :: RWST Nabla () (DIdEnv (Id, SDoc), [SDoc]) Identity [SDoc]
    ppr_action       = (Id -> RWST Nabla () (DIdEnv (Id, SDoc), [SDoc]) Identity SDoc)
    -> [Id]
    -> RWST Nabla () (DIdEnv (Id, SDoc), [SDoc]) Identity [SDoc]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (PprPrec
    -> Id -> RWST Nabla () (DIdEnv (Id, SDoc), [SDoc]) Identity SDoc
    pprPmVar PprPrec
    init_prec) [Id]
    vas
        ([SDoc]
    vec, DIdEnv (Id, SDoc)
    renamings) = Nabla
    -> RWST Nabla () (DIdEnv (Id, SDoc), [SDoc]) Identity [SDoc]
    -> ([SDoc], DIdEnv (Id, SDoc))
    forall a. Nabla -> PmPprM a -> (a, DIdEnv (Id, SDoc))
    runPmPpr Nabla
    nabla RWST Nabla () (DIdEnv (Id, SDoc), [SDoc]) Identity [SDoc]
    ppr_action
        refuts :: UniqDFM Id (SDoc, [PmAltCon])
    refuts           = Nabla -> DIdEnv (Id, SDoc) -> UniqDFM Id (SDoc, [PmAltCon])
    prettifyRefuts Nabla
    nabla DIdEnv (Id, SDoc)
    renamings

    -- | Output refutable shapes of a variable in the form of @var is not one of {2,
    -- Nothing, 3}@. Will never print more than 3 refutable shapes, the tail is
    -- indicated by an ellipsis.
    pprRefutableShapes :: (SDoc,[PmAltCon]) -> SDoc
    pprRefutableShapes :: (SDoc, [PmAltCon]) -> SDoc
    pprRefutableShapes (SDoc
    var, [PmAltCon]
    alts)
      = SDoc
    var SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "is not one of" SDoc -> SDoc -> SDoc
    <+> [PmAltCon] -> SDoc
    format_alts [PmAltCon]
    alts
      where
        format_alts :: [PmAltCon] -> SDoc
    format_alts = SDoc -> SDoc
    braces (SDoc -> SDoc) -> ([PmAltCon] -> SDoc) -> [PmAltCon] -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [SDoc] -> SDoc
    fsep ([SDoc] -> SDoc) -> ([PmAltCon] -> [SDoc]) -> [PmAltCon] -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SDoc -> [SDoc] -> [SDoc]
    punctuate SDoc
    comma ([SDoc] -> [SDoc])
    -> ([PmAltCon] -> [SDoc]) -> [PmAltCon] -> [SDoc]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [SDoc] -> [SDoc]
    shorten ([SDoc] -> [SDoc])
    -> ([PmAltCon] -> [SDoc]) -> [PmAltCon] -> [SDoc]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (PmAltCon -> SDoc) -> [PmAltCon] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map PmAltCon -> SDoc
    ppr_alt
        shorten :: [SDoc] -> [SDoc]
    shorten (SDoc
    a:SDoc
    b:SDoc
    c:SDoc
    _:[SDoc]
    _)       = SDoc
    aSDoc -> [SDoc] -> [SDoc]
    forall a. a -> [a] -> [a]
    :SDoc
    bSDoc -> [SDoc] -> [SDoc]
    forall a. a -> [a] -> [a]
    :SDoc
    cSDoc -> [SDoc] -> [SDoc]
    forall a. a -> [a] -> [a]
    :[String -> SDoc
    text String
    "..."]
        shorten [SDoc]
    xs                = [SDoc]
    xs
        ppr_alt :: PmAltCon -> SDoc
    ppr_alt (PmAltConLike ConLike
    cl) = ConLike -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ConLike
    cl
        ppr_alt (PmAltLit PmLit
    lit)    = PmLit -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr PmLit
    lit

    {- 1. Literals
    ~~~~~~~~~~~~~~
    Starting with a function definition like:

        f :: Int -> Bool
        f 5 = True
        f 6 = True

    The uncovered set looks like:
        { var |> var /= 5, var /= 6 }

    Yet, we would like to print this nicely as follows:
       x , where x not one of {5,6}

    Since these variables will be shown to the programmer, we give them better names
    (t1, t2, ..) in 'prettifyRefuts', hence the SDoc in 'PrettyPmRefutEnv'.

    2. Residual Constraints
    ~~~~~~~~~~~~~~~~~~~~~~~
    Unhandled constraints that refer to HsExpr are typically ignored by the solver
    (it does not even substitute in HsExpr so they are even printed as wildcards).
    Additionally, the oracle returns a substitution if it succeeds so we apply this
    substitution to the vectors before printing them out (see function `pprOne' in
    "GHC.HsToCore.Pmc") to be more precise.
    -}

    -- | Extract and assigns pretty names to constraint variables with refutable
    -- shapes.
    prettifyRefuts :: Nabla -> DIdEnv (Id, SDoc) -> DIdEnv (SDoc, [PmAltCon])
    prettifyRefuts :: Nabla -> DIdEnv (Id, SDoc) -> UniqDFM Id (SDoc, [PmAltCon])
    prettifyRefuts Nabla
    nabla = [(Unique, (SDoc, [PmAltCon]))] -> UniqDFM Id (SDoc, [PmAltCon])
    forall elt key. [(Unique, elt)] -> UniqDFM key elt
    listToUDFM_Directly ([(Unique, (SDoc, [PmAltCon]))] -> UniqDFM Id (SDoc, [PmAltCon]))
    -> (DIdEnv (Id, SDoc) -> [(Unique, (SDoc, [PmAltCon]))])
    -> DIdEnv (Id, SDoc)
    -> UniqDFM Id (SDoc, [PmAltCon])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((Unique, (Id, SDoc)) -> (Unique, (SDoc, [PmAltCon])))
    -> [(Unique, (Id, SDoc))] -> [(Unique, (SDoc, [PmAltCon]))]
    forall a b. (a -> b) -> [a] -> [b]
    map (Unique, (Id, SDoc)) -> (Unique, (SDoc, [PmAltCon]))
    attach_refuts ([(Unique, (Id, SDoc))] -> [(Unique, (SDoc, [PmAltCon]))])
    -> (DIdEnv (Id, SDoc) -> [(Unique, (Id, SDoc))])
    -> DIdEnv (Id, SDoc)
    -> [(Unique, (SDoc, [PmAltCon]))]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DIdEnv (Id, SDoc) -> [(Unique, (Id, SDoc))]
    forall key elt. UniqDFM key elt -> [(Unique, elt)]
    udfmToList
      where
        attach_refuts :: (Unique, (Id, SDoc)) -> (Unique, (SDoc, [PmAltCon]))
    attach_refuts (Unique
    u, (Id
    x, SDoc
    sdoc)) = (Unique
    u, (SDoc
    sdoc, Nabla -> Id -> [PmAltCon]
    lookupRefuts Nabla
    nabla Id
    x))

    type PmPprM a = RWS Nabla () (DIdEnv (Id, SDoc), [SDoc]) a

    -- Try nice names p,q,r,s,t before using the (ugly) t_i
    nameList :: [SDoc]
    nameList :: [SDoc]
    nameList = (String -> SDoc) -> [String] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> SDoc
    text [String
    "p",String
    "q",String
    "r",String
    "s",String
    "t"] [SDoc] -> [SDoc] -> [SDoc]
    forall a. [a] -> [a] -> [a]
    ++
                [ String -> SDoc
    text (Char
    't'Char -> String -> String
    forall a. a -> [a] -> [a]
    :Int -> String
    forall a. Show a => a -> String
    show Int
    u) | Int
    u <- [(Int
    0 :: Int)..] ]

    runPmPpr :: Nabla -> PmPprM a -> (a, DIdEnv (Id, SDoc))
    runPmPpr :: forall a. Nabla -> PmPprM a -> (a, DIdEnv (Id, SDoc))
    runPmPpr Nabla
    nabla PmPprM a
    m = case PmPprM a
    -> Nabla
    -> (DIdEnv (Id, SDoc), [SDoc])
    -> (a, (DIdEnv (Id, SDoc), [SDoc]), ())
    forall w r s a. Monoid w => RWS r w s a -> r -> s -> (a, s, w)
    runRWS PmPprM a
    m Nabla
    nabla (DIdEnv (Id, SDoc)
    forall a. DVarEnv a
    emptyDVarEnv, [SDoc]
    nameList) of
      (a
    a, (DIdEnv (Id, SDoc)
    renamings, [SDoc]
    _), ()
    _) -> (a
    a, DIdEnv (Id, SDoc)
    renamings)

    -- | Allocates a new, clean name for the given 'Id' if it doesn't already have
    -- one.
    getCleanName :: Id -> PmPprM SDoc
    getCleanName :: Id -> RWST Nabla () (DIdEnv (Id, SDoc), [SDoc]) Identity SDoc
    getCleanName Id
    x = do
      (DIdEnv (Id, SDoc)
    renamings, [SDoc]
    name_supply) <- RWST
      Nabla
      ()
      (DIdEnv (Id, SDoc), [SDoc])
      Identity
      (DIdEnv (Id, SDoc), [SDoc])
    forall (m :: * -> *) r w s. Monad m => RWST r w s m s
    get
      let (SDoc
    clean_name:[SDoc]
    name_supply') = [SDoc]
    name_supply
      case DIdEnv (Id, SDoc) -> Id -> Maybe (Id, SDoc)
    forall a. DVarEnv a -> Id -> Maybe a
    lookupDVarEnv DIdEnv (Id, SDoc)
    renamings Id
    x of
        Just (Id
    _, SDoc
    nm) -> SDoc -> RWST Nabla () (DIdEnv (Id, SDoc), [SDoc]) Identity SDoc
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure SDoc
    nm
        Maybe (Id, SDoc)
    Nothing -> do
          (DIdEnv (Id, SDoc), [SDoc])
    -> RWST Nabla () (DIdEnv (Id, SDoc), [SDoc]) Identity ()
    forall (m :: * -> *) s r w. Monad m => s -> RWST r w s m ()
    put (DIdEnv (Id, SDoc) -> Id -> (Id, SDoc) -> DIdEnv (Id, SDoc)
    forall a. DVarEnv a -> Id -> a -> DVarEnv a
    extendDVarEnv DIdEnv (Id, SDoc)
    renamings Id
    x (Id
    x, SDoc
    clean_name), [SDoc]
    name_supply')
          SDoc -> RWST Nabla () (DIdEnv (Id, SDoc), [SDoc]) Identity SDoc
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure SDoc
    clean_name

    checkRefuts :: Id -> PmPprM (Maybe SDoc) -- the clean name if it has negative info attached
    checkRefuts :: Id -> PmPprM (Maybe SDoc)
    checkRefuts Id
    x = do
      Nabla
    nabla <- RWST Nabla () (DIdEnv (Id, SDoc), [SDoc]) Identity Nabla
    forall (m :: * -> *) r w s. Monad m => RWST r w s m r
    ask
      case Nabla -> Id -> [PmAltCon]
    lookupRefuts Nabla
    nabla Id
    x of
        [] -> Maybe SDoc -> PmPprM (Maybe SDoc)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe SDoc
    forall a. Maybe a
    Nothing -- Will just be a wildcard later on
        [PmAltCon]
    _  -> SDoc -> Maybe SDoc
    forall a. a -> Maybe a
    Just (SDoc -> Maybe SDoc)
    -> RWST Nabla () (DIdEnv (Id, SDoc), [SDoc]) Identity SDoc
    -> PmPprM (Maybe SDoc)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Id -> RWST Nabla () (DIdEnv (Id, SDoc), [SDoc]) Identity SDoc
    getCleanName Id
    x

    -- | Pretty print a variable, but remember to prettify the names of the variables
    -- that refer to neg-literals. The ones that cannot be shown are printed as
    -- underscores.
    pprPmVar :: PprPrec -> Id -> PmPprM SDoc
    pprPmVar :: PprPrec
    -> Id -> RWST Nabla () (DIdEnv (Id, SDoc), [SDoc]) Identity SDoc
    pprPmVar PprPrec
    prec Id
    x = do
      Nabla
    nabla <- RWST Nabla () (DIdEnv (Id, SDoc), [SDoc]) Identity Nabla
    forall (m :: * -> *) r w s. Monad m => RWST r w s m r
    ask
      case Nabla -> Id -> Maybe PmAltConApp
    lookupSolution Nabla
    nabla Id
    x of
        Just (PACA PmAltCon
    alt [Id]
    _tvs [Id]
    args) -> PprPrec
    -> PmAltCon
    -> [Id]
    -> RWST Nabla () (DIdEnv (Id, SDoc), [SDoc]) Identity SDoc
    pprPmAltCon PprPrec
    prec PmAltCon
    alt [Id]
    args
        Maybe PmAltConApp
    Nothing                   -> SDoc -> Maybe SDoc -> SDoc
    forall a. a -> Maybe a -> a
    fromMaybe SDoc
    underscore (Maybe SDoc -> SDoc)
    -> PmPprM (Maybe SDoc)
    -> RWST Nabla () (DIdEnv (Id, SDoc), [SDoc]) Identity SDoc
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Id -> PmPprM (Maybe SDoc)
    checkRefuts Id
    x

    pprPmAltCon :: PprPrec -> PmAltCon -> [Id] -> PmPprM SDoc
    pprPmAltCon :: PprPrec
    -> PmAltCon
    -> [Id]
    -> RWST Nabla () (DIdEnv (Id, SDoc), [SDoc]) Identity SDoc
    pprPmAltCon PprPrec
    _prec (PmAltLit PmLit
    l)      [Id]
    _    = SDoc -> RWST Nabla () (DIdEnv (Id, SDoc), [SDoc]) Identity SDoc
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (PmLit -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr PmLit
    l)
    pprPmAltCon PprPrec
    prec  (PmAltConLike ConLike
    cl) [Id]
    args = do
      Nabla
    nabla <- RWST Nabla () (DIdEnv (Id, SDoc), [SDoc]) Identity Nabla
    forall (m :: * -> *) r w s. Monad m => RWST r w s m r
    ask
      Nabla
    -> PprPrec
    -> ConLike
    -> [Id]
    -> RWST Nabla () (DIdEnv (Id, SDoc), [SDoc]) Identity SDoc
    pprConLike Nabla
    nabla PprPrec
    prec ConLike
    cl [Id]
    args

    pprConLike :: Nabla -> PprPrec -> ConLike -> [Id] -> PmPprM SDoc
    pprConLike :: Nabla
    -> PprPrec
    -> ConLike
    -> [Id]
    -> RWST Nabla () (DIdEnv (Id, SDoc), [SDoc]) Identity SDoc
    pprConLike Nabla
    nabla PprPrec
    _prec ConLike
    cl [Id]
    args
      | Just PmExprList
    pm_expr_list <- Nabla -> PmAltCon -> [Id] -> Maybe PmExprList
    pmExprAsList Nabla
    nabla (ConLike -> PmAltCon
    PmAltConLike ConLike
    cl) [Id]
    args
      = case PmExprList
    pm_expr_list of
          NilTerminated [Id]
    list ->
            SDoc -> SDoc
    brackets (SDoc -> SDoc) -> ([SDoc] -> SDoc) -> [SDoc] -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [SDoc] -> SDoc
    fsep ([SDoc] -> SDoc) -> ([SDoc] -> [SDoc]) -> [SDoc] -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SDoc -> [SDoc] -> [SDoc]
    punctuate SDoc
    comma ([SDoc] -> SDoc)
    -> RWST Nabla () (DIdEnv (Id, SDoc), [SDoc]) Identity [SDoc]
    -> RWST Nabla () (DIdEnv (Id, SDoc), [SDoc]) Identity SDoc
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Id -> RWST Nabla () (DIdEnv (Id, SDoc), [SDoc]) Identity SDoc)
    -> [Id]
    -> RWST Nabla () (DIdEnv (Id, SDoc), [SDoc]) Identity [SDoc]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (PprPrec
    -> Id -> RWST Nabla () (DIdEnv (Id, SDoc), [SDoc]) Identity SDoc
    pprPmVar PprPrec
    appPrec) [Id]
    list
          WcVarTerminated NonEmpty Id
    pref Id
    x ->
            SDoc -> SDoc
    parens   (SDoc -> SDoc) -> ([SDoc] -> SDoc) -> [SDoc] -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [SDoc] -> SDoc
    fcat ([SDoc] -> SDoc) -> ([SDoc] -> [SDoc]) -> [SDoc] -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SDoc -> [SDoc] -> [SDoc]
    punctuate SDoc
    colon ([SDoc] -> SDoc)
    -> RWST Nabla () (DIdEnv (Id, SDoc), [SDoc]) Identity [SDoc]
    -> RWST Nabla () (DIdEnv (Id, SDoc), [SDoc]) Identity SDoc
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Id -> RWST Nabla () (DIdEnv (Id, SDoc), [SDoc]) Identity SDoc)
    -> [Id]
    -> RWST Nabla () (DIdEnv (Id, SDoc), [SDoc]) Identity [SDoc]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (PprPrec
    -> Id -> RWST Nabla () (DIdEnv (Id, SDoc), [SDoc]) Identity SDoc
    pprPmVar PprPrec
    appPrec) (NonEmpty Id -> [Id]
    forall a. NonEmpty a -> [a]
    toList NonEmpty Id
    pref [Id] -> [Id] -> [Id]
    forall a. [a] -> [a] -> [a]
    ++ [Id
    x])
    pprConLike Nabla
    _nabla PprPrec
    _prec (RealDataCon DataCon
    con) [Id]
    args
      | DataCon -> Bool
    isUnboxedTupleDataCon DataCon
    con
      , let hash_parens :: SDoc -> SDoc
    hash_parens SDoc
    doc = String -> SDoc
    text String
    "(#" SDoc -> SDoc -> SDoc
    <+> SDoc
    doc SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "#)"
      = SDoc -> SDoc
    hash_parens (SDoc -> SDoc) -> ([SDoc] -> SDoc) -> [SDoc] -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [SDoc] -> SDoc
    fsep ([SDoc] -> SDoc) -> ([SDoc] -> [SDoc]) -> [SDoc] -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SDoc -> [SDoc] -> [SDoc]
    punctuate SDoc
    comma ([SDoc] -> SDoc)
    -> RWST Nabla () (DIdEnv (Id, SDoc), [SDoc]) Identity [SDoc]
    -> RWST Nabla () (DIdEnv (Id, SDoc), [SDoc]) Identity SDoc
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Id -> RWST Nabla () (DIdEnv (Id, SDoc), [SDoc]) Identity SDoc)
    -> [Id]
    -> RWST Nabla () (DIdEnv (Id, SDoc), [SDoc]) Identity [SDoc]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (PprPrec
    -> Id -> RWST Nabla () (DIdEnv (Id, SDoc), [SDoc]) Identity SDoc
    pprPmVar PprPrec
    appPrec) [Id]
    args
      | DataCon -> Bool
    isTupleDataCon DataCon
    con
      = SDoc -> SDoc
    parens (SDoc -> SDoc) -> ([SDoc] -> SDoc) -> [SDoc] -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [SDoc] -> SDoc
    fsep ([SDoc] -> SDoc) -> ([SDoc] -> [SDoc]) -> [SDoc] -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SDoc -> [SDoc] -> [SDoc]
    punctuate SDoc
    comma ([SDoc] -> SDoc)
    -> RWST Nabla () (DIdEnv (Id, SDoc), [SDoc]) Identity [SDoc]
    -> RWST Nabla () (DIdEnv (Id, SDoc), [SDoc]) Identity SDoc
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Id -> RWST Nabla () (DIdEnv (Id, SDoc), [SDoc]) Identity SDoc)
    -> [Id]
    -> RWST Nabla () (DIdEnv (Id, SDoc), [SDoc]) Identity [SDoc]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (PprPrec
    -> Id -> RWST Nabla () (DIdEnv (Id, SDoc), [SDoc]) Identity SDoc
    pprPmVar PprPrec
    appPrec) [Id]
    args
    pprConLike Nabla
    _nabla PprPrec
    prec ConLike
    cl [Id]
    args
      | ConLike -> Bool
    conLikeIsInfix ConLike
    cl = case [Id]
    args of
          [Id
    x, Id
    y] -> do SDoc
    x' <- PprPrec
    -> Id -> RWST Nabla () (DIdEnv (Id, SDoc), [SDoc]) Identity SDoc
    pprPmVar PprPrec
    funPrec Id
    x
                       SDoc
    y' <- PprPrec
    -> Id -> RWST Nabla () (DIdEnv (Id, SDoc), [SDoc]) Identity SDoc
    pprPmVar PprPrec
    funPrec Id
    y
                       SDoc -> RWST Nabla () (DIdEnv (Id, SDoc), [SDoc]) Identity SDoc
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> SDoc -> SDoc
    cparen (PprPrec
    prec PprPrec -> PprPrec -> Bool
    forall a. Ord a => a -> a -> Bool
    > PprPrec
    opPrec) (SDoc
    x' SDoc -> SDoc -> SDoc
    <+> ConLike -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ConLike
    cl SDoc -> SDoc -> SDoc
    <+> SDoc
    y'))
          -- can it be infix but have more than two arguments?
          [Id]
    list   -> String
    -> SDoc -> RWST Nabla () (DIdEnv (Id, SDoc), [SDoc]) Identity SDoc
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "pprConLike:" ([Id] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [Id]
    list)
      | [Id] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Id]
    args = SDoc -> RWST Nabla () (DIdEnv (Id, SDoc), [SDoc]) Identity SDoc
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ConLike -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ConLike
    cl)
      | Bool
    otherwise = do [SDoc]
    args' <- (Id -> RWST Nabla () (DIdEnv (Id, SDoc), [SDoc]) Identity SDoc)
    -> [Id]
    -> RWST Nabla () (DIdEnv (Id, SDoc), [SDoc]) Identity [SDoc]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (PprPrec
    -> Id -> RWST Nabla () (DIdEnv (Id, SDoc), [SDoc]) Identity SDoc
    pprPmVar PprPrec
    appPrec) [Id]
    args
                       SDoc -> RWST Nabla () (DIdEnv (Id, SDoc), [SDoc]) Identity SDoc
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> SDoc -> SDoc
    cparen (PprPrec
    prec PprPrec -> PprPrec -> Bool
    forall a. Ord a => a -> a -> Bool
    > PprPrec
    funPrec) ([SDoc] -> SDoc
    fsep (ConLike -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ConLike
    cl SDoc -> [SDoc] -> [SDoc]
    forall a. a -> [a] -> [a]
    : [SDoc]
    args')))

    -- | The result of 'pmExprAsList'.
    data PmExprList
      = NilTerminated [Id]
      | WcVarTerminated (NonEmpty Id) Id

    -- | Extract a list of 'Id's out of a sequence of cons cells, optionally
    -- terminated by a wildcard variable instead of @[]@. Some examples:
    --
    -- * @pmExprAsList (1:2:[]) == Just ('NilTerminated' [1,2])@, a regular,
    --   @[]@-terminated list. Should be pretty-printed as @[1,2]@.
    -- * @pmExprAsList (1:2:x) == Just ('WcVarTerminated' [1,2] x)@, a list prefix
    --   ending in a wildcard variable x (of list type). Should be pretty-printed as
    --   (1:2:_).
    -- * @pmExprAsList [] == Just ('NilTerminated' [])@
    pmExprAsList :: Nabla -> PmAltCon -> [Id] -> Maybe PmExprList
    pmExprAsList :: Nabla -> PmAltCon -> [Id] -> Maybe PmExprList
    pmExprAsList Nabla
    nabla = [Id] -> PmAltCon -> [Id] -> Maybe PmExprList
    go_con []
      where
        go_var :: [Id] -> Id -> Maybe PmExprList
    go_var [Id]
    rev_pref Id
    x
          | Just (PACA PmAltCon
    alt [Id]
    _tvs [Id]
    args) <- Nabla -> Id -> Maybe PmAltConApp
    lookupSolution Nabla
    nabla Id
    x
          = [Id] -> PmAltCon -> [Id] -> Maybe PmExprList
    go_con [Id]
    rev_pref PmAltCon
    alt [Id]
    args
        go_var [Id]
    rev_pref Id
    x
          | Just NonEmpty Id
    pref <- [Id] -> Maybe (NonEmpty Id)
    forall a. [a] -> Maybe (NonEmpty a)
    nonEmpty ([Id] -> [Id]
    forall a. [a] -> [a]
    reverse [Id]
    rev_pref)
          = PmExprList -> Maybe PmExprList
    forall a. a -> Maybe a
    Just (NonEmpty Id -> Id -> PmExprList
    WcVarTerminated NonEmpty Id
    pref Id
    x)
        go_var [Id]
    _ Id
    _
          = Maybe PmExprList
    forall a. Maybe a
    Nothing

        go_con :: [Id] -> PmAltCon -> [Id] -> Maybe PmExprList
    go_con [Id]
    rev_pref (PmAltConLike (RealDataCon DataCon
    c)) [Id]
    es
          | DataCon
    c DataCon -> DataCon -> Bool
    forall a. Eq a => a -> a -> Bool
    == DataCon
    nilDataCon
          = ASSERT( null es ) Just (NilTerminated (reverse rev_pref))
          | DataCon
    c DataCon -> DataCon -> Bool
    forall a. Eq a => a -> a -> Bool
    == DataCon
    consDataCon
          = ASSERT( length es == 2 ) go_var (es !! 0 : rev_pref) (es !! 1)
        go_con [Id]
    _ PmAltCon
    _ [Id]
    _
          = Maybe PmExprList
    forall a. Maybe a
    Nothing