match :: [Id]             -- Variables rep\'ing the exprs we\'re matching with
      -> Type             -- Type of the case expression
      -> [EquationInfo]   -- Info about patterns, etc. (type synonym below)
      -> DsM MatchResult  -- Desugared result!

match [] ty eqns
  = ASSERT2( not (null eqns), ppr ty )
    return (foldr1 combineMatchResults match_results)
  where
    match_results = [ ASSERT( null (eqn_pats eqn) )
                      eqn_rhs eqn
                    | eqn <- eqns ]

match vars@(v:_) ty eqns    -- Eqns *can* be empty
  = do  { dflags <- getDynFlags
        ;       -- Tidy the first pattern, generating
                -- auxiliary bindings if necessary
          (aux_binds, tidy_eqns) <- mapAndUnzipM (tidyEqnInfo v) eqns

                -- Group the equations and match each group in turn
        ; let grouped = groupEquations dflags tidy_eqns

         -- print the view patterns that are commoned up to help debug
        ; whenDOptM Opt_D_dump_view_pattern_commoning (debug grouped)

        ; match_results <- match_groups grouped
        ; return (adjustMatchResult (foldr (.) id aux_binds) $
                  foldr1 combineMatchResults match_results) }
  where
    dropGroup :: [(PatGroup,EquationInfo)] -> [EquationInfo]
    dropGroup = map snd

    match_groups :: [[(PatGroup,EquationInfo)]] -> DsM [MatchResult]
    -- Result list of [MatchResult] is always non-empty
    match_groups [] = matchEmpty v ty
    match_groups gs = mapM match_group gs

    match_group :: [(PatGroup,EquationInfo)] -> DsM MatchResult
    match_group [] = panic "match_group"
    match_group eqns@((group,_) : _)
        = case group of
            PgCon _    -> matchConFamily  vars ty (subGroup [(c,e) | (PgCon c, e) <- eqns])
            PgSyn _    -> matchPatSyn     vars ty (dropGroup eqns)
            PgLit _    -> matchLiterals   vars ty (subGroup [(l,e) | (PgLit l, e) <- eqns])
            PgAny      -> matchVariables  vars ty (dropGroup eqns)
            PgN _      -> matchNPats      vars ty (dropGroup eqns)
            PgNpK _    -> matchNPlusKPats vars ty (dropGroup eqns)
            PgBang     -> matchBangs      vars ty (dropGroup eqns)
            PgCo _     -> matchCoercion   vars ty (dropGroup eqns)
            PgView _ _ -> matchView       vars ty (dropGroup eqns)
            PgOverloadedList -> matchOverloadedList vars ty (dropGroup eqns)

    -- FIXME: we should also warn about view patterns that should be
    -- commoned up but are not

    -- print some stuff to see what's getting grouped
    -- use -dppr-debug to see the resolution of overloaded literals
    debug eqns =
        let gs = map (\group -> foldr (\ (p,_) -> \acc ->
                                           case p of PgView e _ -> e:acc
                                                     _ -> acc) [] group) eqns
            maybeWarn [] = return ()
            maybeWarn l = warnDs (vcat l)
        in
          maybeWarn $ (map (\g -> text "Putting these view expressions into the same case:" <+> (ppr g))
                       (filter (not . null) gs))

matchEmpty :: Id -> Type -> DsM [MatchResult]
-- See Note [Empty case expressions]
matchEmpty var res_ty
  = return [MatchResult CanFail mk_seq]
  where
    mk_seq fail = return $ mkWildCase (Var var) (idType var) res_ty
                                      [(DEFAULT, [], fail)]

matchVariables :: [Id] -> Type -> [EquationInfo] -> DsM MatchResult
-- Real true variables, just like in matchVar, SLPJ p 94
-- No binding to do: they'll all be wildcards by now (done in tidy)
matchVariables (_:vars) ty eqns = match vars ty (shiftEqns eqns)
matchVariables [] _ _ = panic "matchVariables"

matchBangs :: [Id] -> Type -> [EquationInfo] -> DsM MatchResult
matchBangs (var:vars) ty eqns
  = do  { match_result <- match (var:vars) ty $
                          map (decomposeFirstPat getBangPat) eqns
        ; return (mkEvalMatchResult var ty match_result) }
matchBangs [] _ _ = panic "matchBangs"

matchCoercion :: [Id] -> Type -> [EquationInfo] -> DsM MatchResult
-- Apply the coercion to the match variable and then match that
matchCoercion (var:vars) ty (eqns@(eqn1:_))
  = do  { let CoPat co pat _ = firstPat eqn1
        ; var' <- newUniqueId var (hsPatType pat)
        ; match_result <- match (var':vars) ty $
                          map (decomposeFirstPat getCoPat) eqns
        ; rhs' <- dsHsWrapper co (Var var)
        ; return (mkCoLetMatchResult (NonRec var' rhs') match_result) }
matchCoercion _ _ _ = panic "matchCoercion"

matchView :: [Id] -> Type -> [EquationInfo] -> DsM MatchResult
-- Apply the view function to the match variable and then match that
matchView (var:vars) ty (eqns@(eqn1:_))
  = do  { -- we could pass in the expr from the PgView,
         -- but this needs to extract the pat anyway
         -- to figure out the type of the fresh variable
         let ViewPat viewExpr (L _ pat) _ = firstPat eqn1
         -- do the rest of the compilation
        ; var' <- newUniqueId var (hsPatType pat)
        ; match_result <- match (var':vars) ty $
                          map (decomposeFirstPat getViewPat) eqns
         -- compile the view expressions
        ; viewExpr' <- dsLExpr viewExpr
        ; return (mkViewMatchResult var' viewExpr' var match_result) }
matchView _ _ _ = panic "matchView"

matchOverloadedList :: [Id] -> Type -> [EquationInfo] -> DsM MatchResult
matchOverloadedList (var:vars) ty (eqns@(eqn1:_))
-- Since overloaded list patterns are treated as view patterns,
-- the code is roughly the same as for matchView
  = do { let ListPat _ elt_ty (Just (_,e)) = firstPat eqn1
       ; var' <- newUniqueId var (mkListTy elt_ty)  -- we construct the overall type by hand
       ; match_result <- match (var':vars) ty $
                            map (decomposeFirstPat getOLPat) eqns -- getOLPat builds the pattern inside as a non-overloaded version of the overloaded list pattern
       ; e' <- dsExpr e
       ; return (mkViewMatchResult var' e' var match_result) }
matchOverloadedList _ _ _ = panic "matchOverloadedList"

-- decompose the first pattern and leave the rest alone
decomposeFirstPat :: (Pat Id -> Pat Id) -> EquationInfo -> EquationInfo
decomposeFirstPat extractpat (eqn@(EqnInfo { eqn_pats = pat : pats }))
        = eqn { eqn_pats = extractpat pat : pats}
decomposeFirstPat _ _ = panic "decomposeFirstPat"

getCoPat, getBangPat, getViewPat, getOLPat :: Pat Id -> Pat Id
getCoPat (CoPat _ pat _)     = pat
getCoPat _                   = panic "getCoPat"
getBangPat (BangPat pat  )   = unLoc pat
getBangPat _                 = panic "getBangPat"
getViewPat (ViewPat _ pat _) = unLoc pat
getViewPat _                 = panic "getViewPat"
getOLPat (ListPat pats ty (Just _)) = ListPat pats ty Nothing
getOLPat _                   = panic "getOLPat"

tidyEqnInfo :: Id -> EquationInfo
            -> DsM (DsWrapper, EquationInfo)
        -- DsM'd because of internal call to dsLHsBinds
        --      and mkSelectorBinds.
        -- "tidy1" does the interesting stuff, looking at
        -- one pattern and fiddling the list of bindings.
        --
        -- POST CONDITION: head pattern in the EqnInfo is
        --      WildPat
        --      ConPat
        --      NPat
        --      LitPat
        --      NPlusKPat
        -- but no other

tidyEqnInfo _ (EqnInfo { eqn_pats = [] })
  = panic "tidyEqnInfo"

tidyEqnInfo v eqn@(EqnInfo { eqn_pats = pat : pats })
  = do { (wrap, pat') <- tidy1 v pat
       ; return (wrap, eqn { eqn_pats = do pat' : pats }) }

tidy1 :: Id               -- The Id being scrutinised
      -> Pat Id           -- The pattern against which it is to be matched
      -> DsM (DsWrapper,  -- Extra bindings to do before the match
              Pat Id)     -- Equivalent pattern

-------------------------------------------------------
--      (pat', mr') = tidy1 v pat mr
-- tidies the *outer level only* of pat, giving pat'
-- It eliminates many pattern forms (as-patterns, variable patterns,
-- list patterns, etc) yielding one of:
--      WildPat
--      ConPatOut
--      LitPat
--      NPat
--      NPlusKPat

tidy1 v (ParPat pat)      = tidy1 v (unLoc pat)
tidy1 v (SigPatOut pat _) = tidy1 v (unLoc pat)
tidy1 _ (WildPat ty)      = return (idDsWrapper, WildPat ty)
tidy1 v (BangPat (L l p)) = tidy_bang_pat v l p

        -- case v of { x -> mr[] }
        -- = case v of { _ -> let x=v in mr[] }
tidy1 v (VarPat var)
  = return (wrapBind var v, WildPat (idType var))

        -- case v of { x@p -> mr[] }
        -- = case v of { p -> let x=v in mr[] }
tidy1 v (AsPat (L _ var) pat)
  = do  { (wrap, pat') <- tidy1 v (unLoc pat)
        ; return (wrapBind var v . wrap, pat') }

{- now, here we handle lazy patterns:
    tidy1 v ~p bs = (v, v1 = case v of p -> v1 :
                        v2 = case v of p -> v2 : ... : bs )

    where the v_i's are the binders in the pattern.

    ToDo: in "v_i = ... -> v_i", are the v_i's really the same thing?

    The case expr for v_i is just: match [v] [(p, [], \ x -> Var v_i)] any_expr
-}

tidy1 v (LazyPat pat)
  = do  { sel_prs <- mkSelectorBinds [] pat (Var v)
        ; let sel_binds =  [NonRec b rhs | (b,rhs) <- sel_prs]
        ; return (mkCoreLets sel_binds, WildPat (idType v)) }

tidy1 _ (ListPat pats ty Nothing)
  = return (idDsWrapper, unLoc list_ConPat)
  where
    list_ConPat = foldr (\ x y -> mkPrefixConPat consDataCon [x, y] [ty])
                        (mkNilPat ty)
                        pats

-- Introduce fake parallel array constructors to be able to handle parallel
-- arrays with the existing machinery for constructor pattern
tidy1 _ (PArrPat pats ty)
  = return (idDsWrapper, unLoc parrConPat)
  where
    arity      = length pats
    parrConPat = mkPrefixConPat (parrFakeCon arity) pats [ty]

tidy1 _ (TuplePat pats boxity tys)
  = return (idDsWrapper, unLoc tuple_ConPat)
  where
    arity = length pats
    tuple_ConPat = mkPrefixConPat (tupleCon (boxityNormalTupleSort boxity) arity) pats tys

-- LitPats: we *might* be able to replace these w/ a simpler form
tidy1 _ (LitPat lit)
  = return (idDsWrapper, tidyLitPat lit)

-- NPats: we *might* be able to replace these w/ a simpler form
tidy1 _ (NPat lit mb_neg eq)
  = return (idDsWrapper, tidyNPat tidyLitPat lit mb_neg eq)

-- Everything else goes through unchanged...

tidy1 _ non_interesting_pat
  = return (idDsWrapper, non_interesting_pat)

--------------------
tidy_bang_pat :: Id -> SrcSpan -> Pat Id -> DsM (DsWrapper, Pat Id)

-- Discard bang around strict pattern
tidy_bang_pat v _ p@(ListPat {})   = tidy1 v p
tidy_bang_pat v _ p@(TuplePat {})  = tidy1 v p
tidy_bang_pat v _ p@(PArrPat {})   = tidy1 v p
tidy_bang_pat v _ p@(ConPatOut {}) = tidy1 v p
tidy_bang_pat v _ p@(LitPat {})    = tidy1 v p

-- Discard par/sig under a bang
tidy_bang_pat v _ (ParPat (L l p))      = tidy_bang_pat v l p
tidy_bang_pat v _ (SigPatOut (L l p) _) = tidy_bang_pat v l p

-- Push the bang-pattern inwards, in the hope that
-- it may disappear next time
tidy_bang_pat v l (AsPat v' p)  = tidy1 v (AsPat v' (L l (BangPat p)))
tidy_bang_pat v l (CoPat w p t) = tidy1 v (CoPat w (BangPat (L l p)) t)

-- Default case, leave the bang there:
-- VarPat, LazyPat, WildPat, ViewPat, NPat, NPlusKPat
-- For LazyPat, remember that it's semantically like a VarPat
--  i.e.  !(~p) is not like ~p, or p!  (Trac #8952)

tidy_bang_pat _ l p = return (idDsWrapper, BangPat (L l p))
  -- NB: SigPatIn, ConPatIn should not happen

matchWrapper :: HsMatchContext Name         -- For shadowing warning messages
             -> MatchGroup Id (LHsExpr Id)  -- Matches being desugared
             -> DsM ([Id], CoreExpr)        -- Results

matchWrapper ctxt (MG { mg_alts = matches
                      , mg_arg_tys = arg_tys
                      , mg_res_ty = rhs_ty
                      , mg_origin = origin })
  = do  { eqns_info   <- mapM mk_eqn_info matches
        ; new_vars    <- case matches of
                           []    -> mapM newSysLocalDs arg_tys
                           (m:_) -> selectMatchVars (map unLoc (hsLMatchPats m))
        ; result_expr <- handleWarnings $
                         matchEquations ctxt new_vars eqns_info rhs_ty
        ; return (new_vars, result_expr) }
  where
    mk_eqn_info (L _ (Match pats _ grhss))
      = do { let upats = map unLoc pats
           ; match_result <- dsGRHSs ctxt upats grhss rhs_ty
           ; return (EqnInfo { eqn_pats = upats, eqn_rhs  = match_result}) }

    handleWarnings = if isGenerated origin
                     then discardWarningsDs
                     else id


matchEquations  :: HsMatchContext Name
                -> [Id] -> [EquationInfo] -> Type
                -> DsM CoreExpr
matchEquations ctxt vars eqns_info rhs_ty
  = do  { locn <- getSrcSpanDs
        ; let   ds_ctxt   = DsMatchContext ctxt locn
                error_doc = matchContextErrString ctxt

        ; match_result <- matchCheck ds_ctxt vars rhs_ty eqns_info

        ; fail_expr <- mkErrorAppDs pAT_ERROR_ID rhs_ty error_doc
        ; extractMatchResult match_result fail_expr }

matchSimply :: CoreExpr                 -- Scrutinee
            -> HsMatchContext Name      -- Match kind
            -> LPat Id                  -- Pattern it should match
            -> CoreExpr                 -- Return this if it matches
            -> CoreExpr                 -- Return this if it doesn't
            -> DsM CoreExpr
-- Do not warn about incomplete patterns; see matchSinglePat comments
matchSimply scrut hs_ctx pat result_expr fail_expr = do
    let
      match_result = cantFailMatchResult result_expr
      rhs_ty       = exprType fail_expr
        -- Use exprType of fail_expr, because won't refine in the case of failure!
    match_result' <- matchSinglePat scrut hs_ctx pat rhs_ty match_result
    extractMatchResult match_result' fail_expr

matchSinglePat :: CoreExpr -> HsMatchContext Name -> LPat Id
               -> Type -> MatchResult -> DsM MatchResult
-- Do not warn about incomplete patterns
-- Used for things like [ e | pat <- stuff ], where
-- incomplete patterns are just fine
matchSinglePat (Var var) ctx (L _ pat) ty match_result
  = do { locn <- getSrcSpanDs
       ; matchCheck (DsMatchContext ctx locn)
                    [var] ty
                    [EqnInfo { eqn_pats = [pat], eqn_rhs  = match_result }] }

matchSinglePat scrut hs_ctx pat ty match_result
  = do { var <- selectSimpleMatchVarL pat
       ; match_result' <- matchSinglePat (Var var) hs_ctx pat ty match_result
       ; return (adjustMatchResult (bindNonRec var scrut) match_result') }

data PatGroup
  = PgAny               -- Immediate match: variables, wildcards,
                        --                  lazy patterns
  | PgCon DataCon       -- Constructor patterns (incl list, tuple)
  | PgSyn PatSyn
  | PgLit Literal       -- Literal patterns
  | PgN   Literal       -- Overloaded literals
  | PgNpK Literal       -- n+k patterns
  | PgBang              -- Bang patterns
  | PgCo Type           -- Coercion patterns; the type is the type
                        --      of the pattern *inside*
  | PgView (LHsExpr Id) -- view pattern (e -> p):
                        -- the LHsExpr is the expression e
           Type         -- the Type is the type of p (equivalently, the result type of e)
  | PgOverloadedList

groupEquations :: DynFlags -> [EquationInfo] -> [[(PatGroup, EquationInfo)]]
-- If the result is of form [g1, g2, g3],
-- (a) all the (pg,eq) pairs in g1 have the same pg
-- (b) none of the gi are empty
-- The ordering of equations is unchanged
groupEquations dflags eqns
  = runs same_gp [(patGroup dflags (firstPat eqn), eqn) | eqn <- eqns]
  where
    same_gp :: (PatGroup,EquationInfo) -> (PatGroup,EquationInfo) -> Bool
    (pg1,_) `same_gp` (pg2,_) = pg1 `sameGroup` pg2

subGroup :: Ord a => [(a, EquationInfo)] -> [[EquationInfo]]
-- Input is a particular group.  The result sub-groups the
-- equations by with particular constructor, literal etc they match.
-- Each sub-list in the result has the same PatGroup
-- See Note [Take care with pattern order]
subGroup group
    = map reverse $ Map.elems $ foldl accumulate Map.empty group
  where
    accumulate pg_map (pg, eqn)
      = case Map.lookup pg pg_map of
          Just eqns -> Map.insert pg (eqn:eqns) pg_map
          Nothing   -> Map.insert pg [eqn]      pg_map

    -- pg_map :: Map a [EquationInfo]
    -- Equations seen so far in reverse order of appearance

sameGroup :: PatGroup -> PatGroup -> Bool
-- Same group means that a single case expression
-- or test will suffice to match both, *and* the order
-- of testing within the group is insignificant.
sameGroup PgAny      PgAny      = True
sameGroup PgBang     PgBang     = True
sameGroup (PgCon _)  (PgCon _)  = True          -- One case expression
sameGroup (PgSyn p1) (PgSyn p2) = p1==p2
sameGroup (PgLit _)  (PgLit _)  = True          -- One case expression
sameGroup (PgN l1)   (PgN l2)   = l1==l2        -- Order is significant
sameGroup (PgNpK l1) (PgNpK l2) = l1==l2        -- See Note [Grouping overloaded literal patterns]
sameGroup (PgCo t1)  (PgCo t2)  = t1 `eqType` t2
        -- CoPats are in the same goup only if the type of the
        -- enclosed pattern is the same. The patterns outside the CoPat
        -- always have the same type, so this boils down to saying that
        -- the two coercions are identical.
sameGroup (PgView e1 t1) (PgView e2 t2) = viewLExprEq (e1,t1) (e2,t2)
       -- ViewPats are in the same group iff the expressions
       -- are "equal"---conservatively, we use syntactic equality
sameGroup _          _          = False

-- An approximation of syntactic equality used for determining when view
-- exprs are in the same group.
-- This function can always safely return false;
-- but doing so will result in the application of the view function being repeated.
--
-- Currently: compare applications of literals and variables
--            and anything else that we can do without involving other
--            HsSyn types in the recursion
--
-- NB we can't assume that the two view expressions have the same type.  Consider
--   f (e1 -> True) = ...
--   f (e2 -> "hi") = ...
viewLExprEq :: (LHsExpr Id,Type) -> (LHsExpr Id,Type) -> Bool
viewLExprEq (e1,_) (e2,_) = lexp e1 e2
  where
    lexp :: LHsExpr Id -> LHsExpr Id -> Bool
    lexp e e' = exp (unLoc e) (unLoc e')

    ---------
    exp :: HsExpr Id -> HsExpr Id -> Bool
    -- real comparison is on HsExpr's
    -- strip parens
    exp (HsPar (L _ e)) e'   = exp e e'
    exp e (HsPar (L _ e'))   = exp e e'
    -- because the expressions do not necessarily have the same type,
    -- we have to compare the wrappers
    exp (HsWrap h e) (HsWrap h' e') = wrap h h' && exp e e'
    exp (HsVar i) (HsVar i') =  i == i'
    -- the instance for IPName derives using the id, so this works if the
    -- above does
    exp (HsIPVar i) (HsIPVar i') = i == i'
    exp (HsOverLit l) (HsOverLit l') =
        -- Overloaded lits are equal if they have the same type
        -- and the data is the same.
        -- this is coarser than comparing the SyntaxExpr's in l and l',
        -- which resolve the overloading (e.g., fromInteger 1),
        -- because these expressions get written as a bunch of different variables
        -- (presumably to improve sharing)
        eqType (overLitType l) (overLitType l') && l == l'
    exp (HsApp e1 e2) (HsApp e1' e2') = lexp e1 e1' && lexp e2 e2'
    -- the fixities have been straightened out by now, so it's safe
    -- to ignore them?
    exp (OpApp l o _ ri) (OpApp l' o' _ ri') =
        lexp l l' && lexp o o' && lexp ri ri'
    exp (NegApp e n) (NegApp e' n') = lexp e e' && exp n n'
    exp (SectionL e1 e2) (SectionL e1' e2') =
        lexp e1 e1' && lexp e2 e2'
    exp (SectionR e1 e2) (SectionR e1' e2') =
        lexp e1 e1' && lexp e2 e2'
    exp (ExplicitTuple es1 _) (ExplicitTuple es2 _) =
        eq_list tup_arg es1 es2
    exp (HsIf _ e e1 e2) (HsIf _ e' e1' e2') =
        lexp e e' && lexp e1 e1' && lexp e2 e2'

    -- Enhancement: could implement equality for more expressions
    --   if it seems useful
    -- But no need for HsLit, ExplicitList, ExplicitTuple,
    -- because they cannot be functions
    exp _ _  = False

    ---------
    tup_arg (Present e1) (Present e2) = lexp e1 e2
    tup_arg (Missing t1) (Missing t2) = eqType t1 t2
    tup_arg _ _ = False

    ---------
    wrap :: HsWrapper -> HsWrapper -> Bool
    -- Conservative, in that it demands that wrappers be
    -- syntactically identical and doesn't look under binders
    --
    -- Coarser notions of equality are possible
    -- (e.g., reassociating compositions,
    --        equating different ways of writing a coercion)
    wrap WpHole WpHole = True
    wrap (WpCompose w1 w2) (WpCompose w1' w2') = wrap w1 w1' && wrap w2 w2'
    wrap (WpCast co)       (WpCast co')        = co `eq_co` co'
    wrap (WpEvApp et1)     (WpEvApp et2)       = et1 `ev_term` et2
    wrap (WpTyApp t)       (WpTyApp t')        = eqType t t'
    -- Enhancement: could implement equality for more wrappers
    --   if it seems useful (lams and lets)
    wrap _ _ = False

    ---------
    ev_term :: EvTerm -> EvTerm -> Bool
    ev_term (EvId a)       (EvId b)       = a==b
    ev_term (EvCoercion a) (EvCoercion b) = a `eq_co` b
    ev_term _ _ = False

    ---------
    eq_list :: (a->a->Bool) -> [a] -> [a] -> Bool
    eq_list _  []     []     = True
    eq_list _  []     (_:_)  = False
    eq_list _  (_:_)  []     = False
    eq_list eq (x:xs) (y:ys) = eq x y && eq_list eq xs ys

    ---------
    eq_co :: TcCoercion -> TcCoercion -> Bool
    -- Just some simple cases (should the r1 == r2 rather be an ASSERT?)
    eq_co (TcRefl r1 t1)             (TcRefl r2 t2)             = r1 == r2 && eqType t1 t2
    eq_co (TcCoVarCo v1)             (TcCoVarCo v2)             = v1==v2
    eq_co (TcSymCo co1)              (TcSymCo co2)              = co1 `eq_co` co2
    eq_co (TcTyConAppCo r1 tc1 cos1) (TcTyConAppCo r2 tc2 cos2) = r1 == r2 && tc1==tc2 && eq_list eq_co cos1 cos2
    eq_co _ _ = False

patGroup :: DynFlags -> Pat Id -> PatGroup
patGroup _      (WildPat {})                  = PgAny
patGroup _      (BangPat {})                  = PgBang
patGroup _      (ConPatOut { pat_con = con }) = case unLoc con of
    RealDataCon dcon -> PgCon dcon
    PatSynCon psyn -> PgSyn psyn
patGroup dflags (LitPat lit)                  = PgLit (hsLitKey dflags lit)
patGroup _      (NPat olit mb_neg _)          = PgN   (hsOverLitKey olit (isJust mb_neg))
patGroup _      (NPlusKPat _ olit _ _)        = PgNpK (hsOverLitKey olit False)
patGroup _      (CoPat _ p _)                 = PgCo  (hsPatType p) -- Type of innelexp pattern
patGroup _      (ViewPat expr p _)            = PgView expr (hsPatType (unLoc p))
patGroup _      (ListPat _ _ (Just _))        = PgOverloadedList
patGroup _      pat                           = pprPanic "patGroup" (ppr pat)