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

    import GHC.Prelude

    import GHC.Data.List.Infinite (Infinite (..))
    import qualified GHC.Data.List.Infinite as Inf
    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.Data.Maybe
    import Data.List.NonEmpty (NonEmpty, nonEmpty, toList)

    import GHC.HsToCore.Pmc.Types

    -- | 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 {k} (key :: k) elt. UniqDFM key elt -> Bool
    isNullUDFM UniqDFM Id (SDoc, [PmAltCon])
    refuts = [SDoc] -> SDoc
    forall doc. IsLine doc => [doc] -> doc
    fsep [SDoc]
    vec -- there are no refutations
      | Bool
    otherwise         = SDoc -> Int -> SDoc -> SDoc
    hang ([SDoc] -> SDoc
    forall doc. IsLine doc => [doc] -> doc
    fsep [SDoc]
    vec) Int
    4 (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
                              String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "where" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> [SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    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 {k} (key :: k) 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), Infinite SDoc) Identity [SDoc]
    ppr_action       = (Id
     -> RWST Nabla () (DIdEnv (Id, SDoc), Infinite SDoc) Identity SDoc)
    -> [Id]
    -> RWST Nabla () (DIdEnv (Id, SDoc), Infinite SDoc) Identity [SDoc]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (PprPrec
    -> Id
    -> RWST Nabla () (DIdEnv (Id, SDoc), Infinite SDoc) Identity SDoc
    pprPmVar PprPrec
    init_prec) [Id]
    vas
        ([SDoc]
    vec, DIdEnv (Id, SDoc)
    renamings) = Nabla
    -> RWST Nabla () (DIdEnv (Id, SDoc), Infinite SDoc) Identity [SDoc]
    -> ([SDoc], DIdEnv (Id, SDoc))
    forall a. Nabla -> PmPprM a -> (a, DIdEnv (Id, SDoc))
    runPmPpr Nabla
    nabla RWST Nabla () (DIdEnv (Id, SDoc), Infinite 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
    forall doc. IsLine doc => doc -> doc -> doc
    <+> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "is not one of" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> [PmAltCon] -> SDoc
    format_alts [PmAltCon]
    alts
      where
        format_alts :: [PmAltCon] -> SDoc
    format_alts = SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc
    braces (SDoc -> SDoc) -> ([PmAltCon] -> SDoc) -> [PmAltCon] -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [SDoc] -> SDoc
    forall doc. IsLine doc => [doc] -> doc
    fsep ([SDoc] -> SDoc) -> ([PmAltCon] -> [SDoc]) -> [PmAltCon] -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SDoc -> [SDoc] -> [SDoc]
    forall doc. IsLine doc => doc -> [doc] -> [doc]
    punctuate SDoc
    forall doc. IsLine doc => doc
    comma ([SDoc] -> [SDoc])
    -> ([PmAltCon] -> [SDoc]) -> [PmAltCon] -> [SDoc]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [SDoc] -> [SDoc]
    forall {a}. IsLine a => [a] -> [a]
    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 :: [a] -> [a]
    shorten (a
    a:a
    b:a
    c:a
    _:[a]
    _)       = a
    aa -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :a
    ba -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :a
    ca -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[String -> a
    forall doc. IsLine doc => String -> doc
    text String
    "..."]
        shorten [a]
    xs                = [a]
    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 {k} elt (key :: k). [(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 {k} (key :: k) 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), Infinite SDoc) a

    -- Try nice names p,q,r,s,t before using the (ugly) t_i
    nameList :: Infinite SDoc
    nameList :: Infinite SDoc
    nameList = (String -> SDoc) -> [String] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> SDoc
    forall doc. IsLine doc => String -> doc
    text [String
    "p",String
    "q",String
    "r",String
    "s",String
    "t"] [SDoc] -> Infinite SDoc -> Infinite SDoc
    forall (f :: * -> *) a.
    Foldable f =>
    f a -> Infinite a -> Infinite a
    Inf.++ ((Int -> (SDoc, Int)) -> Int -> Infinite SDoc)
    -> Int -> (Int -> (SDoc, Int)) -> Infinite SDoc
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (Int -> (SDoc, Int)) -> Int -> Infinite SDoc
    forall b a. (b -> (a, b)) -> b -> Infinite a
    Inf.unfoldr (Int
    0 :: Int) (\ Int
    u -> (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text (Char
    't'Char -> String -> String
    forall a. a -> [a] -> [a]
    :Int -> String
    forall a. Show a => a -> String
    show Int
    u), Int
    uInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1))

    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), Infinite SDoc)
    -> (a, (DIdEnv (Id, SDoc), Infinite 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, Infinite SDoc
    nameList) of
      (a
    a, (DIdEnv (Id, SDoc)
    renamings, Infinite 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), Infinite SDoc) Identity SDoc
    getCleanName Id
    x = do
      (renamings, name_supply) <- RWST
      Nabla
      ()
      (DIdEnv (Id, SDoc), Infinite SDoc)
      Identity
      (DIdEnv (Id, SDoc), Infinite SDoc)
    forall (m :: * -> *) r w s. Monad m => RWST r w s m s
    get
      let Inf clean_name name_supply' = name_supply
      case lookupDVarEnv renamings x of
        Just (Id
    _, SDoc
    nm) -> SDoc
    -> RWST Nabla () (DIdEnv (Id, SDoc), Infinite SDoc) Identity SDoc
    forall a.
    a -> RWST Nabla () (DIdEnv (Id, SDoc), Infinite SDoc) Identity a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure SDoc
    nm
        Maybe (Id, SDoc)
    Nothing -> do
          (DIdEnv (Id, SDoc), Infinite SDoc)
    -> RWST Nabla () (DIdEnv (Id, SDoc), Infinite 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), Infinite SDoc
    name_supply')
          SDoc
    -> RWST Nabla () (DIdEnv (Id, SDoc), Infinite SDoc) Identity SDoc
    forall a.
    a -> RWST Nabla () (DIdEnv (Id, SDoc), Infinite SDoc) Identity a
    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 <- RWST Nabla () (DIdEnv (Id, SDoc), Infinite SDoc) Identity Nabla
    forall (m :: * -> *) r w s. Monad m => RWST r w s m r
    ask
      case lookupRefuts nabla x of
        [] -> Maybe SDoc -> PmPprM (Maybe SDoc)
    forall a.
    a -> RWST Nabla () (DIdEnv (Id, SDoc), Infinite SDoc) Identity a
    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), Infinite SDoc) Identity SDoc
    -> PmPprM (Maybe SDoc)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Id
    -> RWST Nabla () (DIdEnv (Id, SDoc), Infinite 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), Infinite SDoc) Identity SDoc
    pprPmVar PprPrec
    prec Id
    x = do
      nabla <- RWST Nabla () (DIdEnv (Id, SDoc), Infinite SDoc) Identity Nabla
    forall (m :: * -> *) r w s. Monad m => RWST r w s m r
    ask
      case lookupSolution nabla x of
        Just (PACA PmAltCon
    alt [Id]
    _tvs [Id]
    args) -> PprPrec
    -> PmAltCon
    -> [Id]
    -> RWST Nabla () (DIdEnv (Id, SDoc), Infinite 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
    forall doc. IsLine doc => doc
    underscore (Maybe SDoc -> SDoc)
    -> PmPprM (Maybe SDoc)
    -> RWST Nabla () (DIdEnv (Id, SDoc), Infinite 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), Infinite SDoc) Identity SDoc
    pprPmAltCon PprPrec
    _prec (PmAltLit PmLit
    l)      [Id]
    _    = SDoc
    -> RWST Nabla () (DIdEnv (Id, SDoc), Infinite SDoc) Identity SDoc
    forall a.
    a -> RWST Nabla () (DIdEnv (Id, SDoc), Infinite SDoc) Identity a
    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 <- RWST Nabla () (DIdEnv (Id, SDoc), Infinite SDoc) Identity Nabla
    forall (m :: * -> *) r w s. Monad m => RWST r w s m r
    ask
      pprConLike nabla prec cl args

    pprConLike :: Nabla -> PprPrec -> ConLike -> [Id] -> PmPprM SDoc
    pprConLike :: Nabla
    -> PprPrec
    -> ConLike
    -> [Id]
    -> RWST Nabla () (DIdEnv (Id, SDoc), Infinite 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
    forall doc. IsLine doc => doc -> doc
    brackets (SDoc -> SDoc) -> ([SDoc] -> SDoc) -> [SDoc] -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [SDoc] -> SDoc
    forall doc. IsLine doc => [doc] -> doc
    fsep ([SDoc] -> SDoc) -> ([SDoc] -> [SDoc]) -> [SDoc] -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SDoc -> [SDoc] -> [SDoc]
    forall doc. IsLine doc => doc -> [doc] -> [doc]
    punctuate SDoc
    forall doc. IsLine doc => doc
    comma ([SDoc] -> SDoc)
    -> RWST Nabla () (DIdEnv (Id, SDoc), Infinite SDoc) Identity [SDoc]
    -> RWST Nabla () (DIdEnv (Id, SDoc), Infinite SDoc) Identity SDoc
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Id
     -> RWST Nabla () (DIdEnv (Id, SDoc), Infinite SDoc) Identity SDoc)
    -> [Id]
    -> RWST Nabla () (DIdEnv (Id, SDoc), Infinite SDoc) Identity [SDoc]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (PprPrec
    -> Id
    -> RWST Nabla () (DIdEnv (Id, SDoc), Infinite SDoc) Identity SDoc
    pprPmVar PprPrec
    appPrec) [Id]
    list
          WcVarTerminated NonEmpty Id
    pref Id
    x ->
            SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc
    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]
    forall doc. IsLine doc => doc -> [doc] -> [doc]
    punctuate SDoc
    forall doc. IsLine doc => doc
    colon ([SDoc] -> SDoc)
    -> RWST Nabla () (DIdEnv (Id, SDoc), Infinite SDoc) Identity [SDoc]
    -> RWST Nabla () (DIdEnv (Id, SDoc), Infinite SDoc) Identity SDoc
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Id
     -> RWST Nabla () (DIdEnv (Id, SDoc), Infinite SDoc) Identity SDoc)
    -> [Id]
    -> RWST Nabla () (DIdEnv (Id, SDoc), Infinite SDoc) Identity [SDoc]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (PprPrec
    -> Id
    -> RWST Nabla () (DIdEnv (Id, SDoc), Infinite 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 :: doc -> doc
    hash_parens doc
    doc = String -> doc
    forall doc. IsLine doc => String -> doc
    text String
    "(#" doc -> doc -> doc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> doc
    doc doc -> doc -> doc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> String -> doc
    forall doc. IsLine doc => String -> doc
    text String
    "#)"
      = SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc
    hash_parens (SDoc -> SDoc) -> ([SDoc] -> SDoc) -> [SDoc] -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [SDoc] -> SDoc
    forall doc. IsLine doc => [doc] -> doc
    fsep ([SDoc] -> SDoc) -> ([SDoc] -> [SDoc]) -> [SDoc] -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SDoc -> [SDoc] -> [SDoc]
    forall doc. IsLine doc => doc -> [doc] -> [doc]
    punctuate SDoc
    forall doc. IsLine doc => doc
    comma ([SDoc] -> SDoc)
    -> RWST Nabla () (DIdEnv (Id, SDoc), Infinite SDoc) Identity [SDoc]
    -> RWST Nabla () (DIdEnv (Id, SDoc), Infinite SDoc) Identity SDoc
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Id
     -> RWST Nabla () (DIdEnv (Id, SDoc), Infinite SDoc) Identity SDoc)
    -> [Id]
    -> RWST Nabla () (DIdEnv (Id, SDoc), Infinite SDoc) Identity [SDoc]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (PprPrec
    -> Id
    -> RWST Nabla () (DIdEnv (Id, SDoc), Infinite SDoc) Identity SDoc
    pprPmVar PprPrec
    appPrec) [Id]
    args
      | DataCon -> Bool
    isTupleDataCon DataCon
    con
      = SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc
    parens (SDoc -> SDoc) -> ([SDoc] -> SDoc) -> [SDoc] -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [SDoc] -> SDoc
    forall doc. IsLine doc => [doc] -> doc
    fsep ([SDoc] -> SDoc) -> ([SDoc] -> [SDoc]) -> [SDoc] -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SDoc -> [SDoc] -> [SDoc]
    forall doc. IsLine doc => doc -> [doc] -> [doc]
    punctuate SDoc
    forall doc. IsLine doc => doc
    comma ([SDoc] -> SDoc)
    -> RWST Nabla () (DIdEnv (Id, SDoc), Infinite SDoc) Identity [SDoc]
    -> RWST Nabla () (DIdEnv (Id, SDoc), Infinite SDoc) Identity SDoc
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Id
     -> RWST Nabla () (DIdEnv (Id, SDoc), Infinite SDoc) Identity SDoc)
    -> [Id]
    -> RWST Nabla () (DIdEnv (Id, SDoc), Infinite SDoc) Identity [SDoc]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (PprPrec
    -> Id
    -> RWST Nabla () (DIdEnv (Id, SDoc), Infinite 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 x' <- PprPrec
    -> Id
    -> RWST Nabla () (DIdEnv (Id, SDoc), Infinite SDoc) Identity SDoc
    pprPmVar PprPrec
    funPrec Id
    x
                       y' <- pprPmVar funPrec y
                       return (cparen (prec > opPrec) (x' <+> ppr cl <+> y'))
          -- can it be infix but have more than two arguments?
          [Id]
    list   -> String
    -> SDoc
    -> RWST Nabla () (DIdEnv (Id, SDoc), Infinite 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 a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Id]
    args = SDoc
    -> RWST Nabla () (DIdEnv (Id, SDoc), Infinite SDoc) Identity SDoc
    forall a.
    a -> RWST Nabla () (DIdEnv (Id, SDoc), Infinite SDoc) Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ConLike -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ConLike
    cl)
      | Bool
    otherwise = do args' <- (Id
     -> RWST Nabla () (DIdEnv (Id, SDoc), Infinite SDoc) Identity SDoc)
    -> [Id]
    -> RWST Nabla () (DIdEnv (Id, SDoc), Infinite SDoc) Identity [SDoc]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (PprPrec
    -> Id
    -> RWST Nabla () (DIdEnv (Id, SDoc), Infinite SDoc) Identity SDoc
    pprPmVar PprPrec
    appPrec) [Id]
    args
                       return (cparen (prec > funPrec) (fsep (ppr cl : 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
          = Bool -> Maybe PmExprList -> Maybe PmExprList
    forall a. HasCallStack => Bool -> a -> a
    assert ([Id] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Id]
    es) (Maybe PmExprList -> Maybe PmExprList)
    -> Maybe PmExprList -> Maybe PmExprList
    forall a b. (a -> b) -> a -> b
    $ PmExprList -> Maybe PmExprList
    forall a. a -> Maybe a
    Just ([Id] -> PmExprList
    NilTerminated ([Id] -> [Id]
    forall a. [a] -> [a]
    reverse [Id]
    rev_pref))
          | DataCon
    c DataCon -> DataCon -> Bool
    forall a. Eq a => a -> a -> Bool
    == DataCon
    consDataCon
          = Bool -> Maybe PmExprList -> Maybe PmExprList
    forall a. HasCallStack => Bool -> a -> a
    assert ([Id] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Id]
    es Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    2) (Maybe PmExprList -> Maybe PmExprList)
    -> Maybe PmExprList -> Maybe PmExprList
    forall a b. (a -> b) -> a -> b
    $ [Id] -> Id -> Maybe PmExprList
    go_var ([Id]
    es [Id] -> Int -> Id
    forall a. HasCallStack => [a] -> Int -> a
    !! Int
    0 Id -> [Id] -> [Id]
    forall a. a -> [a] -> [a]
    : [Id]
    rev_pref) ([Id]
    es [Id] -> Int -> Id
    forall a. HasCallStack => [a] -> Int -> a
    !! Int
    1)
        go_con [Id]
    _ PmAltCon
    _ [Id]
    _
          = Maybe PmExprList
    forall a. Maybe a
    Nothing