Scrub various partiality involving lists (again).

Lets us avoid some use of `head` and `tail`, and some panics.

31 files changed, 184 insertions, 157 deletions

diff --git a/compiler/GHC/Cmm/Info/Build.hs b/compiler/GHC/Cmm/Info/Build.hs
index 0edf1ce3ab..4b9294020d 100644
--- a/compiler/GHC/Cmm/Info/Build.hs
+++ b/compiler/GHC/Cmm/Info/Build.hs
@@ -1221,15 +1221,15 @@ buildSRTChain
         ( [CmmDeclSRTs] -- The SRT object(s)
         , SRTEntry      -- label to use in the info table
         )
-buildSRTChain _ [] = panic "buildSRT: empty"
 buildSRTChain profile cafSet =
   case splitAt mAX_SRT_SIZE cafSet of
+    ([], _) -> panic "buildSRT: empty"
     (these, []) -> do
       (decl,lbl) <- buildSRT profile these
       return ([decl], lbl)
-    (these,those) -> do
-      (rest, rest_lbl) <- buildSRTChain profile (head these : those)
-      (decl,lbl) <- buildSRT profile (rest_lbl : tail these)
+    (this:these,those) -> do
+      (rest, rest_lbl) <- buildSRTChain profile (this : those)
+      (decl,lbl) <- buildSRT profile (rest_lbl : these)
       return (decl:rest, lbl)
   where
     mAX_SRT_SIZE = 16
diff --git a/compiler/GHC/CmmToAsm/BlockLayout.hs b/compiler/GHC/CmmToAsm/BlockLayout.hs
index f59fb14679..2d4f75be5c 100644
--- a/compiler/GHC/CmmToAsm/BlockLayout.hs
+++ b/compiler/GHC/CmmToAsm/BlockLayout.hs
@@ -13,7 +13,7 @@ module GHC.CmmToAsm.BlockLayout
     ( sequenceTop, backendMaintainsCfg)
 where
 
-import GHC.Prelude
+import GHC.Prelude hiding (head, init, last, tail)
 
 import GHC.Platform
 
@@ -42,6 +42,9 @@ import GHC.Utils.Panic.Plain
 import GHC.Utils.Misc
 
 import Data.List (sortOn, sortBy, nub)
+import qualified Data.List as Partial (head, tail)
+import Data.List.NonEmpty (nonEmpty)
+import qualified Data.List.NonEmpty as NE
 import Data.Foldable (toList)
 import qualified Data.Set as Set
 import Data.STRef
@@ -354,7 +357,7 @@ chainToBlocks (BlockChain blks) = fromOL blks
 breakChainAt :: BlockId -> BlockChain
              -> (BlockChain,BlockChain)
 breakChainAt bid (BlockChain blks)
-    | not (bid == head rblks)
+    | not (bid == Partial.head rblks)
     = panic "Block not in chain"
     | otherwise
     = (BlockChain (toOL lblks),
@@ -493,7 +496,7 @@ mergeChains edges chains
         merge :: forall s. [CfgEdge] -> LabelMap (Point s BlockChain) -> ST s BlockChain
         merge [] chains = do
             chains' <- mapM find =<< (nub <$> (mapM repr $ mapElems chains)) :: ST s [BlockChain]
-            return $ foldl' chainConcat (head chains') (tail chains')
+            return $ foldl' chainConcat (Partial.head chains') (Partial.tail chains')
         merge ((CfgEdge from to _):edges) chains
         --   | pprTrace "merge" (ppr (from,to) <> ppr chains) False
         --   = undefined
@@ -593,8 +596,8 @@ buildChains edges blocks
             toChain <- readSTRef toRef
             let newChain = chainConcat fromChain toChain
             ref <- newSTRef newChain
-            let start = head $ takeL 1 newChain
-            let end = head $ takeR 1 newChain
+            let start = Partial.head $ takeL 1 newChain
+            let end = Partial.head $ takeR 1 newChain
             -- chains <- sequence $ mapMap readSTRef chainStarts
             -- pprTraceM "pre-fuse chains:" $ ppr chains
             buildNext
@@ -772,13 +775,13 @@ sequenceChain  info weights     blocks@((BasicBlock entry _):_) =
 dropJumps :: forall a i. Instruction i => LabelMap a -> [GenBasicBlock i]
           -> [GenBasicBlock i]
 dropJumps _    [] = []
-dropJumps info ((BasicBlock lbl ins):todo)
-    | not . null $ ins --This can happen because of shortcutting
-    , [dest] <- jumpDestsOfInstr (last ins)
-    , ((BasicBlock nextLbl _) : _) <- todo
+dropJumps info (BasicBlock lbl ins:todo)
+    | Just ins <- nonEmpty ins --This can happen because of shortcutting
+    , [dest] <- jumpDestsOfInstr (NE.last ins)
+    , BasicBlock nextLbl _ : _ <- todo
     , not (mapMember dest info)
     , nextLbl == dest
-    = BasicBlock lbl (init ins) : dropJumps info todo
+    = BasicBlock lbl (NE.init ins) : dropJumps info todo
     | otherwise
     = BasicBlock lbl ins : dropJumps info todo
 
@@ -869,10 +872,10 @@ mkNode edgeWeights block@(BasicBlock id instrs) =
             ((target,info):_)
               | length successors > 2 || edgeWeight info <= 0 -> []
               | otherwise -> [target]
-          | otherwise
-          = case jumpDestsOfInstr (last instrs) of
-                [one] -> [one]
-                _many -> []
+          | Just instr <- lastMaybe instrs
+          , [one] <- jumpDestsOfInstr instr
+          = [one]
+          | otherwise = []
 
 
 seqBlocks :: LabelMap i -> [Node BlockId (GenBasicBlock t1)]
diff --git a/compiler/GHC/CmmToAsm/PPC/Instr.hs b/compiler/GHC/CmmToAsm/PPC/Instr.hs
index b8fc53e201..c852789bbe 100644
--- a/compiler/GHC/CmmToAsm/PPC/Instr.hs
+++ b/compiler/GHC/CmmToAsm/PPC/Instr.hs
@@ -33,7 +33,7 @@ module GHC.CmmToAsm.PPC.Instr
    )
 where
 
-import GHC.Prelude
+import GHC.Prelude hiding (head, init, last, tail)
 
 import GHC.CmmToAsm.PPC.Regs
 import GHC.CmmToAsm.PPC.Cond
@@ -58,6 +58,8 @@ import GHC.Platform
 import GHC.Types.Unique.FM (listToUFM, lookupUFM)
 import GHC.Types.Unique.Supply
 
+import Data.Foldable (toList)
+import qualified Data.List.NonEmpty as NE
 import Data.Maybe (fromMaybe)
 
 
@@ -679,10 +681,11 @@ makeFarBranches
         -> [NatBasicBlock Instr]
         -> [NatBasicBlock Instr]
 makeFarBranches info_env blocks
-    | last blockAddresses < nearLimit = blocks
-    | otherwise = zipWith handleBlock blockAddresses blocks
+    | NE.last blockAddresses < nearLimit = blocks
+    | otherwise = zipWith handleBlock blockAddressList blocks
     where
-        blockAddresses = scanl (+) 0 $ map blockLen blocks
+        blockAddresses = NE.scanl (+) 0 $ map blockLen blocks
+        blockAddressList = toList blockAddresses
         blockLen (BasicBlock _ instrs) = length instrs
 
         handleBlock addr (BasicBlock id instrs)
@@ -703,4 +706,4 @@ makeFarBranches info_env blocks
         -- to calculate things exactly
         nearLimit = 7000 - mapSize info_env * maxRetInfoTableSizeW
 
-        blockAddressMap = listToUFM $ zip (map blockId blocks) blockAddresses
+        blockAddressMap = listToUFM $ zip (map blockId blocks) blockAddressList
diff --git a/compiler/GHC/CmmToAsm/X86/CodeGen.hs b/compiler/GHC/CmmToAsm/X86/CodeGen.hs
index 9861177c3a..fd85ae6154 100644
--- a/compiler/GHC/CmmToAsm/X86/CodeGen.hs
+++ b/compiler/GHC/CmmToAsm/X86/CodeGen.hs
@@ -3353,9 +3353,9 @@ invertCondBranches (Just cfg) keep bs =
     invert bs
   where
     invert :: [NatBasicBlock Instr] -> [NatBasicBlock Instr]
-    invert ((BasicBlock lbl1 ins@(_:_:_xs)):b2@(BasicBlock lbl2 _):bs)
+    invert (BasicBlock lbl1 ins:b2@(BasicBlock lbl2 _):bs)
       | --pprTrace "Block" (ppr lbl1) True,
-        (jmp1,jmp2) <- last2 ins
+        Just (jmp1,jmp2) <- last2 ins
       , JXX cond1 target1 <- jmp1
       , target1 == lbl2
       --, pprTrace "CutChance" (ppr b1) True
diff --git a/compiler/GHC/Core/InstEnv.hs b/compiler/GHC/Core/InstEnv.hs
index 53d7077e61..af2045caac 100644
--- a/compiler/GHC/Core/InstEnv.hs
+++ b/compiler/GHC/Core/InstEnv.hs
@@ -32,7 +32,7 @@ module GHC.Core.InstEnv (
         isOverlappable, isOverlapping, isIncoherent
     ) where
 
-import GHC.Prelude
+import GHC.Prelude hiding ( head, init, last, tail )
 
 import GHC.Tc.Utils.TcType -- InstEnv is really part of the type checker,
               -- and depends on TcType in many ways
@@ -50,6 +50,8 @@ import GHC.Core.Unify
 import GHC.Types.Basic
 import GHC.Types.Id
 import Data.Data        ( Data )
+import Data.List.NonEmpty ( NonEmpty (..), nonEmpty )
+import qualified Data.List.NonEmpty as NE
 import Data.Maybe       ( isJust )
 
 import GHC.Utils.Outputable
@@ -280,16 +282,18 @@ mkLocalInstance dfun oflag tvs cls tys
 
     -- See Note [When exactly is an instance decl an orphan?]
     orph | is_local cls_name   = NotOrphan (nameOccName cls_name)
-         | all notOrphan mb_ns = assert (not (null mb_ns)) $ head mb_ns
+         | all notOrphan mb_ns = NE.head mb_ns
          | otherwise           = IsOrphan
 
     notOrphan NotOrphan{} = True
     notOrphan _ = False
 
-    mb_ns :: [IsOrphan]    -- One for each fundep; a locally-defined name
-                           -- that is not in the "determined" arguments
-    mb_ns | null fds   = [choose_one arg_names]
-          | otherwise  = map do_one fds
+    mb_ns :: NonEmpty IsOrphan
+    -- One for each fundep; a locally-defined name
+    -- that is not in the "determined" arguments
+    mb_ns = case nonEmpty fds of
+        Nothing -> NE.singleton (choose_one arg_names)
+        Just fds -> fmap do_one fds
     do_one (_ltvs, rtvs) = choose_one [ns | (tv,ns) <- cls_tvs `zip` arg_names
                                             , not (tv `elem` rtvs)]
 
diff --git a/compiler/GHC/Core/Lint.hs b/compiler/GHC/Core/Lint.hs
index 04f685de55..f983c49d6f 100644
--- a/compiler/GHC/Core/Lint.hs
+++ b/compiler/GHC/Core/Lint.hs
@@ -3196,8 +3196,8 @@ dumpLoc (UnfoldingOf b)
 dumpLoc (BodyOfLetRec [])
   = (noSrcLoc, text "In body of a letrec with no binders")
 
-dumpLoc (BodyOfLetRec bs@(_:_))
-  = ( getSrcLoc (head bs), text "In the body of letrec with binders" <+> pp_binders bs)
+dumpLoc (BodyOfLetRec bs@(b:_))
+  = ( getSrcLoc b, text "In the body of letrec with binders" <+> pp_binders bs)
 
 dumpLoc (AnExpr e)
   = (noSrcLoc, text "In the expression:" <+> ppr e)
diff --git a/compiler/GHC/Core/Opt/Monad.hs b/compiler/GHC/Core/Opt/Monad.hs
index a195f3997e..e06d4ed06d 100644
--- a/compiler/GHC/Core/Opt/Monad.hs
+++ b/compiler/GHC/Core/Opt/Monad.hs
@@ -70,6 +70,7 @@ import GHC.Unit.External
 
 import Data.Bifunctor ( bimap )
 import Data.Dynamic
+import Data.Maybe (listToMaybe)
 import Data.Word
 import Control.Monad
 import Control.Applicative ( Alternative(..) )
@@ -328,8 +329,8 @@ getFirstAnnotations :: Typeable a => ([Word8] -> a) -> ModGuts -> CoreM (ModuleE
 getFirstAnnotations deserialize guts
   = bimap mod name <$> getAnnotations deserialize guts
   where
-    mod = mapModuleEnv head . filterModuleEnv (const $ not . null)
-    name = mapNameEnv head . filterNameEnv (not . null)
+    mod = mapMaybeModuleEnv (const listToMaybe)
+    name = mapMaybeNameEnv listToMaybe
 
 {-
 Note [Annotations]
diff --git a/compiler/GHC/Core/Opt/OccurAnal.hs b/compiler/GHC/Core/Opt/OccurAnal.hs
index bf6393f292..5e59e149a9 100644
--- a/compiler/GHC/Core/Opt/OccurAnal.hs
+++ b/compiler/GHC/Core/Opt/OccurAnal.hs
@@ -22,7 +22,7 @@ module GHC.Core.Opt.OccurAnal (
     zapLambdaBndrs
   ) where
 
-import GHC.Prelude
+import GHC.Prelude hiding ( head, init, last, tail )
 
 import GHC.Core
 import GHC.Core.FVs
@@ -59,6 +59,8 @@ import GHC.Builtin.Names( runRWKey )
 import GHC.Unit.Module( Module )
 
 import Data.List (mapAccumL, mapAccumR)
+import Data.List.NonEmpty (NonEmpty (..), nonEmpty)
+import qualified Data.List.NonEmpty as NE
 
 {-
 ************************************************************************
@@ -3129,7 +3131,7 @@ tagNonRecBinder :: TopLevelFlag           -- At top level?
 tagNonRecBinder lvl usage binder
  = let
      occ     = lookupDetails usage binder
-     will_be_join = decideJoinPointHood lvl usage [binder]
+     will_be_join = decideJoinPointHood lvl usage (NE.singleton binder)
      occ'    | will_be_join = -- must already be marked AlwaysTailCalled
                               assert (isAlwaysTailCalled occ) occ
              | otherwise    = markNonTail occ
@@ -3154,7 +3156,11 @@ tagRecBinders lvl body_uds details_s
      -- 1. Determine join-point-hood of whole group, as determined by
      --    the *unadjusted* usage details
      unadj_uds     = foldr andUDs body_uds rhs_udss
-     will_be_joins = decideJoinPointHood lvl unadj_uds bndrs
+
+     -- This is only used in `mb_join_arity`, to adjust each `Details` in `details_s`, thus,
+     -- when `bndrs` is non-empty. So, we only write `maybe False` as `decideJoinPointHood`
+     -- takes a `NonEmpty CoreBndr`; the default value `False` won't affect program behavior.
+     will_be_joins = maybe False (decideJoinPointHood lvl unadj_uds) (nonEmpty bndrs)
 
      -- 2. Adjust usage details of each RHS, taking into account the
      --    join-point-hood decision
@@ -3210,12 +3216,12 @@ setBinderOcc occ_info bndr
 --
 -- See Note [Invariants on join points] in "GHC.Core".
 decideJoinPointHood :: TopLevelFlag -> UsageDetails
-                    -> [CoreBndr]
+                    -> NonEmpty CoreBndr
                     -> Bool
 decideJoinPointHood TopLevel _ _
   = False
 decideJoinPointHood NotTopLevel usage bndrs
-  | isJoinId (head bndrs)
+  | isJoinId (NE.head bndrs)
   = warnPprTrace (not all_ok)
                  "OccurAnal failed to rediscover join point(s)" (ppr bndrs)
                  all_ok
diff --git a/compiler/GHC/Core/Utils.hs b/compiler/GHC/Core/Utils.hs
index 02cd2bf8af..2dc3432ddd 100644
--- a/compiler/GHC/Core/Utils.hs
+++ b/compiler/GHC/Core/Utils.hs
@@ -2152,14 +2152,17 @@ diffBinds :: Bool -> RnEnv2 -> [(Var, CoreExpr)] -> [(Var, CoreExpr)]
 diffBinds top env binds1 = go (length binds1) env binds1
  where go _    env []     []
           = ([], env)
-       go fuel env binds1 binds2
-          -- No binds left to compare? Bail out early.
-          | null binds1 || null binds2
-          = (warn env binds1 binds2, env)
+       go _fuel env [] binds2
+          -- No binds remaining to compare on the left? Bail out early.
+          = (warn env [] binds2, env)
+       go _fuel env binds1 []
+          -- No binds remaining to compare on the right? Bail out early.
+          = (warn env binds1 [], env)
+       go fuel env binds1@(bind1:_) binds2@(_:_)
           -- Iterated over all binds without finding a match? Then
           -- try speculatively matching binders by order.
           | fuel == 0
-          = if not $ env `inRnEnvL` fst (head binds1)
+          = if not $ env `inRnEnvL` fst bind1
             then let env' = uncurry (rnBndrs2 env) $ unzip $
                             zip (sort $ map fst binds1) (sort $ map fst binds2)
                  in go (length binds1) env' binds1 binds2
@@ -2175,7 +2178,6 @@ diffBinds top env binds1 = go (length binds1) env binds1
                 binds1 (binds2l ++ binds2r)
           | otherwise -- No match, so push back (FIXME O(n^2))
           = go (fuel-1) env (binds1++[(bndr1,expr1)]) binds2
-       go _ _ _ _ = panic "diffBinds: impossible" -- GHC isn't smart enough
 
        -- We have tried everything, but couldn't find a good match. So
        -- now we just return the comparison results when we pair up
diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs
index 836ad88005..19b874dcf7 100644
--- a/compiler/GHC/Driver/Session.hs
+++ b/compiler/GHC/Driver/Session.hs
@@ -4467,12 +4467,11 @@ setCallerCcFilters arg =
 
 setMainIs :: String -> DynP ()
 setMainIs arg
-  | not (null main_fn) && isLower (head main_fn)
-     -- The arg looked like "Foo.Bar.baz"
+  | x:_ <- main_fn, isLower x  -- The arg looked like "Foo.Bar.baz"
   = upd $ \d -> d { mainFunIs = Just main_fn,
                     mainModuleNameIs = mkModuleName main_mod }
 
-  | isUpper (head arg)  -- The arg looked like "Foo" or "Foo.Bar"
+  | x:_ <- arg, isUpper x  -- The arg looked like "Foo" or "Foo.Bar"
   = upd $ \d -> d { mainModuleNameIs = mkModuleName arg }
 
   | otherwise                   -- The arg looked like "baz"
diff --git a/compiler/GHC/Hs/Decls.hs b/compiler/GHC/Hs/Decls.hs
index c4a79f25a7..e1e368a76b 100644
--- a/compiler/GHC/Hs/Decls.hs
+++ b/compiler/GHC/Hs/Decls.hs
@@ -487,10 +487,11 @@ pp_vanilla_decl_head thing (HsQTvs { hsq_explicit = tyvars }) fixity context
  = hsep [pprLHsContext context, pp_tyvars tyvars]
   where
     pp_tyvars (varl:varsr)
-      | fixity == Infix && length varsr > 1
+      | fixity == Infix, varr:varsr'@(_:_) <- varsr
+         -- If varsr has at least 2 elements, parenthesize.
          = hsep [char '(',ppr (unLoc varl), pprInfixOcc (unLoc thing)
-                , (ppr.unLoc) (head varsr), char ')'
-                , hsep (map (ppr.unLoc) (tail varsr))]
+                , (ppr.unLoc) varr, char ')'
+                , hsep (map (ppr.unLoc) varsr')]
       | fixity == Infix
          = hsep [ppr (unLoc varl), pprInfixOcc (unLoc thing)
          , hsep (map (ppr.unLoc) varsr)]
diff --git a/compiler/GHC/Hs/Utils.hs b/compiler/GHC/Hs/Utils.hs
index 195df82d8a..eb708cd295 100644
--- a/compiler/GHC/Hs/Utils.hs
+++ b/compiler/GHC/Hs/Utils.hs
@@ -109,7 +109,7 @@ module GHC.Hs.Utils(
   lStmtsImplicits, hsValBindsImplicits, lPatImplicits
   ) where
 
-import GHC.Prelude
+import GHC.Prelude hiding (head, init, last, tail)
 
 import GHC.Hs.Decls
 import GHC.Hs.Binds
@@ -150,6 +150,8 @@ import Data.Either
 import Data.Foldable ( toList )
 import Data.Function
 import Data.List ( partition, deleteBy )
+import Data.List.NonEmpty ( nonEmpty )
+import qualified Data.List.NonEmpty as NE
 
 {-
 ************************************************************************
@@ -220,8 +222,9 @@ mkLamCaseMatchGroup origin lc_variant (L l matches)
 
 mkLocatedList :: Semigroup a
   => [GenLocated (SrcAnn a) e2] -> LocatedAn an [GenLocated (SrcAnn a) e2]
-mkLocatedList [] = noLocA []
-mkLocatedList ms = L (noAnnSrcSpan $ locA $ combineLocsA (head ms) (last ms)) ms
+mkLocatedList ms = case nonEmpty ms of
+    Nothing -> noLocA []
+    Just ms1 -> L (noAnnSrcSpan $ locA $ combineLocsA (NE.head ms1) (NE.last ms1)) ms
 
 mkHsApp :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
 mkHsApp e1 e2 = addCLocAA e1 e2 (HsApp noComments e1 e2)
@@ -656,7 +659,7 @@ missingTupArg ann = Missing ann
 mkLHsPatTup :: [LPat GhcRn] -> LPat GhcRn
 mkLHsPatTup []     = noLocA $ TuplePat noExtField [] Boxed
 mkLHsPatTup [lpat] = lpat
-mkLHsPatTup lpats  = L (getLoc (head lpats)) $ TuplePat noExtField lpats Boxed
+mkLHsPatTup lpats@(lpat:_) = L (getLoc lpat) $ TuplePat noExtField lpats Boxed
 
 -- | The Big equivalents for the source tuple expressions
 mkBigLHsVarTup :: IsSrcSpanAnn p a
diff --git a/compiler/GHC/HsToCore/Pmc/Solver/Types.hs b/compiler/GHC/HsToCore/Pmc/Solver/Types.hs
index d602335692..fa22807358 100644
--- a/compiler/GHC/HsToCore/Pmc/Solver/Types.hs
+++ b/compiler/GHC/HsToCore/Pmc/Solver/Types.hs
@@ -348,9 +348,9 @@ isDataConSolution _                                             = False
 lookupSolution :: Nabla -> Id -> Maybe PmAltConApp
 lookupSolution nabla x = case vi_pos (lookupVarInfo (nabla_tm_st nabla) x) of
   []                                         -> Nothing
-  pos
+  pos@(x:_)
     | Just sol <- find isDataConSolution pos -> Just sol
-    | otherwise                              -> Just (head pos)
+    | otherwise                              -> Just x
 
 --------------------------------------------------------------------------------
 -- The rest is just providing an IR for (overloaded!) literals and AltCons that
diff --git a/compiler/GHC/HsToCore/Utils.hs b/compiler/GHC/HsToCore/Utils.hs
index 05992ce499..7564a3cd1c 100644
--- a/compiler/GHC/HsToCore/Utils.hs
+++ b/compiler/GHC/HsToCore/Utils.hs
@@ -821,7 +821,7 @@ is_triv_pat _            = False
 mkLHsPatTup :: [LPat GhcTc] -> LPat GhcTc
 mkLHsPatTup []     = noLocA $ mkVanillaTuplePat [] Boxed
 mkLHsPatTup [lpat] = lpat
-mkLHsPatTup lpats  = L (getLoc (head lpats)) $
+mkLHsPatTup lpats@(L l _:_)  = L l $
                      mkVanillaTuplePat lpats Boxed
 
 mkVanillaTuplePat :: [LPat GhcTc] -> Boxity -> Pat GhcTc
diff --git a/compiler/GHC/Iface/Ext/Ast.hs b/compiler/GHC/Iface/Ext/Ast.hs
index 61a88fc4c7..8f97f51833 100644
--- a/compiler/GHC/Iface/Ext/Ast.hs
+++ b/compiler/GHC/Iface/Ext/Ast.hs
@@ -23,7 +23,7 @@ module GHC.Iface.Ext.Ast ( mkHieFile, mkHieFileWithSource, getCompressedAsts, en
 
 import GHC.Utils.Outputable(ppr)
 
-import GHC.Prelude
+import GHC.Prelude hiding ( head, init, last, tail )
 
 import GHC.Types.Avail            ( Avails )
 import GHC.Data.Bag               ( Bag, bagToList )
@@ -71,7 +71,8 @@ import qualified Data.Set as S
 import Data.Data                  ( Data, Typeable )
 import Data.Foldable              ( toList )
 import Data.Functor.Identity      ( Identity(..) )
-import Data.List.NonEmpty         ( NonEmpty(..) )
+import Data.List.NonEmpty         ( NonEmpty(..), nonEmpty )
+import qualified Data.List.NonEmpty as NE
 import Data.Void                  ( Void, absurd )
 import Control.Monad              ( forM_ )
 import Control.Monad.Trans.State.Strict
@@ -334,10 +335,11 @@ enrichHie ts (hsGrp, imports, exports, docs) ev_bs insts tcs =
         Nothing -> pure ()
         Just c -> forM_ (classSCSelIds c) $ \v ->
           addUnlocatedEvBind v (EvidenceVarBind (EvInstBind True (className c)) ModuleScope Nothing)
-    let spanFile file children = case children of
-          [] -> realSrcLocSpan (mkRealSrcLoc file 1 1)
-          _ -> mkRealSrcSpan (realSrcSpanStart $ nodeSpan $ head children)
-                             (realSrcSpanEnd   $ nodeSpan $ last children)
+    let spanFile file children = case nonEmpty children of
+          Nothing -> realSrcLocSpan (mkRealSrcLoc file 1 1)
+          Just children -> mkRealSrcSpan
+              (realSrcSpanStart $ nodeSpan (NE.head children))
+              (realSrcSpanEnd   $ nodeSpan (NE.last children))
 
         flat_asts = concat
           [ tasts
diff --git a/compiler/GHC/Parser/PostProcess/Haddock.hs b/compiler/GHC/Parser/PostProcess/Haddock.hs
index 2194739373..2675921b04 100644
--- a/compiler/GHC/Parser/PostProcess/Haddock.hs
+++ b/compiler/GHC/Parser/PostProcess/Haddock.hs
@@ -48,7 +48,7 @@ Alternative approaches that did not work properly:
 -}
 module GHC.Parser.PostProcess.Haddock (addHaddockToModule) where
 
-import GHC.Prelude hiding (head, mod)
+import GHC.Prelude hiding (head, init, last, mod, tail)
 
 import GHC.Hs
 
@@ -60,7 +60,8 @@ import Data.Semigroup
 import Data.Foldable
 import Data.Traversable
 import Data.Maybe
-import Data.List.NonEmpty (head)
+import Data.List.NonEmpty (nonEmpty)
+import qualified Data.List.NonEmpty as NE
 import Control.Monad
 import Control.Monad.Trans.State.Strict
 import Control.Monad.Trans.Reader
@@ -699,7 +700,7 @@ instance HasHaddock (LocatedA (ConDecl GhcPs)) where
     case con_decl of
       ConDeclGADT { con_g_ext, con_names, con_dcolon, con_bndrs, con_mb_cxt, con_g_args, con_res_ty } -> do
         -- discardHasInnerDocs is ok because we don't need this info for GADTs.
-        con_doc' <- discardHasInnerDocs $ getConDoc (getLocA (head con_names))
+        con_doc' <- discardHasInnerDocs $ getConDoc (getLocA (NE.head con_names))
         con_g_args' <-
           case con_g_args of
             PrefixConGADT ts -> PrefixConGADT <$> addHaddock ts
@@ -873,13 +874,13 @@ addConTrailingDoc l_sep =
                     doc <- selectDocString trailingDocs
                     return $ L l' (con_fld { cd_fld_doc = fmap lexLHsDocString doc })
               con_args' <- case con_args con_decl of
-                x@(PrefixCon _ [])  -> x <$ reportExtraDocs trailingDocs
-                x@(RecCon (L _ [])) -> x <$ reportExtraDocs trailingDocs
-                PrefixCon _ ts -> PrefixCon noTypeArgs <$> mapLastM mk_doc_ty ts
+                x@(PrefixCon _ ts) -> case nonEmpty ts of
+                    Nothing -> x <$ reportExtraDocs trailingDocs
+                    Just ts -> PrefixCon noTypeArgs . toList <$> mapLastM mk_doc_ty ts
+                x@(RecCon (L l_rec flds)) -> case nonEmpty flds of
+                    Nothing -> x <$ reportExtraDocs trailingDocs
+                    Just flds -> RecCon . L l_rec . toList <$> mapLastM mk_doc_fld flds
                 InfixCon t1 t2 -> InfixCon t1 <$> mk_doc_ty t2
-                RecCon (L l_rec flds) -> do
-                  flds' <- mapLastM mk_doc_fld flds
-                  return (RecCon (L l_rec flds'))
               return $ L l (con_decl{ con_args = con_args' })
             else do
               con_doc' <- selectDoc (con_doc con_decl `mcons` (map lexLHsDocString trailingDocs))
diff --git a/compiler/GHC/Rename/Names.hs b/compiler/GHC/Rename/Names.hs
index ca710744de..6a98ba1893 100644
--- a/compiler/GHC/Rename/Names.hs
+++ b/compiler/GHC/Rename/Names.hs
@@ -30,7 +30,7 @@ module GHC.Rename.Names (
         ImportDeclUsage
     ) where
 
-import GHC.Prelude
+import GHC.Prelude hiding ( head, init, last, tail )
 
 import GHC.Driver.Env
 import GHC.Driver.Session
@@ -755,7 +755,7 @@ extendGlobalRdrEnvRn avails new_fixities
     -- This establishes INVARIANT 1 of GlobalRdrEnvs
     add_gre env gre
       | not (null dups)    -- Same OccName defined twice
-      = do { addDupDeclErr (gre : dups); return env }
+      = do { addDupDeclErr (gre :| dups); return env }
 
       | otherwise
       = return (extendGlobalRdrEnv env gre)
@@ -2153,10 +2153,9 @@ badImportItemErr iface decl_spec ie avails
 illegalImportItemErr :: SDoc
 illegalImportItemErr = text "Illegal import item"
 
-addDupDeclErr :: [GlobalRdrElt] -> TcRn ()
-addDupDeclErr [] = panic "addDupDeclErr: empty list"
-addDupDeclErr gres@(gre : _)
-  = addErrAt (getSrcSpan (last sorted_names)) $ mkTcRnUnknownMessage $ mkPlainError noHints $
+addDupDeclErr :: NonEmpty GlobalRdrElt -> TcRn ()
+addDupDeclErr gres@(gre :| _)
+  = addErrAt (getSrcSpan (NE.last sorted_names)) $ mkTcRnUnknownMessage $ mkPlainError noHints $
     -- Report the error at the later location
     vcat [text "Multiple declarations of" <+>
              quotes (ppr (greOccName gre)),
@@ -2164,11 +2163,11 @@ addDupDeclErr gres@(gre : _)
              -- latter might not be in scope in the RdrEnv and so will
              -- be printed qualified.
           text "Declared at:" <+>
-                   vcat (map (ppr . nameSrcLoc) sorted_names)]
+                   vcat (toList $ ppr . nameSrcLoc <$> sorted_names)]
   where
     sorted_names =
-      sortBy (SrcLoc.leftmost_smallest `on` nameSrcSpan)
-             (map greMangledName gres)
+      NE.sortBy (SrcLoc.leftmost_smallest `on` nameSrcSpan)
+             (fmap greMangledName gres)
 
 
 
diff --git a/compiler/GHC/Rename/Unbound.hs b/compiler/GHC/Rename/Unbound.hs
index b843ff6d5a..d91227670d 100644
--- a/compiler/GHC/Rename/Unbound.hs
+++ b/compiler/GHC/Rename/Unbound.hs
@@ -328,8 +328,7 @@ importSuggestions looking_for global_env hpt currMod imports rdr_name
       | otherwise                             = True
     where
       hpt_uniques = map fst (udfmToList hpt)
-      is_last_loaded_mod _ []         = False
-      is_last_loaded_mod modnam uniqs = last uniqs == getUnique modnam
+      is_last_loaded_mod modnam uniqs = lastMaybe uniqs == Just (getUnique modnam)
       glob_mods = nub [ mod
                      | gre <- globalRdrEnvElts global_env
                      , (mod, _) <- qualsInScope gre
diff --git a/compiler/GHC/Runtime/Heap/Inspect.hs b/compiler/GHC/Runtime/Heap/Inspect.hs
index cd2e20cc19..8357eb1bdb 100644
--- a/compiler/GHC/Runtime/Heap/Inspect.hs
+++ b/compiler/GHC/Runtime/Heap/Inspect.hs
@@ -23,7 +23,7 @@ module GHC.Runtime.Heap.Inspect(
      constrClosToName -- exported to use in test T4891
  ) where
 
-import GHC.Prelude
+import GHC.Prelude hiding (head, init, last, tail)
 import GHC.Platform
 
 import GHC.Runtime.Interpreter as GHCi
@@ -67,6 +67,8 @@ import GHC.IO (throwIO)
 import Control.Monad
 import Data.Maybe
 import Data.List ((\\))
+import Data.List.NonEmpty (NonEmpty (..))
+import qualified Data.List.NonEmpty as NE
 import GHC.Exts
 import qualified Data.Sequence as Seq
 import Data.Sequence (viewl, ViewL(..))
@@ -431,13 +433,14 @@ cPprTermBase y =
    --Note pprinting of list terms is not lazy
    ppr_list :: Precedence -> Term -> m SDoc
    ppr_list p (Term{subTerms=[h,t]}) = do
-       let elems      = h : getListTerms t
-           isConsLast = not (termType (last elems) `eqType` termType h)
+       let elems      = h :| getListTerms t
+           elemList   = toList elems
+           isConsLast = not (termType (NE.last elems) `eqType` termType h)
            is_string  = all (isCharTy . ty) elems
            chars = [ chr (fromIntegral w)
-                   | Term{subTerms=[Prim{valRaw=[w]}]} <- elems ]
+                   | Term{subTerms=[Prim{valRaw=[w]}]} <- elemList ]
 
-       print_elems <- mapM (y cons_prec) elems
+       print_elems <- mapM (y cons_prec) elemList
        if is_string
         then return (Ppr.doubleQuotes (Ppr.text chars))
         else if isConsLast
diff --git a/compiler/GHC/StgToByteCode.hs b/compiler/GHC/StgToByteCode.hs
index be2d6a82fa..2ad1a8300f 100644
--- a/compiler/GHC/StgToByteCode.hs
+++ b/compiler/GHC/StgToByteCode.hs
@@ -1299,10 +1299,11 @@ generateCCall d0 s p (CCallSpec target cconv safety) result_ty args_r_to_l
          push_args    = concatOL pushs_arg
          !d_after_args = d0 + wordsToBytes platform a_reps_sizeW
          a_reps_pushed_RAW
-            | null a_reps_pushed_r_to_l || not (isVoidRep (head a_reps_pushed_r_to_l))
-            = panic "GHC.StgToByteCode.generateCCall: missing or invalid World token?"
+            | x:xs <- a_reps_pushed_r_to_l
+            , isVoidRep x
+            = reverse xs
             | otherwise
-            = reverse (tail a_reps_pushed_r_to_l)
+            = panic "GHC.StgToByteCode.generateCCall: missing or invalid World token?"
 
          -- Now: a_reps_pushed_RAW are the reps which are actually on the stack.
          -- push_args is the code to do that.
@@ -1371,9 +1372,8 @@ generateCCall d0 s p (CCallSpec target cconv safety) result_ty args_r_to_l
          -- Get the arg reps, zapping the leading Addr# in the dynamic case
          a_reps --  | trace (showSDoc (ppr a_reps_pushed_RAW)) False = error "???"
                 | is_static = a_reps_pushed_RAW
-                | otherwise = if null a_reps_pushed_RAW
-                              then panic "GHC.StgToByteCode.generateCCall: dyn with no args"
-                              else tail a_reps_pushed_RAW
+                | _:xs <- a_reps_pushed_RAW = xs
+                | otherwise = panic "GHC.StgToByteCode.generateCCall: dyn with no args"
 
          -- push the Addr#
          (push_Addr, d_after_Addr)
@@ -1857,11 +1857,9 @@ mkMultiBranch maybe_ncons raw_ways = do
          testEQ NoDiscr    _          = panic "mkMultiBranch NoDiscr"
 
          -- None of these will be needed if there are no non-default alts
-         (init_lo, init_hi)
-            | null notd_ways
-            = panic "mkMultiBranch: awesome foursome"
-            | otherwise
-            = case fst (head notd_ways) of
+         (init_lo, init_hi) = case notd_ways of
+            [] -> panic "mkMultiBranch: awesome foursome"
+            (discr, _):_ -> case discr of
                 DiscrI _ -> ( DiscrI minBound,  DiscrI maxBound )
                 DiscrW _ -> ( DiscrW minBound,  DiscrW maxBound )
                 DiscrF _ -> ( DiscrF minF,      DiscrF maxF )
diff --git a/compiler/GHC/StgToCmm/Utils.hs b/compiler/GHC/StgToCmm/Utils.hs
index 29e9eddbf0..cd80cd51ff 100644
--- a/compiler/GHC/StgToCmm/Utils.hs
+++ b/compiler/GHC/StgToCmm/Utils.hs
@@ -46,7 +46,7 @@ module GHC.StgToCmm.Utils (
         convertInfoProvMap, cmmInfoTableToInfoProvEnt
   ) where
 
-import GHC.Prelude
+import GHC.Prelude hiding ( head, init, last, tail )
 
 import GHC.Platform
 import GHC.StgToCmm.Monad
@@ -448,8 +448,8 @@ emitCmmLitSwitch :: CmmExpr                    -- Tag to switch on
                -> [(Literal, CmmAGraphScoped)] -- Tagged branches
                -> CmmAGraphScoped              -- Default branch (always)
                -> FCode ()                     -- Emit the code
-emitCmmLitSwitch _scrut []       deflt = emit $ fst deflt
-emitCmmLitSwitch scrut  branches deflt = do
+emitCmmLitSwitch _scrut [] deflt = emit $ fst deflt
+emitCmmLitSwitch scrut branches@(branch:_) deflt = do
     scrut' <- assignTemp' scrut
     join_lbl <- newBlockId
     deflt_lbl <- label_code join_lbl deflt
@@ -460,7 +460,7 @@ emitCmmLitSwitch scrut  branches deflt = do
         rep = typeWidth cmm_ty
 
     -- We find the necessary type information in the literals in the branches
-    let (signed,range) = case head branches of
+    let (signed,range) = case branch of
           (LitNumber nt _, _) -> (signed,range)
             where
               signed = litNumIsSigned nt
diff --git a/compiler/GHC/Tc/Deriv/Generate.hs b/compiler/GHC/Tc/Deriv/Generate.hs
index 49d97e81e1..e51eee9841 100644
--- a/compiler/GHC/Tc/Deriv/Generate.hs
+++ b/compiler/GHC/Tc/Deriv/Generate.hs
@@ -1403,7 +1403,6 @@ gen_Data_binds loc (DerivInstTys{dit_rep_tc = rep_tc})
   where
     data_cons  = tyConDataCons rep_tc
     n_cons     = length data_cons
-    one_constr = n_cons == 1
 
         ------------ gfoldl
     gfoldl_bind = mkFunBindEC 3 loc gfoldl_RDR id (map gfoldl_eqn data_cons)
@@ -1420,11 +1419,11 @@ gen_Data_binds loc (DerivInstTys{dit_rep_tc = rep_tc})
         ------------ gunfold
     gunfold_bind = mkSimpleGeneratedFunBind loc
                      gunfold_RDR
-                     [k_Pat, z_Pat, if one_constr then nlWildPat else c_Pat]
+                     [k_Pat, z_Pat, if n_cons == 1 then nlWildPat else c_Pat]
                      gunfold_rhs
 
     gunfold_rhs
-        | one_constr = mk_unfold_rhs (head data_cons)   -- No need for case
+        | [con] <- data_cons = mk_unfold_rhs con   -- No need for case
         | otherwise  = nlHsCase (nlHsVar conIndex_RDR `nlHsApp` c_Expr)
                                 (map gunfold_alt data_cons)
 
diff --git a/compiler/GHC/Tc/Deriv/Generics.hs b/compiler/GHC/Tc/Deriv/Generics.hs
index b47d6cd632..d35bac99a4 100644
--- a/compiler/GHC/Tc/Deriv/Generics.hs
+++ b/compiler/GHC/Tc/Deriv/Generics.hs
@@ -21,7 +21,7 @@ module GHC.Tc.Deriv.Generics
    )
 where
 
-import GHC.Prelude
+import GHC.Prelude hiding (head, init, last, tail)
 
 import GHC.Hs
 import GHC.Core.Type
@@ -62,6 +62,9 @@ import Language.Haskell.Syntax.Basic (FieldLabelString(..))
 
 import Control.Monad (mplus)
 import Data.List (zip4, partition)
+import qualified Data.List as Partial (last)
+import Data.List.NonEmpty (nonEmpty)
+import qualified Data.List.NonEmpty as NE
 import Data.Maybe (isJust)
 
 {-
@@ -291,9 +294,9 @@ canDoGenerics1 dit@(DerivInstTys{dit_rep_tc = rep_tc}) =
       , ft_var = caseVar, ft_co_var = caseVar
 
       -- (component_0,component_1,...,component_n)
-      , ft_tup = \_ components -> if any _ccdg1_hasParam (init components)
-                                  then bmbad con
-                                  else foldr bmplus bmzero components
+      , ft_tup = \_ components -> case nonEmpty components of
+            Just components' | any _ccdg1_hasParam (NE.init components') -> bmbad con
+            _ -> foldr bmplus bmzero components
 
       -- (dom -> rng), where the head of ty is not a tuple tycon
       , ft_fun = \dom rng -> -- cf #8516
@@ -344,7 +347,7 @@ gk2gkDC Gen1 dc tc_args = Gen1_DC $ assert (isTyVarTy last_dc_inst_univ)
   where
     dc_inst_univs = dataConInstUnivs dc tc_args
     last_dc_inst_univ = assert (not (null dc_inst_univs)) $
-                        last dc_inst_univs
+                        Partial.last dc_inst_univs
 
 
 -- Bindings for the Generic instance
diff --git a/compiler/GHC/Tc/Gen/Default.hs b/compiler/GHC/Tc/Gen/Default.hs
index 15f2bdd440..9027337b83 100644
--- a/compiler/GHC/Tc/Gen/Default.hs
+++ b/compiler/GHC/Tc/Gen/Default.hs
@@ -26,9 +26,10 @@ import GHC.Builtin.Names
 import GHC.Types.Error
 import GHC.Types.SrcLoc
 import GHC.Utils.Outputable
-import GHC.Utils.Panic
 import qualified GHC.LanguageExtensions as LangExt
 
+import Data.List.NonEmpty ( NonEmpty (..) )
+
 tcDefaults :: [LDefaultDecl GhcRn]
            -> TcM (Maybe [Type])    -- Defaulting types to heave
                                     -- into Tc monad for later use
@@ -67,9 +68,9 @@ tcDefaults [L locn (DefaultDecl _ mono_tys)]
 
         ; return (Just tau_tys) }
 
-tcDefaults decls@(L locn (DefaultDecl _ _) : _)
+tcDefaults (decl@(L locn (DefaultDecl _ _)) : decls)
   = setSrcSpan (locA locn) $
-    failWithTc (dupDefaultDeclErr decls)
+    failWithTc (dupDefaultDeclErr (decl:|decls))
 
 
 tc_default_ty :: [Class] -> LHsType GhcRn -> TcM Type
@@ -103,7 +104,6 @@ check_instance ty cls
 defaultDeclCtxt :: SDoc
 defaultDeclCtxt = text "When checking the types in a default declaration"
 
-dupDefaultDeclErr :: [LDefaultDecl GhcRn] -> TcRnMessage
-dupDefaultDeclErr (L _ (DefaultDecl _ _) : dup_things)
+dupDefaultDeclErr :: NonEmpty (LDefaultDecl GhcRn) -> TcRnMessage
+dupDefaultDeclErr (L _ (DefaultDecl _ _) :| dup_things)
   = TcRnMultipleDefaultDeclarations dup_things
-dupDefaultDeclErr [] = panic "dupDefaultDeclErr []"
diff --git a/compiler/GHC/Tc/Gen/HsType.hs b/compiler/GHC/Tc/Gen/HsType.hs
index b649891d04..19ea11f2d4 100644
--- a/compiler/GHC/Tc/Gen/HsType.hs
+++ b/compiler/GHC/Tc/Gen/HsType.hs
@@ -75,7 +75,7 @@ module GHC.Tc.Gen.HsType (
         funAppCtxt, addTyConFlavCtxt
    ) where
 
-import GHC.Prelude
+import GHC.Prelude hiding ( head, init, last, tail )
 
 import GHC.Hs
 import GHC.Rename.Utils
@@ -130,7 +130,8 @@ import GHC.Data.Maybe
 import GHC.Data.Bag( unitBag )
 
 import Data.Function ( on )
-import Data.List.NonEmpty as NE( NonEmpty(..), nubBy )
+import Data.List.NonEmpty ( NonEmpty(..), nonEmpty )
+import qualified Data.List.NonEmpty as NE
 import Data.List ( find, mapAccumL )
 import Control.Monad
 import Data.Tuple( swap )
@@ -3169,19 +3170,19 @@ tcExplicitTKBndrsX :: OutputableBndrFlag flag 'Renamed
 -- Push level, capture constraints, and emit an implication constraint.
 -- The implication constraint has a ForAllSkol ic_info,
 --   so that it is subject to a telescope test.
-tcExplicitTKBndrsX skol_mode bndrs thing_inside
-  | null bndrs
-  = do { res <- thing_inside
+tcExplicitTKBndrsX skol_mode bndrs thing_inside = case nonEmpty bndrs of
+    Nothing -> do
+       { res <- thing_inside
        ; return ([], res) }
 
-  | otherwise
-  = do { (tclvl, wanted, (skol_tvs, res))
+    Just bndrs1 -> do
+       { (tclvl, wanted, (skol_tvs, res))
              <- pushLevelAndCaptureConstraints $
                 bindExplicitTKBndrsX skol_mode bndrs $
                 thing_inside
 
        -- Set up SkolemInfo for telescope test
-       ; let bndr_1 = head bndrs; bndr_n = last bndrs
+       ; let bndr_1 = NE.head bndrs1; bndr_n = NE.last bndrs1
        ; skol_info <- mkSkolemInfo (ForAllSkol (HsTyVarBndrsRn  (unLoc <$> bndrs)))
          -- Notice that we use ForAllSkol here, ignoring the enclosing
          -- skol_info unlike tcImplicitTKBndrs, because the bad-telescope
diff --git a/compiler/GHC/Tc/Module.hs b/compiler/GHC/Tc/Module.hs
index d290045f62..68728cd3d7 100644
--- a/compiler/GHC/Tc/Module.hs
+++ b/compiler/GHC/Tc/Module.hs
@@ -891,9 +891,9 @@ checkHiBootIface'
       | name `elem` boot_dfun_names = return ()
 
         -- Check that the actual module exports the same thing
-      | not (null missing_names)
-      = addErrAt (nameSrcSpan (head missing_names))
-                 (missingBootThing True (head missing_names) "exported by")
+      | missing_name:_ <- missing_names
+      = addErrAt (nameSrcSpan missing_name)
+                 (missingBootThing True missing_name "exported by")
 
         -- If the boot module does not *define* the thing, we are done
         -- (it simply re-exports it, and names match, so nothing further to do)
diff --git a/compiler/GHC/Tc/TyCl.hs b/compiler/GHC/Tc/TyCl.hs
index 31da54dca7..ac5e336e65 100644
--- a/compiler/GHC/Tc/TyCl.hs
+++ b/compiler/GHC/Tc/TyCl.hs
@@ -4669,7 +4669,7 @@ checkValidClass cls
         -- Test case: rep-poly/RepPolyClassMethod.
 
         ; unless constrained_class_methods $
-          mapM_ check_constraint (tail (cls_pred:op_theta))
+          mapM_ check_constraint op_theta
 
         ; check_dm ctxt sel_id cls_pred tau2 dm
         }
diff --git a/compiler/GHC/Types/Name/Env.hs b/compiler/GHC/Types/Name/Env.hs
index a65bbed4a2..5990355426 100644
--- a/compiler/GHC/Types/Name/Env.hs
+++ b/compiler/GHC/Types/Name/Env.hs
@@ -19,7 +19,7 @@ module GHC.Types.Name.Env (
         unitNameEnv, nonDetNameEnvElts,
         extendNameEnv_C, extendNameEnv_Acc, extendNameEnv,
         extendNameEnvList, extendNameEnvList_C,
-        filterNameEnv, anyNameEnv,
+        filterNameEnv, mapMaybeNameEnv, anyNameEnv,
         plusNameEnv, plusNameEnv_C, plusNameEnv_CD, plusNameEnv_CD2, alterNameEnv,
         lookupNameEnv, lookupNameEnv_NF, delFromNameEnv, delListFromNameEnv,
         elemNameEnv, mapNameEnv, disjointNameEnv,
@@ -121,6 +121,7 @@ unitNameEnv        :: Name -> a -> NameEnv a
 lookupNameEnv      :: NameEnv a -> Name -> Maybe a
 lookupNameEnv_NF   :: NameEnv a -> Name -> a
 filterNameEnv      :: (elt -> Bool) -> NameEnv elt -> NameEnv elt
+mapMaybeNameEnv    :: (a -> Maybe b) -> NameEnv a -> NameEnv b
 anyNameEnv         :: (elt -> Bool) -> NameEnv elt -> Bool
 mapNameEnv         :: (elt1 -> elt2) -> NameEnv elt1 -> NameEnv elt2
 disjointNameEnv    :: NameEnv a -> NameEnv a -> Bool
@@ -149,6 +150,7 @@ extendNameEnvList_C x y z = addListToUFM_C x y z
 delFromNameEnv x y      = delFromUFM x y
 delListFromNameEnv x y  = delListFromUFM x y
 filterNameEnv x y       = filterUFM x y
+mapMaybeNameEnv x y     = mapMaybeUFM x y
 anyNameEnv f x          = foldUFM ((||) . f) False x
 disjointNameEnv x y     = disjointUFM x y
 seqEltsNameEnv seqElt x = seqEltsUFM seqElt x
diff --git a/compiler/GHC/Unit/Module/Env.hs b/compiler/GHC/Unit/Module/Env.hs
index 0c0559e206..aec4add585 100644
--- a/compiler/GHC/Unit/Module/Env.hs
+++ b/compiler/GHC/Unit/Module/Env.hs
@@ -9,7 +9,7 @@ module GHC.Unit.Module.Env
    , partitionModuleEnv
    , moduleEnvKeys, moduleEnvElts, moduleEnvToList
    , unitModuleEnv, isEmptyModuleEnv
-   , extendModuleEnvWith, filterModuleEnv
+   , extendModuleEnvWith, filterModuleEnv, mapMaybeModuleEnv
 
      -- * ModuleName mappings
    , ModuleNameEnv, DModuleNameEnv
@@ -94,6 +94,10 @@ filterModuleEnv :: (Module -> a -> Bool) -> ModuleEnv a -> ModuleEnv a
 filterModuleEnv f (ModuleEnv e) =
   ModuleEnv (Map.filterWithKey (f . unNDModule) e)
 
+mapMaybeModuleEnv :: (Module -> a -> Maybe b) -> ModuleEnv a -> ModuleEnv b
+mapMaybeModuleEnv f (ModuleEnv e) =
+  ModuleEnv (Map.mapMaybeWithKey (f . unNDModule) e)
+
 elemModuleEnv :: Module -> ModuleEnv a -> Bool
 elemModuleEnv m (ModuleEnv e) = Map.member (NDModule m) e
 
diff --git a/compiler/GHC/Utils/Misc.hs b/compiler/GHC/Utils/Misc.hs
index 307476b395..4020f1263f 100644
--- a/compiler/GHC/Utils/Misc.hs
+++ b/compiler/GHC/Utils/Misc.hs
@@ -124,7 +124,7 @@ module GHC.Utils.Misc (
         HasDebugCallStack,
     ) where
 
-import GHC.Prelude hiding ( last )
+import GHC.Prelude hiding ( head, init, last, tail )
 
 import GHC.Utils.Exception
 import GHC.Utils.Panic.Plain
@@ -133,7 +133,9 @@ import GHC.Utils.Fingerprint
 
 import Data.Data
 import qualified Data.List as List
-import Data.List.NonEmpty  ( NonEmpty(..), last )
+import qualified Data.List as Partial ( head )
+import Data.List.NonEmpty  ( NonEmpty(..), last, nonEmpty )
+import qualified Data.List.NonEmpty as NE
 
 import GHC.Exts
 import GHC.Stack (HasCallStack)
@@ -522,11 +524,9 @@ changeLast [_]    x  = [x]
 changeLast (x:xs) x' = x : changeLast xs x'
 
 -- | Apply an effectful function to the last list element.
--- Assumes a non-empty list (panics otherwise).
-mapLastM :: Functor f => (a -> f a) -> [a] -> f [a]
-mapLastM _ [] = panic "mapLastM: empty list"
-mapLastM f [x] = (\x' -> [x']) <$> f x
-mapLastM f (x:xs) = (x:) <$> mapLastM f xs
+mapLastM :: Functor f => (a -> f a) -> NonEmpty a -> f (NonEmpty a)
+mapLastM f (x:|[]) = NE.singleton <$> f x
+mapLastM f (x0:|x1:xs) = (x0 NE.<|) <$> mapLastM f (x1:|xs)
 
 whenNonEmpty :: Applicative m => [a] -> (NonEmpty a -> m ()) -> m ()
 whenNonEmpty []     _ = pure ()
@@ -590,7 +590,7 @@ isSortedBy cmp = sorted
 
 minWith :: Ord b => (a -> b) -> [a] -> a
 minWith get_key xs = assert (not (null xs) )
-                     head (sortWith get_key xs)
+                     Partial.head (sortWith get_key xs)
 
 nubSort :: Ord a => [a] -> [a]
 nubSort = Set.toAscList . Set.fromList
@@ -741,12 +741,10 @@ spanEnd p l = go l [] [] l
           | p x       = go yes (x : rev_yes) rev_no                  xs
           | otherwise = go xs  []            (x : rev_yes ++ rev_no) xs
 
--- | Get the last two elements in a list. Partial!
+-- | Get the last two elements in a list.
 {-# INLINE last2 #-}
-last2 :: [a] -> (a,a)
-last2 = List.foldl' (\(_,x2) x -> (x2,x)) (partialError,partialError)
-  where
-    partialError = panic "last2 - list length less than two"
+last2 :: [a] -> Maybe (a,a)
+last2 = uncurry (liftA2 (,)) . List.foldl' (\(_,x2) x -> (x2, Just x)) (Nothing, Nothing)
 
 lastMaybe :: [a] -> Maybe a
 lastMaybe [] = Nothing
@@ -764,17 +762,12 @@ onJust dflt = flip (maybe dflt)
 -- If you are guaranteed to use both, this will
 -- be more efficient.
 snocView :: [a] -> Maybe ([a],a)
-snocView [] = Nothing
-snocView xs
-    | (xs,x) <- go xs
-    = Just (xs,x)
+snocView = fmap go . nonEmpty
   where
-    go :: [a] -> ([a],a)
-    go [x] = ([],x)
-    go (x:xs)
-        | !(xs',x') <- go xs
-        = (x:xs', x')
-    go [] = error "impossible"
+    go :: NonEmpty a -> ([a],a)
+    go (x:|xs) = case nonEmpty xs of
+        Nothing -> ([],x)
+        Just xs -> case go xs of !(xs', x') -> (x:xs', x')
 
 split :: Char -> String -> [String]
 split c s = case rest of
diff --git a/compiler/GHC/Utils/Outputable.hs b/compiler/GHC/Utils/Outputable.hs
index fd065266d6..1c6126d208 100644
--- a/compiler/GHC/Utils/Outputable.hs
+++ b/compiler/GHC/Utils/Outputable.hs
@@ -121,6 +121,7 @@ import GHC.Utils.Ppr       ( Doc, Mode(..) )
 import GHC.Serialized
 import GHC.LanguageExtensions (Extension)
 import GHC.Utils.GlobalVars( unsafeHasPprDebug )
+import GHC.Utils.Misc (lastMaybe)
 
 import Data.ByteString (ByteString)
 import qualified Data.ByteString as BS
@@ -716,7 +717,7 @@ quotes d = sdocOption sdocCanUseUnicode $ \case
       in case str of
          []                   -> Pretty.quotes pp_d
          '\'' : _             -> pp_d
-         _ | '\'' <- last str -> pp_d
+         _ | Just '\'' <- lastMaybe str -> pp_d
            | otherwise        -> Pretty.quotes pp_d
 
 semi, comma, colon, equals, space, dcolon, underscore, dot, vbar :: SDoc