Use non-empty lists to remove partiality in matching code

5 files changed, 105 insertions, 103 deletions

diff --git a/compiler/deSugar/DsUtils.hs b/compiler/deSugar/DsUtils.hs
index c358c175c6..9d6b709dc9 100644
--- a/compiler/deSugar/DsUtils.hs
+++ b/compiler/deSugar/DsUtils.hs
@@ -84,6 +84,8 @@ import qualified GHC.LanguageExtensions as LangExt
 import TcEvidence
 
 import Control.Monad    ( zipWithM )
+import Data.List.NonEmpty (NonEmpty(..))
+import qualified Data.List.NonEmpty as NEL
 
 {-
 ************************************************************************
@@ -186,9 +188,9 @@ worthy of a type synonym and a few handy functions.
 firstPat :: EquationInfo -> Pat GhcTc
 firstPat eqn = ASSERT( notNull (eqn_pats eqn) ) head (eqn_pats eqn)
 
-shiftEqns :: [EquationInfo] -> [EquationInfo]
+shiftEqns :: Functor f => f EquationInfo -> f EquationInfo
 -- Drop the first pattern in each equation
-shiftEqns eqns = [ eqn { eqn_pats = tail (eqn_pats eqn) } | eqn <- eqns ]
+shiftEqns = fmap $ \eqn -> eqn { eqn_pats = tail (eqn_pats eqn) }
 
 -- Functions on MatchResults
 
@@ -286,13 +288,13 @@ data CaseAlt a = MkCaseAlt{ alt_pat :: a,
                             alt_result :: MatchResult }
 
 mkCoAlgCaseMatchResult
-  :: Id                 -- Scrutinee
-  -> Type               -- Type of exp
-  -> [CaseAlt DataCon]  -- Alternatives (bndrs *include* tyvars, dicts)
+  :: Id -- ^ Scrutinee
+  -> Type -- ^ Type of exp
+  -> NonEmpty (CaseAlt DataCon) -- ^ Alternatives (bndrs *include* tyvars, dicts)
   -> MatchResult
 mkCoAlgCaseMatchResult var ty match_alts
   | isNewtype  -- Newtype case; use a let
-  = ASSERT( null (tail match_alts) && null (tail arg_ids1) )
+  = ASSERT( null match_alts_tail && null (tail arg_ids1) )
     mkCoLetMatchResult (NonRec arg_id1 newtype_rhs) match_result1
 
   | otherwise
@@ -303,8 +305,8 @@ mkCoAlgCaseMatchResult var ty match_alts
         -- [Interesting: because of GADTs, we can't rely on the type of
         --  the scrutinised Id to be sufficiently refined to have a TyCon in it]
 
-    alt1@MkCaseAlt{ alt_bndrs = arg_ids1, alt_result = match_result1 }
-      = ASSERT( notNull match_alts ) head match_alts
+    alt1@MkCaseAlt{ alt_bndrs = arg_ids1, alt_result = match_result1 } :| match_alts_tail
+      = match_alts
     -- Stuff for newtype
     arg_id1       = ASSERT( notNull arg_ids1 ) head arg_ids1
     var_ty        = idType var
@@ -315,9 +317,6 @@ mkCoAlgCaseMatchResult var ty match_alts
 mkCoSynCaseMatchResult :: Id -> Type -> CaseAlt PatSyn -> MatchResult
 mkCoSynCaseMatchResult var ty alt = MatchResult CanFail $ mkPatSynCase var ty alt
 
-sort_alts :: [CaseAlt DataCon] -> [CaseAlt DataCon]
-sort_alts = sortWith (dataConTag . alt_pat)
-
 mkPatSynCase :: Id -> Type -> CaseAlt PatSyn -> CoreExpr -> DsM CoreExpr
 mkPatSynCase var ty alt fail = do
     matcher <- dsLExpr $ mkLHsWrap wrapper $
@@ -337,17 +336,16 @@ mkPatSynCase var ty alt fail = do
     ensure_unstrict cont | needs_void_lam = Lam voidArgId cont
                          | otherwise      = cont
 
-mkDataConCase :: Id -> Type -> [CaseAlt DataCon] -> MatchResult
-mkDataConCase _   _  []            = panic "mkDataConCase: no alternatives"
-mkDataConCase var ty alts@(alt1:_) = MatchResult fail_flag mk_case
+mkDataConCase :: Id -> Type -> NonEmpty (CaseAlt DataCon) -> MatchResult
+mkDataConCase var ty alts@(alt1 :| _) = MatchResult fail_flag mk_case
   where
     con1          = alt_pat alt1
     tycon         = dataConTyCon con1
     data_cons     = tyConDataCons tycon
-    match_results = map alt_result alts
+    match_results = fmap alt_result alts
 
-    sorted_alts :: [CaseAlt DataCon]
-    sorted_alts  = sort_alts alts
+    sorted_alts :: NonEmpty (CaseAlt DataCon)
+    sorted_alts  = NEL.sortWith (dataConTag . alt_pat) alts
 
     var_ty       = idType var
     (_, ty_args) = tcSplitTyConApp var_ty -- Don't look through newtypes
@@ -356,7 +354,7 @@ mkDataConCase var ty alts@(alt1:_) = MatchResult fail_flag mk_case
     mk_case :: CoreExpr -> DsM CoreExpr
     mk_case fail = do
         alts <- mapM (mk_alt fail) sorted_alts
-        return $ mkWildCase (Var var) (idType var) ty (mk_default fail ++ alts)
+        return $ mkWildCase (Var var) (idType var) ty (mk_default fail ++ NEL.toList alts)
 
     mk_alt :: CoreExpr -> CaseAlt DataCon -> DsM CoreAlt
     mk_alt fail MkCaseAlt{ alt_pat = con,
@@ -376,11 +374,11 @@ mkDataConCase var ty alts@(alt1:_) = MatchResult fail_flag mk_case
 
     fail_flag :: CanItFail
     fail_flag | exhaustive_case
-              = foldr orFail CantFail [can_it_fail | MatchResult can_it_fail _ <- match_results]
+              = foldr orFail CantFail [can_it_fail | MatchResult can_it_fail _ <- NEL.toList match_results]
               | otherwise
               = CanFail
 
-    mentioned_constructors = mkUniqSet $ map alt_pat alts
+    mentioned_constructors = mkUniqSet $ map alt_pat $ NEL.toList alts
     un_mentioned_constructors
         = mkUniqSet data_cons `minusUniqSet` mentioned_constructors
     exhaustive_case = isEmptyUniqSet un_mentioned_constructors
diff --git a/compiler/deSugar/Match.hs b/compiler/deSugar/Match.hs
index b11a2e2f06..3cc88e31db 100644
--- a/compiler/deSugar/Match.hs
+++ b/compiler/deSugar/Match.hs
@@ -7,6 +7,8 @@ The @match@ function
 -}
 
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE MonadComprehensions #-}
+{-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE ViewPatterns #-}
 
@@ -55,7 +57,8 @@ import Unique
 import UniqDFM
 
 import Control.Monad( when, unless )
-import Data.List ( groupBy )
+import Data.List.NonEmpty (NonEmpty(..))
+import qualified Data.List.NonEmpty as NEL
 import qualified Data.Map as Map
 
 {-
@@ -161,11 +164,10 @@ See also Note [Localise pattern binders] in DsUtils
 
 type MatchId = Id   -- See Note [Match Ids]
 
-match :: [MatchId]        -- ^ Variables rep\'ing the exprs we\'re matching with
-                          -- ^ See Note [Match Ids]
-      -> Type             -- ^ Type of the case expression
-      -> [EquationInfo]   -- ^ Info about patterns, etc. (type synonym below)
-      -> DsM MatchResult  -- ^ Desugared result!
+match :: [MatchId] -- ^ Variables rep\'ing the exprs we\'re matching with. See Note [Match Ids]
+      -> 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 )
@@ -175,13 +177,12 @@ match [] ty eqns
                       eqn_rhs eqn
                     | eqn <- eqns ]
 
-match vars@(v:_) ty eqns    -- Eqns *can* be empty
+match (v:vs) ty eqns    -- Eqns *can* be empty
   = ASSERT2( all (isInternalName . idName) vars, ppr vars )
     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
 
@@ -192,21 +193,22 @@ match vars@(v:_) ty eqns    -- Eqns *can* be empty
         ; return (adjustMatchResult (foldr (.) id aux_binds) $
                   foldr1 combineMatchResults match_results) }
   where
-    dropGroup :: [(PatGroup,EquationInfo)] -> [EquationInfo]
-    dropGroup = map snd
+    vars = v :| vs
+
+    dropGroup :: Functor f => f (PatGroup,EquationInfo) -> f EquationInfo
+    dropGroup = fmap snd
 
-    match_groups :: [[(PatGroup,EquationInfo)]] -> DsM [MatchResult]
+    match_groups :: [NonEmpty (PatGroup,EquationInfo)] -> DsM (NonEmpty MatchResult)
     -- Result list of [MatchResult] is always non-empty
     match_groups [] = matchEmpty v ty
-    match_groups gs = mapM match_group gs
+    match_groups (g:gs) = mapM match_group $ g :| gs
 
-    match_group :: [(PatGroup,EquationInfo)] -> DsM MatchResult
-    match_group [] = panic "match_group"
-    match_group eqns@((group,_) : _)
+    match_group :: NonEmpty (PatGroup,EquationInfo) -> DsM MatchResult
+    match_group eqns@((group,_) :| _)
         = case group of
-            PgCon {}  -> matchConFamily  vars ty (subGroupUniq [(c,e) | (PgCon c, e) <- eqns])
+            PgCon {}  -> matchConFamily  vars ty (ne $ subGroupUniq [(c,e) | (PgCon c, e) <- eqns'])
             PgSyn {}  -> matchPatSyn     vars ty (dropGroup eqns)
-            PgLit {}  -> matchLiterals   vars ty (subGroupOrd [(l,e) | (PgLit l, e) <- eqns])
+            PgLit {}  -> matchLiterals   vars ty (ne $ subGroupOrd [(l,e) | (PgLit l, e) <- eqns'])
             PgAny     -> matchVariables  vars ty (dropGroup eqns)
             PgN {}    -> matchNPats      vars ty (dropGroup eqns)
             PgOverS {}-> matchNPats      vars ty (dropGroup eqns)
@@ -215,6 +217,10 @@ match vars@(v:_) ty eqns    -- Eqns *can* be empty
             PgCo {}   -> matchCoercion   vars ty (dropGroup eqns)
             PgView {} -> matchView       vars ty (dropGroup eqns)
             PgOverloadedList -> matchOverloadedList vars ty (dropGroup eqns)
+      where eqns' = NEL.toList eqns
+            ne l = case NEL.nonEmpty l of
+              Just nel -> nel
+              Nothing -> pprPanic "match match_group" $ text "Empty result should be impossible since input was non-empty"
 
     -- FIXME: we should also warn about view patterns that should be
     -- commoned up but are not
@@ -231,7 +237,7 @@ match vars@(v:_) ty eqns    -- Eqns *can* be empty
           maybeWarn $ (map (\g -> text "Putting these view expressions into the same case:" <+> (ppr g))
                        (filter (not . null) gs))
 
-matchEmpty :: MatchId -> Type -> DsM [MatchResult]
+matchEmpty :: MatchId -> Type -> DsM (NonEmpty MatchResult)
 -- See Note [Empty case expressions]
 matchEmpty var res_ty
   = return [MatchResult CanFail mk_seq]
@@ -239,35 +245,32 @@ matchEmpty var res_ty
     mk_seq fail = return $ mkWildCase (Var var) (idType var) res_ty
                                       [(DEFAULT, [], fail)]
 
-matchVariables :: [MatchId] -> Type -> [EquationInfo] -> DsM MatchResult
+matchVariables :: NonEmpty MatchId -> Type -> NonEmpty 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"
+matchVariables (_ :| vars) ty eqns = match vars ty $ NEL.toList $ shiftEqns eqns
 
-matchBangs :: [MatchId] -> Type -> [EquationInfo] -> DsM MatchResult
-matchBangs (var:vars) ty eqns
-  = do  { match_result <- match (var:vars) ty $
-                          map (decomposeFirstPat getBangPat) eqns
+matchBangs :: NonEmpty MatchId -> Type -> NonEmpty EquationInfo -> DsM MatchResult
+matchBangs (var :| vars) ty eqns
+  = do  { match_result <- match (var:vars) ty $ NEL.toList $
+            decomposeFirstPat getBangPat <$> eqns
         ; return (mkEvalMatchResult var ty match_result) }
-matchBangs [] _ _ = panic "matchBangs"
 
-matchCoercion :: [MatchId] -> Type -> [EquationInfo] -> DsM MatchResult
+matchCoercion :: NonEmpty MatchId -> Type -> NonEmpty EquationInfo -> DsM MatchResult
 -- Apply the coercion to the match variable and then match that
-matchCoercion (var:vars) ty (eqns@(eqn1:_))
+matchCoercion (var :| vars) ty (eqns@(eqn1 :| _))
   = do  { let CoPat _ co pat _ = firstPat eqn1
         ; let pat_ty' = hsPatType pat
         ; var' <- newUniqueId var pat_ty'
-        ; match_result <- match (var':vars) ty $
-                          map (decomposeFirstPat getCoPat) eqns
+        ; match_result <- match (var':vars) ty $ NEL.toList $
+            decomposeFirstPat getCoPat <$> eqns
         ; core_wrap <- dsHsWrapper co
         ; let bind = NonRec var' (core_wrap (Var var))
         ; return (mkCoLetMatchResult bind match_result) }
-matchCoercion _ _ _ = panic "matchCoercion"
 
-matchView :: [MatchId] -> Type -> [EquationInfo] -> DsM MatchResult
+matchView :: NonEmpty MatchId -> Type -> NonEmpty EquationInfo -> DsM MatchResult
 -- Apply the view function to the match variable and then match that
-matchView (var:vars) ty (eqns@(eqn1:_))
+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
@@ -275,26 +278,25 @@ matchView (var:vars) ty (eqns@(eqn1:_))
          -- do the rest of the compilation
         ; let pat_ty' = hsPatType pat
         ; var' <- newUniqueId var pat_ty'
-        ; match_result <- match (var':vars) ty $
-                          map (decomposeFirstPat getViewPat) eqns
+        ; match_result <- match (var':vars) ty $ NEL.toList $
+            decomposeFirstPat getViewPat <$> eqns
          -- compile the view expressions
         ; viewExpr' <- dsLExpr viewExpr
         ; return (mkViewMatchResult var'
                     (mkCoreAppDs (text "matchView") viewExpr' (Var var))
                     match_result) }
-matchView _ _ _ = panic "matchView"
 
-matchOverloadedList :: [MatchId] -> Type -> [EquationInfo] -> DsM MatchResult
-matchOverloadedList (var:vars) ty (eqns@(eqn1:_))
+matchOverloadedList :: NonEmpty MatchId -> Type -> NonEmpty 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 (ListPatTc 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
+       ; match_result <- match (var':vars) ty $ NEL.toList $
+           decomposeFirstPat getOLPat <$> eqns -- getOLPat builds the pattern inside as a non-overloaded version of the overloaded list pattern
        ; e' <- dsSyntaxExpr e [Var var]
-       ; return (mkViewMatchResult var' e' match_result) }
-matchOverloadedList _ _ _ = panic "matchOverloadedList"
+       ; return (mkViewMatchResult var' e' match_result)
+       }
 
 -- decompose the first pattern and leave the rest alone
 decomposeFirstPat :: (Pat GhcTc -> Pat GhcTc) -> EquationInfo -> EquationInfo
@@ -889,22 +891,24 @@ the PgN constructor as a Rational if numeric, and add a PgOverStr constructor
 for overloaded strings.
 -}
 
-groupEquations :: DynFlags -> [EquationInfo] -> [[(PatGroup, EquationInfo)]]
+groupEquations :: DynFlags -> [EquationInfo] -> [NonEmpty (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
-  = groupBy same_gp [(patGroup dflags (firstPat eqn), eqn) | eqn <- eqns]
+  = NEL.groupBy same_gp $ [(patGroup dflags (firstPat eqn), eqn) | eqn <- eqns]
+  -- comprehension on NonEmpty
   where
     same_gp :: (PatGroup,EquationInfo) -> (PatGroup,EquationInfo) -> Bool
     (pg1,_) `same_gp` (pg2,_) = pg1 `sameGroup` pg2
 
-subGroup :: (m -> [[EquationInfo]]) -- Map.elems
+-- TODO Make subGroup1 using a NonEmptyMap
+subGroup :: (m -> [NonEmpty EquationInfo]) -- Map.elems
          -> m -- Map.empty
-         -> (a -> m -> Maybe [EquationInfo]) -- Map.lookup
-         -> (a -> [EquationInfo] -> m -> m) -- Map.insert
-         -> [(a, EquationInfo)] -> [[EquationInfo]]
+         -> (a -> m -> Maybe (NonEmpty EquationInfo)) -- Map.lookup
+         -> (a -> NonEmpty EquationInfo -> m -> m) -- Map.insert
+         -> [(a, EquationInfo)] -> [NonEmpty 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
@@ -912,19 +916,19 @@ subGroup :: (m -> [[EquationInfo]]) -- Map.elems
 -- Parameterized by map operations to allow different implementations
 -- and constraints, eg. types without Ord instance.
 subGroup elems empty lookup insert group
-    = map reverse $ elems $ foldl' accumulate empty group
+    = fmap NEL.reverse $ elems $ foldl' accumulate empty group
   where
     accumulate pg_map (pg, eqn)
       = case lookup pg pg_map of
-          Just eqns -> insert pg (eqn:eqns) pg_map
-          Nothing   -> insert pg [eqn]      pg_map
+          Just eqns -> insert pg (NEL.cons eqn eqns) pg_map
+          Nothing   -> insert pg [eqn] pg_map
     -- pg_map :: Map a [EquationInfo]
     -- Equations seen so far in reverse order of appearance
 
-subGroupOrd :: Ord a => [(a, EquationInfo)] -> [[EquationInfo]]
+subGroupOrd :: Ord a => [(a, EquationInfo)] -> [NonEmpty EquationInfo]
 subGroupOrd = subGroup Map.elems Map.empty Map.lookup Map.insert
 
-subGroupUniq :: Uniquable a => [(a, EquationInfo)] -> [[EquationInfo]]
+subGroupUniq :: Uniquable a => [(a, EquationInfo)] -> [NonEmpty EquationInfo]
 subGroupUniq =
   subGroup eltsUDFM emptyUDFM (flip lookupUDFM) (\k v m -> addToUDFM m k v)
 
diff --git a/compiler/deSugar/MatchCon.hs b/compiler/deSugar/MatchCon.hs
index d1a0390da1..d27e1b37af 100644
--- a/compiler/deSugar/MatchCon.hs
+++ b/compiler/deSugar/MatchCon.hs
@@ -34,6 +34,7 @@ import SrcLoc
 import Outputable
 import Control.Monad(liftM)
 import Data.List (groupBy)
+import Data.List.NonEmpty (NonEmpty(..))
 
 {-
 We are confronted with the first column of patterns in a set of
@@ -88,40 +89,38 @@ have-we-used-all-the-constructors? question; the local function
 @match_cons_used@ does all the real work.
 -}
 
-matchConFamily :: [Id]
+matchConFamily :: NonEmpty Id
                -> Type
-               -> [[EquationInfo]]
+               -> NonEmpty (NonEmpty EquationInfo)
                -> DsM MatchResult
 -- Each group of eqns is for a single constructor
-matchConFamily (var:vars) ty groups
+matchConFamily (var :| vars) ty groups
   = do alts <- mapM (fmap toRealAlt . matchOneConLike vars ty) groups
        return (mkCoAlgCaseMatchResult var ty alts)
   where
     toRealAlt alt = case alt_pat alt of
         RealDataCon dcon -> alt{ alt_pat = dcon }
         _ -> panic "matchConFamily: not RealDataCon"
-matchConFamily [] _ _ = panic "matchConFamily []"
 
-matchPatSyn :: [Id]
+matchPatSyn :: NonEmpty Id
             -> Type
-            -> [EquationInfo]
+            -> NonEmpty EquationInfo
             -> DsM MatchResult
-matchPatSyn (var:vars) ty eqns
+matchPatSyn (var :| vars) ty eqns
   = do alt <- fmap toSynAlt $ matchOneConLike vars ty eqns
        return (mkCoSynCaseMatchResult var ty alt)
   where
     toSynAlt alt = case alt_pat alt of
         PatSynCon psyn -> alt{ alt_pat = psyn }
         _ -> panic "matchPatSyn: not PatSynCon"
-matchPatSyn _ _ _ = panic "matchPatSyn []"
 
 type ConArgPats = HsConDetails (LPat GhcTc) (HsRecFields GhcTc (LPat GhcTc))
 
 matchOneConLike :: [Id]
                 -> Type
-                -> [EquationInfo]
+                -> NonEmpty EquationInfo
                 -> DsM (CaseAlt ConLike)
-matchOneConLike vars ty (eqn1 : eqns)   -- All eqns for a single constructor
+matchOneConLike vars ty (eqn1 :| eqns)   -- All eqns for a single constructor
   = do  { let inst_tys = ASSERT( all tcIsTcTyVar ex_tvs )
                            -- ex_tvs can only be tyvars as data types in source
                            -- Haskell cannot mention covar yet (Aug 2018).
@@ -195,7 +194,6 @@ matchOneConLike vars ty (eqn1 : eqns)   -- All eqns for a single constructor
         lookup_fld (L _ rpat) = lookupNameEnv_NF fld_var_env
                                             (idName (unLoc (hsRecFieldId rpat)))
     select_arg_vars _ [] = panic "matchOneCon/select_arg_vars []"
-matchOneConLike _ _ [] = panic "matchOneCon []"
 
 -----------------
 compatible_pats :: (ConArgPats,a) -> (ConArgPats,a) -> Bool
diff --git a/compiler/deSugar/MatchLit.hs b/compiler/deSugar/MatchLit.hs
index 4f65362b2b..3fb64f6769 100644
--- a/compiler/deSugar/MatchLit.hs
+++ b/compiler/deSugar/MatchLit.hs
@@ -53,6 +53,8 @@ import qualified GHC.LanguageExtensions as LangExt
 
 import Control.Monad
 import Data.Int
+import Data.List.NonEmpty (NonEmpty(..))
+import qualified Data.List.NonEmpty as NEL
 import Data.Word
 import Data.Proxy
 
@@ -397,14 +399,13 @@ tidyNPat over_lit mb_neg eq outer_ty
 ************************************************************************
 -}
 
-matchLiterals :: [Id]
-              -> Type                   -- Type of the whole case expression
-              -> [[EquationInfo]]       -- All PgLits
+matchLiterals :: NonEmpty Id
+              -> Type -- ^ Type of the whole case expression
+              -> NonEmpty (NonEmpty EquationInfo) -- ^ All PgLits
               -> DsM MatchResult
 
-matchLiterals (var:vars) ty sub_groups
-  = ASSERT( notNull sub_groups && all notNull sub_groups )
-    do  {       -- Deal with each group
+matchLiterals (var :| vars) ty sub_groups
+  = do  {       -- Deal with each group
         ; alts <- mapM match_group sub_groups
 
                 -- Combine results.  For everything except String
@@ -415,14 +416,14 @@ matchLiterals (var:vars) ty sub_groups
                 ; mrs <- mapM (wrap_str_guard eq_str) alts
                 ; return (foldr1 combineMatchResults mrs) }
           else
-            return (mkCoPrimCaseMatchResult var ty alts)
+            return (mkCoPrimCaseMatchResult var ty $ NEL.toList alts)
         }
   where
-    match_group :: [EquationInfo] -> DsM (Literal, MatchResult)
-    match_group eqns
+    match_group :: NonEmpty EquationInfo -> DsM (Literal, MatchResult)
+    match_group eqns@(firstEqn :| _)
         = do { dflags <- getDynFlags
-             ; let LitPat _ hs_lit = firstPat (head eqns)
-             ; match_result <- match vars ty (shiftEqns eqns)
+             ; let LitPat _ hs_lit = firstPat firstEqn
+             ; match_result <- match vars ty (NEL.toList $ shiftEqns eqns)
              ; return (hsLitKey dflags hs_lit, match_result) }
 
     wrap_str_guard :: Id -> (Literal,MatchResult) -> DsM MatchResult
@@ -436,7 +437,6 @@ matchLiterals (var:vars) ty sub_groups
              ; return (mkGuardedMatchResult pred mr) }
     wrap_str_guard _ (l, _) = pprPanic "matchLiterals/wrap_str_guard" (ppr l)
 
-matchLiterals [] _ _ = panic "matchLiterals []"
 
 ---------------------------
 hsLitKey :: DynFlags -> HsLit GhcTc -> Literal
@@ -467,8 +467,8 @@ hsLitKey _      l                  = pprPanic "hsLitKey" (ppr l)
 ************************************************************************
 -}
 
-matchNPats :: [Id] -> Type -> [EquationInfo] -> DsM MatchResult
-matchNPats (var:vars) ty (eqn1:eqns)    -- All for the same literal
+matchNPats :: NonEmpty Id -> Type -> NonEmpty EquationInfo -> DsM MatchResult
+matchNPats (var :| vars) ty (eqn1 :| eqns)    -- All for the same literal
   = do  { let NPat _ (L _ lit) mb_neg eq_chk = firstPat eqn1
         ; lit_expr <- dsOverLit lit
         ; neg_lit <- case mb_neg of
@@ -477,7 +477,6 @@ matchNPats (var:vars) ty (eqn1:eqns)    -- All for the same literal
         ; pred_expr <- dsSyntaxExpr eq_chk [Var var, neg_lit]
         ; match_result <- match vars ty (shiftEqns (eqn1:eqns))
         ; return (mkGuardedMatchResult pred_expr match_result) }
-matchNPats vars _ eqns = pprPanic "matchOneNPat" (ppr (vars, eqns))
 
 {-
 ************************************************************************
@@ -497,9 +496,9 @@ We generate:
 \end{verbatim}
 -}
 
-matchNPlusKPats :: [Id] -> Type -> [EquationInfo] -> DsM MatchResult
+matchNPlusKPats :: NonEmpty Id -> Type -> NonEmpty EquationInfo -> DsM MatchResult
 -- All NPlusKPats, for the *same* literal k
-matchNPlusKPats (var:vars) ty (eqn1:eqns)
+matchNPlusKPats (var :| vars) ty (eqn1 :| eqns)
   = do  { let NPlusKPat _ (L _ n1) (L _ lit1) lit2 ge minus
                 = firstPat eqn1
         ; lit1_expr   <- dsOverLit lit1
@@ -517,5 +516,3 @@ matchNPlusKPats (var:vars) ty (eqn1:eqns)
         = (wrapBind n n1, eqn { eqn_pats = pats })
         -- The wrapBind is a no-op for the first equation
     shift _ e = pprPanic "matchNPlusKPats/shift" (ppr e)
-
-matchNPlusKPats vars _ eqns = pprPanic "matchNPlusKPats" (ppr (vars, eqns))
diff --git a/compiler/utils/Outputable.hs b/compiler/utils/Outputable.hs
index 6717430a58..d81c754866 100644
--- a/compiler/utils/Outputable.hs
+++ b/compiler/utils/Outputable.hs
@@ -124,6 +124,8 @@ import Text.Printf
 import Numeric (showFFloat)
 import Data.Graph (SCC(..))
 import Data.List (intersperse)
+import Data.List.NonEmpty (NonEmpty (..))
+import qualified Data.List.NonEmpty as NEL
 
 import GHC.Fingerprint
 import GHC.Show         ( showMultiLineString )
@@ -819,6 +821,9 @@ instance Outputable () where
 instance (Outputable a) => Outputable [a] where
     ppr xs = brackets (fsep (punctuate comma (map ppr xs)))
 
+instance (Outputable a) => Outputable (NonEmpty a) where
+    ppr = ppr . NEL.toList
+
 instance (Outputable a) => Outputable (Set a) where
     ppr s = braces (fsep (punctuate comma (map ppr (Set.toList s))))