Use lengthIs and friends in more places

While investigating #12545, I discovered several places in the code
that performed length-checks like so:

```
length ts == 4
```

This is not ideal, since the length of `ts` could be much longer than 4,
and we'd be doing way more work than necessary! There are already a slew
of helper functions in `Util` such as `lengthIs` that are designed to do
this efficiently, so I found every place where they ought to be used and
did just that. I also defined a couple more utility functions for list
length that were common patterns (e.g., `ltLength`).

Test Plan: ./validate

Reviewers: austin, hvr, goldfire, bgamari, simonmar

Reviewed By: bgamari, simonmar

Subscribers: goldfire, rwbarton, thomie

Differential Revision: https://phabricator.haskell.org/D3622

57 files changed, 167 insertions, 130 deletions

diff --git a/compiler/basicTypes/DataCon.hs b/compiler/basicTypes/DataCon.hs
index 60cffac2ab..cc475e29d7 100644
--- a/compiler/basicTypes/DataCon.hs
+++ b/compiler/basicTypes/DataCon.hs
@@ -1130,7 +1130,7 @@ dataConInstArgTys :: DataCon    -- ^ A datacon with no existentials or equality
                   -> [Type]
 dataConInstArgTys dc@(MkData {dcUnivTyVars = univ_tvs,
                               dcExTyVars = ex_tvs}) inst_tys
- = ASSERT2( length univ_tvs == length inst_tys
+ = ASSERT2( univ_tvs `equalLength` inst_tys
           , text "dataConInstArgTys" <+> ppr dc $$ ppr univ_tvs $$ ppr inst_tys)
    ASSERT2( null ex_tvs, ppr dc )
    map (substTyWith (binderVars univ_tvs) inst_tys) (dataConRepArgTys dc)
@@ -1147,7 +1147,7 @@ dataConInstOrigArgTys
 dataConInstOrigArgTys dc@(MkData {dcOrigArgTys = arg_tys,
                                   dcUnivTyVars = univ_tvs,
                                   dcExTyVars = ex_tvs}) inst_tys
-  = ASSERT2( length tyvars == length inst_tys
+  = ASSERT2( tyvars `equalLength` inst_tys
           , text "dataConInstOrigArgTys" <+> ppr dc $$ ppr tyvars $$ ppr inst_tys )
     map (substTyWith tyvars inst_tys) arg_tys
   where
diff --git a/compiler/basicTypes/Demand.hs b/compiler/basicTypes/Demand.hs
index 95c7b79b4f..b6296f49f7 100644
--- a/compiler/basicTypes/Demand.hs
+++ b/compiler/basicTypes/Demand.hs
@@ -300,7 +300,7 @@ lubStr (SCall _)  (SProd _)    = HeadStr
 lubStr (SProd sx) HyperStr     = SProd sx
 lubStr (SProd _)  HeadStr      = HeadStr
 lubStr (SProd s1) (SProd s2)
-    | length s1 == length s2   = mkSProd (zipWith lubArgStr s1 s2)
+    | s1 `equalLength` s2      = mkSProd (zipWith lubArgStr s1 s2)
     | otherwise                = HeadStr
 lubStr (SProd _) (SCall _)     = HeadStr
 lubStr HeadStr   _             = HeadStr
@@ -325,7 +325,7 @@ bothStr (SCall _)  (SProd _)   = HyperStr  -- Weird
 bothStr (SProd _)  HyperStr    = HyperStr
 bothStr (SProd s1) HeadStr     = SProd s1
 bothStr (SProd s1) (SProd s2)
-    | length s1 == length s2   = mkSProd (zipWith bothArgStr s1 s2)
+    | s1 `equalLength` s2      = mkSProd (zipWith bothArgStr s1 s2)
     | otherwise                = HyperStr  -- Weird
 bothStr (SProd _) (SCall _)    = HyperStr
 
@@ -459,7 +459,7 @@ lubUse (UCall c1 u1) (UCall c2 u2) = UCall (lubCount c1 c2) (lubUse u1 u2)
 lubUse (UCall _ _) _               = Used
 lubUse (UProd ux) UHead            = UProd ux
 lubUse (UProd ux1) (UProd ux2)
-     | length ux1 == length ux2    = UProd $ zipWith lubArgUse ux1 ux2
+     | ux1 `equalLength` ux2       = UProd $ zipWith lubArgUse ux1 ux2
      | otherwise                   = Used
 lubUse (UProd {}) (UCall {})       = Used
 -- lubUse (UProd {}) Used             = Used
@@ -489,7 +489,7 @@ bothUse (UCall _ u1) (UCall _ u2)   = UCall Many (u1 `lubUse` u2)
 bothUse (UCall {}) _                = Used
 bothUse (UProd ux) UHead            = UProd ux
 bothUse (UProd ux1) (UProd ux2)
-      | length ux1 == length ux2    = UProd $ zipWith bothArgUse ux1 ux2
+      | ux1 `equalLength` ux2       = UProd $ zipWith bothArgUse ux1 ux2
       | otherwise                   = Used
 bothUse (UProd {}) (UCall {})       = Used
 -- bothUse (UProd {}) Used             = Used  -- Note [Used should win]
diff --git a/compiler/basicTypes/MkId.hs b/compiler/basicTypes/MkId.hs
index e9a57bc02e..a404e74e12 100644
--- a/compiler/basicTypes/MkId.hs
+++ b/compiler/basicTypes/MkId.hs
@@ -713,7 +713,7 @@ dataConSrcToImplBang dflags fam_envs arg_ty
       NoSrcUnpack ->
         gopt Opt_UnboxStrictFields dflags
             || (gopt Opt_UnboxSmallStrictFields dflags
-                && length rep_tys <= 1) -- See Note [Unpack one-wide fields]
+                && rep_tys `lengthAtMost` 1) -- See Note [Unpack one-wide fields]
       srcUnpack -> isSrcUnpacked srcUnpack
   = case mb_co of
       Nothing     -> HsUnpack Nothing
diff --git a/compiler/basicTypes/PatSyn.hs b/compiler/basicTypes/PatSyn.hs
index 823c838c05..0e218a39c1 100644
--- a/compiler/basicTypes/PatSyn.hs
+++ b/compiler/basicTypes/PatSyn.hs
@@ -394,7 +394,7 @@ patSynInstArgTys :: PatSyn -> [Type] -> [Type]
 patSynInstArgTys (MkPatSyn { psName = name, psUnivTyVars = univ_tvs
                            , psExTyVars = ex_tvs, psArgs = arg_tys })
                  inst_tys
-  = ASSERT2( length tyvars == length inst_tys
+  = ASSERT2( tyvars `equalLength` inst_tys
           , text "patSynInstArgTys" <+> ppr name $$ ppr tyvars $$ ppr inst_tys )
     map (substTyWith tyvars inst_tys) arg_tys
   where
@@ -409,7 +409,7 @@ patSynInstResTy :: PatSyn -> [Type] -> Type
 patSynInstResTy (MkPatSyn { psName = name, psUnivTyVars = univ_tvs
                           , psOrigResTy = res_ty })
                 inst_tys
-  = ASSERT2( length univ_tvs == length inst_tys
+  = ASSERT2( univ_tvs `equalLength` inst_tys
            , text "patSynInstResTy" <+> ppr name $$ ppr univ_tvs $$ ppr inst_tys )
     substTyWith (binderVars univ_tvs) inst_tys res_ty
 
diff --git a/compiler/cmm/CmmBuildInfoTables.hs b/compiler/cmm/CmmBuildInfoTables.hs
index 78c604e067..a28feb4a2b 100644
--- a/compiler/cmm/CmmBuildInfoTables.hs
+++ b/compiler/cmm/CmmBuildInfoTables.hs
@@ -174,7 +174,7 @@ buildSRT dflags topSRT cafs =
                mkSRT topSRT =
                  do localSRTs <- procpointSRT dflags (lbl topSRT) (elt_map topSRT) cafs
                     return (topSRT, localSRTs)
-           in if length cafs > maxBmpSize dflags then
+           in if cafs `lengthExceeds` maxBmpSize dflags then
                 mkSRT (foldl add_if_missing topSRT cafs)
               else -- make sure all the cafs are near the bottom of the srt
                 mkSRT (add_if_too_far topSRT cafs)
diff --git a/compiler/cmm/CmmContFlowOpt.hs b/compiler/cmm/CmmContFlowOpt.hs
index d8740df3f2..142de1e828 100644
--- a/compiler/cmm/CmmContFlowOpt.hs
+++ b/compiler/cmm/CmmContFlowOpt.hs
@@ -15,6 +15,7 @@ import CmmUtils
 import CmmSwitch (mapSwitchTargets)
 import Maybes
 import Panic
+import Util
 
 import Control.Monad
 import Prelude hiding (succ, unzip, zip)
@@ -392,7 +393,7 @@ predMap blocks = foldr add_preds mapEmpty blocks
 -- Removing unreachable blocks
 removeUnreachableBlocksProc :: CmmDecl -> CmmDecl
 removeUnreachableBlocksProc proc@(CmmProc info lbl live g)
-   | length used_blocks < mapSize (toBlockMap g)
+   | used_blocks `lengthLessThan` mapSize (toBlockMap g)
    = CmmProc info' lbl live g'
    | otherwise
    = proc
diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs
index 37572b7d4e..8eaee795a5 100644
--- a/compiler/codeGen/StgCmmClosure.hs
+++ b/compiler/codeGen/StgCmmClosure.hs
@@ -553,7 +553,7 @@ getCallMethod dflags _ id _ n_args v_args _cg_loc
               (Just (self_loop_id, block_id, args))
   | gopt Opt_Loopification dflags
   , id == self_loop_id
-  , n_args - v_args == length args
+  , args `lengthIs` (n_args - v_args)
   -- If these patterns match then we know that:
   --   * loopification optimisation is turned on
   --   * function is performing a self-recursive call in a tail position
diff --git a/compiler/codeGen/StgCmmExpr.hs b/compiler/codeGen/StgCmmExpr.hs
index edf97eeb0a..6e6ad7e9d7 100644
--- a/compiler/codeGen/StgCmmExpr.hs
+++ b/compiler/codeGen/StgCmmExpr.hs
@@ -562,7 +562,7 @@ chooseReturnBndrs bndr (PrimAlt _) _alts
   = assertNonVoidIds [bndr]
 
 chooseReturnBndrs _bndr (MultiValAlt n) [(_, ids, _)]
-  = ASSERT2(n == length ids, ppr n $$ ppr ids $$ ppr _bndr)
+  = ASSERT2(ids `lengthIs` n, ppr n $$ ppr ids $$ ppr _bndr)
     assertNonVoidIds ids     -- 'bndr' is not assigned!
 
 chooseReturnBndrs bndr (AlgAlt _) _alts
diff --git a/compiler/codeGen/StgCmmLayout.hs b/compiler/codeGen/StgCmmLayout.hs
index dc80036b55..b123420d58 100644
--- a/compiler/codeGen/StgCmmLayout.hs
+++ b/compiler/codeGen/StgCmmLayout.hs
@@ -274,7 +274,7 @@ direct_call :: String
             -> CLabel -> RepArity
             -> [(ArgRep,Maybe CmmExpr)] -> FCode ReturnKind
 direct_call caller call_conv lbl arity args
-  | debugIsOn && real_arity > length args  -- Too few args
+  | debugIsOn && args `lengthLessThan` real_arity  -- Too few args
   = do -- Caller should ensure that there enough args!
        pprPanic "direct_call" $
             text caller <+> ppr arity <+>
diff --git a/compiler/codeGen/StgCmmPrim.hs b/compiler/codeGen/StgCmmPrim.hs
index e0a68f68d8..1ecd72f9db 100644
--- a/compiler/codeGen/StgCmmPrim.hs
+++ b/compiler/codeGen/StgCmmPrim.hs
@@ -619,7 +619,7 @@ emitPrimOp dflags [res] (VecBroadcastOp vcat n w) [e] = do
 
 emitPrimOp dflags [res] (VecPackOp vcat n w) es = do
     checkVecCompatibility dflags vcat n w
-    when (length es /= n) $
+    when (es `lengthIsNot` n) $
         panic "emitPrimOp: VecPackOp has wrong number of arguments"
     doVecPackOp (vecElemInjectCast dflags vcat w) ty zeros es res
   where
@@ -637,7 +637,7 @@ emitPrimOp dflags [res] (VecPackOp vcat n w) es = do
 
 emitPrimOp dflags res (VecUnpackOp vcat n w) [arg] = do
     checkVecCompatibility dflags vcat n w
-    when (length res /= n) $
+    when (res `lengthIsNot` n) $
         panic "emitPrimOp: VecUnpackOp has wrong number of results"
     doVecUnpackOp (vecElemProjectCast dflags vcat w) ty arg res
   where
diff --git a/compiler/codeGen/StgCmmTicky.hs b/compiler/codeGen/StgCmmTicky.hs
index 8e4e5ece5a..8d86e37ddf 100644
--- a/compiler/codeGen/StgCmmTicky.hs
+++ b/compiler/codeGen/StgCmmTicky.hs
@@ -124,6 +124,7 @@ import Id
 import BasicTypes
 import FastString
 import Outputable
+import Util
 
 import DynFlags
 
@@ -381,7 +382,7 @@ tickyUnboxedTupleReturn arity
 -- Ticks at a *call site*:
 tickyDirectCall :: RepArity -> [StgArg] -> FCode ()
 tickyDirectCall arity args
-  | arity == length args = tickyKnownCallExact
+  | args `lengthIs` arity = tickyKnownCallExact
   | otherwise = do tickyKnownCallExtraArgs
                    tickySlowCallPat (map argPrimRep (drop arity args))
 
@@ -412,7 +413,7 @@ tickySlowCallPat :: [PrimRep] -> FCode ()
 tickySlowCallPat args = ifTicky $
   let argReps = map toArgRep args
       (_, n_matched) = slowCallPattern argReps
-  in if n_matched > 0 && n_matched == length args
+  in if n_matched > 0 && args `lengthIs` n_matched
      then bumpTickyLbl $ mkRtsSlowFastTickyCtrLabel $ concatMap (map Data.Char.toLower . argRepString) argReps
      else bumpTickyCounter $ fsLit "VERY_SLOW_CALL_ctr"
 
diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs
index 0888afbeeb..2be1020674 100644
--- a/compiler/coreSyn/CoreLint.hs
+++ b/compiler/coreSyn/CoreLint.hs
@@ -566,7 +566,7 @@ lintSingleBinding top_lvl_flag rec_flag (binder,rhs)
        -- Check that the binder's arity is within the bounds imposed by
        -- the type and the strictness signature. See Note [exprArity invariant]
        -- and Note [Trimming arity]
-       ; checkL (idArity binder <= length (typeArity (idType binder)))
+       ; checkL (typeArity (idType binder) `lengthAtLeast` idArity binder)
            (text "idArity" <+> ppr (idArity binder) <+>
            text "exceeds typeArity" <+>
            ppr (length (typeArity (idType binder))) <> colon <+>
@@ -574,7 +574,7 @@ lintSingleBinding top_lvl_flag rec_flag (binder,rhs)
 
        ; case splitStrictSig (idStrictness binder) of
            (demands, result_info) | isBotRes result_info ->
-             checkL (idArity binder <= length demands)
+             checkL (demands `lengthAtLeast` idArity binder)
                (text "idArity" <+> ppr (idArity binder) <+>
                text "exceeds arity imposed by the strictness signature" <+>
                ppr (idStrictness binder) <> colon <+>
@@ -1288,12 +1288,12 @@ lintType ty@(TyConApp tc tys)
   -- should be represented with the FunTy constructor. See Note [Linting
   -- function types] and Note [Representation of function types].
   | isFunTyCon tc
-  , length tys == 4
+  , tys `lengthIs` 4
   = failWithL (hang (text "Saturated application of (->)") 2 (ppr ty))
 
   | isTypeSynonymTyCon tc || isTypeFamilyTyCon tc
        -- Also type synonyms and type families
-  , length tys < tyConArity tc
+  , tys `lengthLessThan` tyConArity tc
   = failWithL (hang (text "Un-saturated type application") 2 (ppr ty))
 
   | otherwise
@@ -1715,7 +1715,7 @@ lintCoercion the_co@(NthCo n co)
              , isInjectiveTyCon tc_s r
                  -- see Note [NthCo and newtypes] in TyCoRep
              , tys_s `equalLength` tys_t
-             , n < length tys_s
+             , tys_s `lengthExceeds` n
              -> return (ks, kt, ts, tt, tr)
              where
                ts = getNth tys_s n
@@ -1766,7 +1766,7 @@ lintCoercion co@(AxiomInstCo con ind cos)
                         , cab_roles = roles
                         , cab_lhs   = lhs
                         , cab_rhs   = rhs } = coAxiomNthBranch con ind
-       ; unless (length ktvs + length cvs == length cos) $
+       ; unless (cos `equalLength` (ktvs ++ cvs)) $
            bad_ax (text "lengths")
        ; subst <- getTCvSubst
        ; let empty_subst = zapTCvSubst subst
diff --git a/compiler/coreSyn/CoreUnfold.hs b/compiler/coreSyn/CoreUnfold.hs
index 811ddad00e..cedc78fcfa 100644
--- a/compiler/coreSyn/CoreUnfold.hs
+++ b/compiler/coreSyn/CoreUnfold.hs
@@ -578,7 +578,7 @@ sizeExpr dflags bOMB_OUT_SIZE top_args expr
                                 foldr (addAltSize . size_up_alt) case_size alts
       where
           case_size
-           | is_inline_scrut e, not (lengthExceeds alts 1)  = sizeN (-10)
+           | is_inline_scrut e, lengthAtMost alts 1 = sizeN (-10)
            | otherwise = sizeZero
                 -- Normally we don't charge for the case itself, but
                 -- we charge one per alternative (see size_up_alt,
@@ -593,7 +593,7 @@ sizeExpr dflags bOMB_OUT_SIZE top_args expr
                 --      case touch# x# of _ -> ...  should cost 0
                 -- (see #4978)
                 --
-                -- I would like to not have the "not (lengthExceeds alts 1)"
+                -- I would like to not have the "lengthAtMost alts 1"
                 -- condition above, but without that some programs got worse
                 -- (spectral/hartel/event and spectral/para).  I don't fully
                 -- understand why. (SDM 24/5/11)
diff --git a/compiler/coreSyn/CoreUtils.hs b/compiler/coreSyn/CoreUtils.hs
index cc2d1724a5..b8399237da 100644
--- a/compiler/coreSyn/CoreUtils.hs
+++ b/compiler/coreSyn/CoreUtils.hs
@@ -1391,7 +1391,7 @@ altsAreExhaustive ((con1,_,_) : alts)
   = case con1 of
       DEFAULT   -> True
       LitAlt {} -> False
-      DataAlt c -> 1 + length alts == tyConFamilySize (dataConTyCon c)
+      DataAlt c -> alts `lengthIs` (tyConFamilySize (dataConTyCon c) - 1)
       -- It is possible to have an exhaustive case that does not
       -- enumerate all constructors, notably in a GADT match, but
       -- we behave conservatively here -- I don't think it's important
@@ -1783,7 +1783,7 @@ eqExpr in_scope e1 e2
       && go (rnBndr2 env v1 v2) e1 e2
 
     go env (Let (Rec ps1) e1) (Let (Rec ps2) e2)
-      = length ps1 == length ps2
+      = equalLength ps1 ps2
       && all2 (go env') rs1 rs2 && go env' e1 e2
       where
         (bs1,rs1) = unzip ps1
@@ -1838,7 +1838,7 @@ diffExpr top env (Let bs1 e1) (Let bs2 e2)
   = let (ds, env') = diffBinds top env (flattenBinds [bs1]) (flattenBinds [bs2])
     in ds ++ diffExpr top env' e1 e2
 diffExpr top env (Case e1 b1 t1 a1) (Case e2 b2 t2 a2)
-  | length a1 == length a2 && not (null a1) || eqTypeX env t1 t2
+  | equalLength a1 a2 && not (null a1) || eqTypeX env t1 t2
     -- See Note [Empty case alternatives] in TrieMap
   = diffExpr top env e1 e2 ++ concat (zipWith diffAlt a1 a2)
   where env' = rnBndr2 env b1 b2
@@ -1933,7 +1933,7 @@ diffUnfold _   BootUnfolding  BootUnfolding               = []
 diffUnfold _   (OtherCon cs1) (OtherCon cs2) | cs1 == cs2 = []
 diffUnfold env (DFunUnfolding bs1 c1 a1)
                (DFunUnfolding bs2 c2 a2)
-  | c1 == c2 && length bs1 == length bs2
+  | c1 == c2 && equalLength bs1 bs2
   = concatMap (uncurry (diffExpr False env')) (zip a1 a2)
   where env' = rnBndrs2 env bs1 bs2
 diffUnfold env (CoreUnfolding t1 _ _ v1 cl1 wf1 x1 g1)
diff --git a/compiler/coreSyn/TrieMap.hs b/compiler/coreSyn/TrieMap.hs
index 9058d03b57..a6b9db46cb 100644
--- a/compiler/coreSyn/TrieMap.hs
+++ b/compiler/coreSyn/TrieMap.hs
@@ -41,6 +41,7 @@ import Var
 import UniqDFM
 import Unique( Unique )
 import FastString(FastString)
+import Util
 
 import qualified Data.Map    as Map
 import qualified Data.IntMap as IntMap
@@ -526,7 +527,7 @@ instance Eq (DeBruijn CoreExpr) where
       && D (extendCME env1 v1) e1 == D (extendCME env2 v2) e2
 
     go (Let (Rec ps1) e1) (Let (Rec ps2) e2)
-      = length ps1 == length ps2
+      = equalLength ps1 ps2
       && D env1' rs1 == D env2' rs2
       && D env1' e1  == D env2' e2
       where
diff --git a/compiler/deSugar/Check.hs b/compiler/deSugar/Check.hs
index 4b01aac323..8234cccb5c 100644
--- a/compiler/deSugar/Check.hs
+++ b/compiler/deSugar/Check.hs
@@ -112,13 +112,9 @@ getResult ls = do
       | null us && null rs && null is = old
       | otherwise =
         let PmResult prov' rs' (UncoveredPatterns us') is' = new
-            lr  = length rs
-            lr' = length rs'
-            li  = length is
-            li' = length is'
-        in case compare (length us) (length us')
-                `mappend` (compare li li')
-                `mappend` (compare lr lr')
+        in case compareLength us us'
+                `mappend` (compareLength is is')
+                `mappend` (compareLength rs rs')
                 `mappend` (compare prov prov') of
               GT  -> Just new
               EQ  -> Just new
@@ -709,7 +705,7 @@ translateConPatVec fam_insts  univ_tys  ex_tvs c (RecCon (HsRecFields fs _))
     -- Generate a simple constructor pattern and make up fresh variables for
     -- the rest of the fields
   | matched_lbls `subsetOf` orig_lbls
-  = ASSERT(length orig_lbls == length arg_tys)
+  = ASSERT(orig_lbls `equalLength` arg_tys)
       let translateOne (lbl, ty) = case lookup lbl matched_pats of
             Just p  -> translatePat fam_insts p
             Nothing -> mkPmVars [ty]
diff --git a/compiler/deSugar/Coverage.hs b/compiler/deSugar/Coverage.hs
index 24213330ef..92002bf793 100644
--- a/compiler/deSugar/Coverage.hs
+++ b/compiler/deSugar/Coverage.hs
@@ -187,7 +187,7 @@ writeMixEntries dflags mod count entries filename
         modTime <- getModificationUTCTime filename
         let entries' = [ (hpcPos, box)
                        | (span,_,_,box) <- entries, hpcPos <- [mkHpcPos span] ]
-        when (length entries' /= count) $ do
+        when (entries' `lengthIsNot` count) $ do
           panic "the number of .mix entries are inconsistent"
         let hashNo = mixHash filename modTime tabStop entries'
         mixCreate hpc_mod_dir mod_name
diff --git a/compiler/deSugar/DsExpr.hs b/compiler/deSugar/DsExpr.hs
index 2a41ede6c9..cfd9996f1a 100644
--- a/compiler/deSugar/DsExpr.hs
+++ b/compiler/deSugar/DsExpr.hs
@@ -853,9 +853,9 @@ dsExplicitList :: Type -> Maybe (SyntaxExpr Id) -> [LHsExpr Id]
 dsExplicitList elt_ty Nothing xs
   = do { dflags <- getDynFlags
        ; xs' <- mapM dsLExprNoLP xs
-       ; if length xs' > maxBuildLength
+       ; if xs' `lengthExceeds` maxBuildLength
                 -- Don't generate builds if the list is very long.
-         || length xs' == 0
+         || null xs'
                 -- Don't generate builds when the [] constructor will do
          || not (gopt Opt_EnableRewriteRules dflags)  -- Rewrite rules off
                 -- Don't generate a build if there are no rules to eliminate it!
diff --git a/compiler/deSugar/MatchCon.hs b/compiler/deSugar/MatchCon.hs
index 0e1aa802e9..47d1276ba6 100644
--- a/compiler/deSugar/MatchCon.hs
+++ b/compiler/deSugar/MatchCon.hs
@@ -177,7 +177,7 @@ matchOneConLike vars ty (eqn1 : eqns)   -- All eqns for a single constructor
       | RecCon flds <- arg_pats
       , let rpats = rec_flds flds
       , not (null rpats)     -- Treated specially; cf conArgPats
-      = ASSERT2( length fields1 == length arg_vars,
+      = ASSERT2( fields1 `equalLength` arg_vars,
                  ppr con1 $$ ppr fields1 $$ ppr arg_vars )
         map lookup_fld rpats
       | otherwise
diff --git a/compiler/ghci/ByteCodeGen.hs b/compiler/ghci/ByteCodeGen.hs
index 0033df1cea..7ad51a7138 100644
--- a/compiler/ghci/ByteCodeGen.hs
+++ b/compiler/ghci/ByteCodeGen.hs
@@ -600,7 +600,7 @@ schemeE d s p (AnnCase scrut bndr _ [(DataAlt dc, [bind1, bind2], rhs)])
 
 schemeE d s p (AnnCase scrut bndr _ [(DataAlt dc, [bind1], rhs)])
    | isUnboxedTupleCon dc
-   , length (typePrimRep (idType bndr)) <= 1 -- handles unit tuples
+   , typePrimRep (idType bndr) `lengthAtMost` 1 -- handles unit tuples
    = doCase d s p scrut bind1 [(DEFAULT, [], rhs)] (Just bndr)
 
 schemeE d s p (AnnCase scrut bndr _ alt@[(DEFAULT, [], _)])
@@ -729,7 +729,7 @@ mkConAppCode _ _ _ con []       -- Nullary constructor
         -- copy of this constructor, use the single shared version.
 
 mkConAppCode orig_d _ p con args_r_to_l
-  = ASSERT( dataConRepArity con == length args_r_to_l )
+  = ASSERT( args_r_to_l `lengthIs` dataConRepArity con )
     do_pushery orig_d (non_ptr_args ++ ptr_args)
  where
         -- The args are already in reverse order, which is the way PACK
diff --git a/compiler/ghci/DebuggerUtils.hs b/compiler/ghci/DebuggerUtils.hs
index 096b809c26..9e3d56e0d1 100644
--- a/compiler/ghci/DebuggerUtils.hs
+++ b/compiler/ghci/DebuggerUtils.hs
@@ -110,14 +110,14 @@ dataConInfoPtrToName x = do
    -- Warning: this code assumes that the string is well formed.
    parse :: [Word8] -> ([Word8], [Word8], [Word8])
    parse input
-      = ASSERT(all (>0) (map length [pkg, mod, occ])) (pkg, mod, occ)
+      = ASSERT(all (`lengthExceeds` 0) ([pkg, mod, occ])) (pkg, mod, occ)
       where
       dot = fromIntegral (ord '.')
       (pkg, rest1) = break (== fromIntegral (ord ':')) input
       (mod, occ)
          = (concat $ intersperse [dot] $ reverse modWords, occWord)
          where
-         (modWords, occWord) = ASSERT(length rest1 > 0) (parseModOcc [] (tail rest1))
+         (modWords, occWord) = ASSERT(rest1 `lengthExceeds` 0) (parseModOcc [] (tail rest1))
       parseModOcc :: [[Word8]] -> [Word8] -> ([[Word8]], [Word8])
       -- We only look for dots if str could start with a module name,
       -- i.e. if it starts with an upper case character.
diff --git a/compiler/hsSyn/Convert.hs b/compiler/hsSyn/Convert.hs
index 5f67515c71..e64c4eaed5 100644
--- a/compiler/hsSyn/Convert.hs
+++ b/compiler/hsSyn/Convert.hs
@@ -1183,7 +1183,7 @@ cvtTypeKind ty_str ty
   = do { (head_ty, tys') <- split_ty_app ty
        ; case head_ty of
            TupleT n
-             | length tys' == n         -- Saturated
+             | tys' `lengthIs` n         -- Saturated
              -> if n==1 then return (head tys') -- Singleton tuples treated
                                                 -- like nothing (ie just parens)
                         else returnL (HsTupleTy HsBoxedOrConstraintTuple tys')
@@ -1193,7 +1193,7 @@ cvtTypeKind ty_str ty
              -> mk_apps (HsTyVar NotPromoted
                                (noLoc (getRdrName (tupleTyCon Boxed n)))) tys'
            UnboxedTupleT n
-             | length tys' == n         -- Saturated
+             | tys' `lengthIs` n         -- Saturated
              -> returnL (HsTupleTy HsUnboxedTuple tys')
              | otherwise
              -> mk_apps (HsTyVar NotPromoted
@@ -1204,7 +1204,7 @@ cvtTypeKind ty_str ty
                    vcat [ text "Illegal sum arity:" <+> text (show n)
                         , nest 2 $
                             text "Sums must have an arity of at least 2" ]
-             | length tys' == n -- Saturated
+             | tys' `lengthIs` n -- Saturated
              -> returnL (HsSumTy tys')
              | otherwise
              -> mk_apps (HsTyVar NotPromoted (noLoc (getRdrName (sumTyCon n))))
diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs
index b56d8d61e0..8b5a6b6af7 100644
--- a/compiler/main/InteractiveEval.hs
+++ b/compiler/main/InteractiveEval.hs
@@ -80,6 +80,7 @@ import RtClosureInspect
 import Outputable
 import FastString
 import Bag
+import Util
 import qualified Lexer (P (..), ParseResult(..), unP, mkPState)
 import qualified Parser (parseStmt, parseModule, parseDeclaration, parseImport)
 
@@ -400,7 +401,7 @@ moveHist fn = do
             history = resumeHistory r
             new_ix = fn ix
         --
-        when (new_ix > length history) $ liftIO $
+        when (history `lengthLessThan` new_ix) $ liftIO $
            throwGhcExceptionIO (ProgramError "no more logged breakpoints")
         when (new_ix < 0) $ liftIO $
            throwGhcExceptionIO (ProgramError "already at the beginning of the history")
diff --git a/compiler/nativeGen/Dwarf/Types.hs b/compiler/nativeGen/Dwarf/Types.hs
index d4d8e2429e..bc278b119e 100644
--- a/compiler/nativeGen/Dwarf/Types.hs
+++ b/compiler/nativeGen/Dwarf/Types.hs
@@ -32,6 +32,7 @@ import Platform
 import Unique
 import Reg
 import SrcLoc
+import Util
 
 import Dwarf.Constants
 
@@ -577,7 +578,7 @@ pprString' str = text "\t.asciz \"" <> str <> char '"'
 pprString :: String -> SDoc
 pprString str
   = pprString' $ hcat $ map escapeChar $
-    if utf8EncodedLength str == length str
+    if str `lengthIs` utf8EncodedLength str
     then str
     else map (chr . fromIntegral) $ bytesFS $ mkFastString str
 
diff --git a/compiler/prelude/PrelInfo.hs b/compiler/prelude/PrelInfo.hs
index 471b61ee09..8e26d80a6a 100644
--- a/compiler/prelude/PrelInfo.hs
+++ b/compiler/prelude/PrelInfo.hs
@@ -170,7 +170,7 @@ knownKeyNamesOkay all_names
   where
     namesEnv      = foldl (\m n -> extendNameEnv_Acc (:) singleton m n n)
                           emptyUFM all_names
-    badNamesEnv   = filterNameEnv (\ns -> length ns > 1) namesEnv
+    badNamesEnv   = filterNameEnv (\ns -> ns `lengthExceeds` 1) namesEnv
     badNamesPairs = nonDetUFMToList badNamesEnv
       -- It's OK to use nonDetUFMToList here because the ordering only affects
       -- the message when we get a panic
diff --git a/compiler/rename/RnPat.hs b/compiler/rename/RnPat.hs
index 7c4663c080..30dd61bece 100644
--- a/compiler/rename/RnPat.hs
+++ b/compiler/rename/RnPat.hs
@@ -625,7 +625,7 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot })
     rn_dotdot (Just {}) Nothing _flds   -- Constructor out of scope
       = return []
     rn_dotdot (Just n) (Just con) flds -- ".." on record construction / pat match
-      = ASSERT( n == length flds )
+      = ASSERT( flds `lengthIs` n )
         do { loc <- getSrcSpanM -- Rather approximate
            ; dd_flag <- xoptM LangExt.RecordWildCards
            ; checkErr dd_flag (needFlagDotDot ctxt)
diff --git a/compiler/simplCore/CallArity.hs b/compiler/simplCore/CallArity.hs
index e23314b569..0cf0c2f44f 100644
--- a/compiler/simplCore/CallArity.hs
+++ b/compiler/simplCore/CallArity.hs
@@ -18,6 +18,7 @@ import CoreArity ( typeArity )
 import CoreUtils ( exprIsCheap, exprIsTrivial )
 import UnVarGraph
 import Demand
+import Util
 
 import Control.Arrow ( first, second )
 
@@ -671,11 +672,11 @@ callArityRecEnv any_boring ae_rhss ae_body
 
     cross_calls
         -- See Note [Taking boring variables into account]
-        | any_boring          = completeGraph (domRes ae_combined)
+        | any_boring               = completeGraph (domRes ae_combined)
         -- Also, calculating cross_calls is expensive. Simply be conservative
         -- if the mutually recursive group becomes too large.
-        | length ae_rhss > 25 = completeGraph (domRes ae_combined)
-        | otherwise           = unionUnVarGraphs $ map cross_call ae_rhss
+        | lengthExceeds ae_rhss 25 = completeGraph (domRes ae_combined)
+        | otherwise                = unionUnVarGraphs $ map cross_call ae_rhss
     cross_call (v, ae_rhs) = completeBipartiteGraph called_by_v called_with_v
       where
         is_thunk = idCallArity v == 0
diff --git a/compiler/simplCore/FloatIn.hs b/compiler/simplCore/FloatIn.hs
index 02a7f741c5..3e44e81cea 100644
--- a/compiler/simplCore/FloatIn.hs
+++ b/compiler/simplCore/FloatIn.hs
@@ -665,7 +665,7 @@ sepBindsByDropPoint dflags is_case drop_pts floaters
   = [] : [[] | _ <- drop_pts]
 
   | otherwise
-  = ASSERT( length drop_pts >= 2 )
+  = ASSERT( drop_pts `lengthAtLeast` 2 )
     go floaters (map (\fvs -> (fvs, [])) (emptyDVarSet : drop_pts))
   where
     n_alts = length drop_pts
diff --git a/compiler/simplCore/OccurAnal.hs b/compiler/simplCore/OccurAnal.hs
index 98c81ce026..5dd30aa668 100644
--- a/compiler/simplCore/OccurAnal.hs
+++ b/compiler/simplCore/OccurAnal.hs
@@ -2572,7 +2572,7 @@ adjustRhsUsage mb_join_arity rec_flag bndrs usage
                  Nothing            -> all isOneShotBndr bndrs
 
     exact_join = case mb_join_arity of
-                   Just join_arity -> join_arity == length bndrs
+                   Just join_arity -> bndrs `lengthIs` join_arity
                    _               -> False
 
 type IdWithOccInfo = Id
@@ -2718,7 +2718,7 @@ decideJoinPointHood NotTopLevel usage bndrs
 
     ok_rule _ BuiltinRule{} = False -- only possible with plugin shenanigans
     ok_rule join_arity (Rule { ru_args = args })
-      = length args == join_arity
+      = args `lengthIs` join_arity
         -- Invariant 1 as applied to LHSes of rules
 
 willBeJoinId_maybe :: CoreBndr -> Maybe JoinArity
diff --git a/compiler/simplStg/RepType.hs b/compiler/simplStg/RepType.hs
index 91e4285341..2acc815125 100644
--- a/compiler/simplStg/RepType.hs
+++ b/compiler/simplStg/RepType.hs
@@ -155,7 +155,7 @@ ubxSumRepType constrs0
   -- has at least two disjuncts. But it could happen if a user writes, e.g.,
   -- forall (a :: TYPE (SumRep [IntRep])). ...
   -- which could never be instantiated. We still don't want to panic.
-  | length constrs0 < 2
+  | constrs0 `lengthLessThan` 2
   = [WordSlot]
 
   | otherwise
diff --git a/compiler/simplStg/UnariseStg.hs b/compiler/simplStg/UnariseStg.hs
index 3f67bc278f..2e8fbda02b 100644
--- a/compiler/simplStg/UnariseStg.hs
+++ b/compiler/simplStg/UnariseStg.hs
@@ -420,7 +420,7 @@ unariseAlts rho (MultiValAlt n) bndr [(DEFAULT, [], e)]
 unariseAlts rho (MultiValAlt n) bndr [(DataAlt _, ys, e)]
   | isUnboxedTupleBndr bndr
   = do (rho', ys1) <- unariseConArgBinders rho ys
-       MASSERT(n == length ys1)
+       MASSERT(ys1 `lengthIs` n)
        let rho'' = extendRho rho' bndr (MultiVal (map StgVarArg ys1))
        e' <- unariseExpr rho'' e
        return [(DataAlt (tupleDataCon Unboxed n), ys1, e')]
diff --git a/compiler/specialise/SpecConstr.hs b/compiler/specialise/SpecConstr.hs
index 39ec7e6946..e5af0b8a3c 100644
--- a/compiler/specialise/SpecConstr.hs
+++ b/compiler/specialise/SpecConstr.hs
@@ -1984,7 +1984,7 @@ callToPats :: ScEnv -> [ArgOcc] -> Call -> UniqSM (Maybe CallPat)
         --      over the following term variables
         -- The [CoreExpr] are the argument patterns for the rule
 callToPats env bndr_occs (Call _ args con_env)
-  | length args < length bndr_occs      -- Check saturated
+  | args `ltLength` bndr_occs      -- Check saturated
   = return Nothing
   | otherwise
   = do  { let in_scope      = substInScope (sc_subst env)
diff --git a/compiler/stgSyn/StgLint.hs b/compiler/stgSyn/StgLint.hs
index 02d989cec0..7a1ed4df92 100644
--- a/compiler/stgSyn/StgLint.hs
+++ b/compiler/stgSyn/StgLint.hs
@@ -249,7 +249,7 @@ lintAlt scrut_ty (DataAlt con, args, rhs) = do
                 -- This does not work for existential constructors
 
          checkL (con `elem` cons) (mkAlgAltMsg2 scrut_ty con)
-         checkL (length args == dataConRepArity con) (mkAlgAltMsg3 con args)
+         checkL (args `lengthIs` dataConRepArity con) (mkAlgAltMsg3 con args)
          when (isVanillaDataCon con) $
            mapM_ check (zipEqual "lintAlgAlt:stg" arg_tys args)
          return ()
@@ -398,7 +398,7 @@ checkFunApp fun_ty arg_tys msg
 
       | Just (tc,tc_args) <- splitTyConApp_maybe fun_ty
       , isNewTyCon tc
-      = if length tc_args < tyConArity tc
+      = if tc_args `lengthLessThan` tyConArity tc
         then WARN( True, text "cfa: unsaturated newtype" <+> ppr fun_ty $$ msg )
              (Nothing, Nothing)   -- This is odd, but I've seen it
         else cfa False (newTyConInstRhs tc tc_args) arg_tys
diff --git a/compiler/typecheck/FamInst.hs b/compiler/typecheck/FamInst.hs
index f69e41209f..cabfb3376b 100644
--- a/compiler/typecheck/FamInst.hs
+++ b/compiler/typecheck/FamInst.hs
@@ -789,7 +789,7 @@ isTFHeaded ty | Just ty' <- coreView ty
               = isTFHeaded ty'
 isTFHeaded ty | (TyConApp tc args) <- ty
               , isTypeFamilyTyCon tc
-              = tyConArity tc == length args
+              = args `lengthIs` tyConArity tc
 isTFHeaded _  = False
 
 
diff --git a/compiler/typecheck/FunDeps.hs b/compiler/typecheck/FunDeps.hs
index fff8979e0d..789254d230 100644
--- a/compiler/typecheck/FunDeps.hs
+++ b/compiler/typecheck/FunDeps.hs
@@ -255,8 +255,8 @@ improveClsFD clas_tvs fd
   = []          -- Filter out ones that can't possibly match,
 
   | otherwise
-  = ASSERT2( length tys_inst == length tys_actual     &&
-             length tys_inst == length clas_tvs
+  = ASSERT2( equalLength tys_inst tys_actual &&
+             equalLength tys_inst clas_tvs
             , ppr tys_inst <+> ppr tys_actual )
 
     case tcMatchTyKis ltys1 ltys2 of
diff --git a/compiler/typecheck/TcCanonical.hs b/compiler/typecheck/TcCanonical.hs
index 77bf63d98e..ff00d4220b 100644
--- a/compiler/typecheck/TcCanonical.hs
+++ b/compiler/typecheck/TcCanonical.hs
@@ -917,7 +917,7 @@ canTyConApp :: CtEvidence -> EqRel
 -- See Note [Decomposing TyConApps]
 canTyConApp ev eq_rel tc1 tys1 tc2 tys2
   | tc1 == tc2
-  , length tys1 == length tys2
+  , tys1 `equalLength` tys2
   = do { inerts <- getTcSInerts
        ; if can_decompose inerts
          then do { traceTcS "canTyConApp"
diff --git a/compiler/typecheck/TcDeriv.hs b/compiler/typecheck/TcDeriv.hs
index 8076115b6c..5bdfae70ac 100644
--- a/compiler/typecheck/TcDeriv.hs
+++ b/compiler/typecheck/TcDeriv.hs
@@ -613,7 +613,7 @@ deriveTyData tvs tc tc_args deriv_strat deriv_pred
                 -- Typeable is special, because Typeable :: forall k. k -> Constraint
                 -- so the argument kind 'k' is not decomposable by splitKindFunTys
                 -- as is the case for all other derivable type classes
-        ; when (length cls_arg_kinds /= 1) $
+        ; when (cls_arg_kinds `lengthIsNot` 1) $
             failWithTc (nonUnaryErr deriv_pred)
         ; let [cls_arg_kind] = cls_arg_kinds
         ; if className cls == typeableClassName
@@ -1101,7 +1101,7 @@ mkNewTypeEqn dflags overlap_mode tvs
              cls cls_tys tycon tc_args rep_tycon rep_tc_args
              mtheta deriv_strat
 -- Want: instance (...) => cls (cls_tys ++ [tycon tc_args]) where ...
-  = ASSERT( length cls_tys + 1 == classArity cls )
+  = ASSERT( cls_tys `lengthIs` (classArity cls - 1) )
     case deriv_strat of
       Just StockStrategy    -> mk_eqn_stock dflags mtheta cls cls_tys rep_tycon
                                  go_for_it_other bale_out
@@ -1302,7 +1302,7 @@ mkNewTypeEqn dflags overlap_mode tvs
            && isNothing at_without_last_cls_tv
 
         -- Check that eta reduction is OK
-        eta_ok = nt_eta_arity <= length rep_tc_args
+        eta_ok = rep_tc_args `lengthAtLeast` nt_eta_arity
                 -- The newtype can be eta-reduced to match the number
                 --     of type argument actually supplied
                 --        newtype T a b = MkT (S [a] b) deriving( Monad )
diff --git a/compiler/typecheck/TcDerivInfer.hs b/compiler/typecheck/TcDerivInfer.hs
index 93dcf4383c..02c0103eec 100644
--- a/compiler/typecheck/TcDerivInfer.hs
+++ b/compiler/typecheck/TcDerivInfer.hs
@@ -67,12 +67,12 @@ inferConstraints :: [TyVar] -> Class -> [TcType] -> TcType
 inferConstraints tvs main_cls cls_tys inst_ty
                  rep_tc rep_tc_args
                  mechanism
-  | is_generic && not is_anyclass     -- Generic constraints are easy
+  | is_generic && not is_anyclass          -- Generic constraints are easy
   = return ([], tvs, inst_tys)
 
-  | is_generic1 && not is_anyclass    -- Generic1 needs Functor
-  = ASSERT( length rep_tc_tvs > 0 )   -- See Note [Getting base classes]
-    ASSERT( length cls_tys   == 1 )   -- Generic1 has a single kind variable
+  | is_generic1 && not is_anyclass         -- Generic1 needs Functor
+  = ASSERT( rep_tc_tvs `lengthExceeds` 0 ) -- See Note [Getting base classes]
+    ASSERT( cls_tys `lengthIs` 1 )         -- Generic1 has a single kind variable
     do { functorClass <- tcLookupClass functorClassName
        ; con_arg_constraints (get_gen1_constraints functorClass) }
 
diff --git a/compiler/typecheck/TcErrors.hs b/compiler/typecheck/TcErrors.hs
index 324391f68b..4411d6ac51 100644
--- a/compiler/typecheck/TcErrors.hs
+++ b/compiler/typecheck/TcErrors.hs
@@ -1548,7 +1548,7 @@ mkCoercibleExplanation rdr_env fam_envs ty1 ty2
 
     has_unknown_roles ty
       | Just (tc, tys) <- tcSplitTyConApp_maybe ty
-      = length tys >= tyConArity tc  -- oversaturated tycon
+      = tys `lengthAtLeast` tyConArity tc  -- oversaturated tycon
       | Just (s, _) <- tcSplitAppTy_maybe ty
       = has_unknown_roles s
       | isTyVarTy ty
@@ -2503,7 +2503,7 @@ mk_dict_err ctxt@(CEC {cec_encl = implics}) (ct, (matches, unifiers, unsafe_over
     -- Overlap error because of Safe Haskell (first
     -- match should be the most specific match)
     safe_haskell_msg
-     = ASSERT( length matches == 1 && not (null unsafe_ispecs) )
+     = ASSERT( matches `lengthIs` 1 && not (null unsafe_ispecs) )
        vcat [ addArising orig (text "Unsafe overlapping instances for"
                        <+> pprType (mkClassPred clas tys))
             , sep [text "The matching instance is:",
@@ -2706,7 +2706,7 @@ pprPotentials dflags sty herald insts
                      <+> text "involving out-of-scope types")
            2 (ppWhen show_potentials (pprInstances not_in_scope))
 
-    flag_hint = ppUnless (show_potentials || length show_these == length insts) $
+    flag_hint = ppUnless (show_potentials || equalLength show_these insts) $
                 text "(use -fprint-potential-instances to see them all)"
 
 {- Note [Displaying potential instances]
diff --git a/compiler/typecheck/TcFlatten.hs b/compiler/typecheck/TcFlatten.hs
index 650cbd8219..1bb4a7165b 100644
--- a/compiler/typecheck/TcFlatten.hs
+++ b/compiler/typecheck/TcFlatten.hs
@@ -1132,7 +1132,7 @@ flatten_fam_app :: TyCon -> [TcType] -> FlatM (Xi, Coercion)
   --   flatten_exact_fam_app_fully lifts out the application to top level
   -- Postcondition: Coercion :: Xi ~ F tys
 flatten_fam_app tc tys  -- Can be over-saturated
-    = ASSERT2( tyConArity tc <= length tys
+    = ASSERT2( tys `lengthAtLeast` tyConArity tc
              , ppr tc $$ ppr (tyConArity tc) $$ ppr tys)
                  -- Type functions are saturated
                  -- The type function might be *over* saturated
diff --git a/compiler/typecheck/TcGenDeriv.hs b/compiler/typecheck/TcGenDeriv.hs
index d8fb62044b..d46b67c248 100644
--- a/compiler/typecheck/TcGenDeriv.hs
+++ b/compiler/typecheck/TcGenDeriv.hs
@@ -381,7 +381,7 @@ gen_Ord_binds loc tycon = do
 
     mkOrdOpRhs :: DynFlags -> OrdOp -> LHsExpr RdrName
     mkOrdOpRhs dflags op       -- RHS for comparing 'a' and 'b' according to op
-      | length nullary_cons <= 2  -- Two nullary or fewer, so use cases
+      | nullary_cons `lengthAtMost` 2 -- Two nullary or fewer, so use cases
       = nlHsCase (nlHsVar a_RDR) $
         map (mkOrdOpAlt dflags op) tycon_data_cons
         -- i.e.  case a of { C1 x y -> case b of C1 x y -> ....compare x,y...
@@ -1027,7 +1027,7 @@ gen_Read_binds get_fixity loc tycon
         labels       = map flLabel $ dataConFieldLabels data_con
         dc_nm        = getName data_con
         is_infix     = dataConIsInfix data_con
-        is_record    = length labels > 0
+        is_record    = labels `lengthExceeds` 0
         as_needed    = take con_arity as_RDRs
         read_args    = zipWithEqual "gen_Read_binds" read_arg as_needed (dataConOrigArgTys data_con)
         (read_a1:read_a2:_) = read_args
diff --git a/compiler/typecheck/TcGenGenerics.hs b/compiler/typecheck/TcGenGenerics.hs
index 51451a6d1a..fc0209d805 100644
--- a/compiler/typecheck/TcGenGenerics.hs
+++ b/compiler/typecheck/TcGenGenerics.hs
@@ -348,7 +348,7 @@ mkBindsRep gk tycon =
         (from_alts, to_alts) = mkSum gk_ (1 :: US) datacons
           where gk_ = case gk of
                   Gen0 -> Gen0_
-                  Gen1 -> ASSERT(length tyvars >= 1)
+                  Gen1 -> ASSERT(tyvars `lengthAtLeast` 1)
                           Gen1_ (last tyvars)
                     where tyvars = tyConTyVars tycon
 
@@ -572,7 +572,7 @@ tc_mkRepTy gk_ tycon k =
         prod :: [Type] -> [HsSrcBang] -> [HsImplBang] -> [FieldLabel] -> Type
         prod [] _  _  _  = mkTyConApp u1 [k]
         prod l  sb ib fl = foldBal mkProd
-                                   [ ASSERT(null fl || length fl > j)
+                                   [ ASSERT(null fl || lengthExceeds fl j)
                                      arg t sb' ib' (if null fl
                                                        then Nothing
                                                        else Just (fl !! j))
@@ -617,7 +617,7 @@ tc_mkRepTy gk_ tycon k =
         buildFix n assoc = mkTyConApp pInfix [ mkTyConTy assoc
                                              , mkNumLitTy (fromIntegral n)]
 
-        isRec c = mkTyConTy $ if length (dataConFieldLabels c) > 0
+        isRec c = mkTyConTy $ if dataConFieldLabels c `lengthExceeds` 0
                               then promotedTrueDataCon
                               else promotedFalseDataCon
 
diff --git a/compiler/typecheck/TcPat.hs b/compiler/typecheck/TcPat.hs
index 486210cb07..07f945ccf3 100644
--- a/compiler/typecheck/TcPat.hs
+++ b/compiler/typecheck/TcPat.hs
@@ -468,7 +468,7 @@ tc_pat penv (TuplePat pats boxity _) pat_ty thing_inside
                 | otherwise                 = unmangled_result
 
         ; pat_ty <- readExpType pat_ty
-        ; ASSERT( length con_arg_tys == length pats ) -- Syntactically enforced
+        ; ASSERT( con_arg_tys `equalLength` pats ) -- Syntactically enforced
           return (mkHsWrapPat coi possibly_mangled_result pat_ty, res)
         }
 
diff --git a/compiler/typecheck/TcSplice.hs b/compiler/typecheck/TcSplice.hs
index 962ad2e0e0..b989aa18d6 100644
--- a/compiler/typecheck/TcSplice.hs
+++ b/compiler/typecheck/TcSplice.hs
@@ -1468,7 +1468,7 @@ reifyDataCon isGadtDataCon tys dc
                 -- constructors can be declared infix.
                 -- See Note [Infix GADT constructors] in TcTyClsDecls.
               | dataConIsInfix dc && not isGadtDataCon ->
-                  ASSERT( length arg_tys == 2 ) do
+                  ASSERT( arg_tys `lengthIs` 2 ) do
                   { let [r_a1, r_a2] = r_arg_tys
                         [s1,   s2]   = dcdBangs
                   ; return $ TH.InfixC (s1,r_a1) name (s2,r_a2) }
@@ -1486,7 +1486,7 @@ reifyDataCon isGadtDataCon tys dc
                          { cxt <- reifyCxt theta'
                          ; ex_tvs'' <- reifyTyVars ex_tvs' Nothing
                          ; return (TH.ForallC ex_tvs'' cxt main_con) }
-       ; ASSERT( length arg_tys == length dcdBangs )
+       ; ASSERT( arg_tys `equalLength` dcdBangs )
          ret_con }
 
 -- Note [Reifying GADT data constructors]
diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs
index cb46c69832..6076c75f30 100644
--- a/compiler/typecheck/TcTyClsDecls.hs
+++ b/compiler/typecheck/TcTyClsDecls.hs
@@ -1087,7 +1087,7 @@ tcDefaultAssocDecl fam_tc [L loc (TyFamEqn { tfe_tycon = L _ tc_name
          checkTc (isTypeFamilyTyCon fam_tc) (wrongKindOfFamily fam_tc)
 
        -- Arity check
-       ; checkTc (length exp_vars == fam_arity)
+       ; checkTc (exp_vars `lengthIs` fam_arity)
                  (wrongNumberOfParmsErr fam_arity)
 
        -- Typecheck RHS
@@ -2295,7 +2295,7 @@ checkValidTyConTyVars tc
                          2 (vcat (map pp_tv stripped_tvs)) ])) }
   where
     tvs = tyConTyVars tc
-    duplicate_vars = sizeVarSet (mkVarSet tvs) < length tvs
+    duplicate_vars = tvs `lengthExceeds` sizeVarSet (mkVarSet tvs)
 
     pp_tv tv = ppr tv <+> dcolon <+> ppr (tyVarKind tv)
 
diff --git a/compiler/typecheck/TcUnify.hs b/compiler/typecheck/TcUnify.hs
index f106268455..a1a2add2b7 100644
--- a/compiler/typecheck/TcUnify.hs
+++ b/compiler/typecheck/TcUnify.hs
@@ -1329,7 +1329,7 @@ uType origin t_or_k orig_ty1 orig_ty2
 
     go (TyConApp tc1 tys1) (TyConApp tc2 tys2)
       -- See Note [Mismatched type lists and application decomposition]
-      | tc1 == tc2, length tys1 == length tys2
+      | tc1 == tc2, equalLength tys1 tys2
       = ASSERT2( isGenerativeTyCon tc1 Nominal, ppr tc1 )
         do { cos <- zipWithM (uType origin t_or_k) tys1 tys2
            ; return $ mkTyConAppCo Nominal tc1 cos }
diff --git a/compiler/typecheck/TcValidity.hs b/compiler/typecheck/TcValidity.hs
index 0a7a0adf7f..a938d12a08 100644
--- a/compiler/typecheck/TcValidity.hs
+++ b/compiler/typecheck/TcValidity.hs
@@ -504,7 +504,7 @@ check_syn_tc_app :: TidyEnv -> UserTypeCtxt -> Rank -> KindOrType
 -- which must be saturated,
 -- but not data families, which need not be saturated
 check_syn_tc_app env ctxt rank ty tc tys
-  | tc_arity <= length tys   -- Saturated
+  | tys `lengthAtLeast` tc_arity   -- Saturated
        -- Check that the synonym has enough args
        -- This applies equally to open and closed synonyms
        -- It's OK to have an *over-applied* type synonym
@@ -739,7 +739,7 @@ check_eq_pred :: TidyEnv -> DynFlags -> PredType -> TyCon -> [TcType] -> TcM ()
 check_eq_pred env dflags pred tc tys
   =         -- Equational constraints are valid in all contexts if type
             -- families are permitted
-    do { checkTc (length tys == tyConArity tc) (tyConArityErr tc tys)
+    do { checkTc (tys `lengthIs` tyConArity tc) (tyConArityErr tc tys)
        ; checkTcM (xopt LangExt.TypeFamilies dflags
                    || xopt LangExt.GADTs dflags)
                   (eqPredTyErr env pred) }
@@ -814,7 +814,7 @@ check_class_pred env dflags ctxt pred cls tys
        ; when warn_simp check_simplifiable_class_constraint
        ; checkTcM arg_tys_ok (predTyVarErr env pred) }
   where
-    check_arity = checkTc (classArity cls == length tys)
+    check_arity = checkTc (tys `lengthIs` classArity cls)
                           (tyConArityErr (classTyCon cls) tys)
 
     -- Check the arguments of a class constraint
@@ -1047,7 +1047,7 @@ checkValidInstHead ctxt clas cls_args
                        all tcInstHeadTyAppAllTyVars ty_args)
                  (instTypeErr clas cls_args head_type_args_tyvars_msg)
             ; checkTc (xopt LangExt.MultiParamTypeClasses dflags ||
-                       length ty_args == 1 ||  -- Only count type arguments
+                       lengthIs ty_args 1 ||  -- Only count type arguments
                        (xopt LangExt.NullaryTypeClasses dflags &&
                         null ty_args))
                  (instTypeErr clas cls_args head_one_type_msg) }
@@ -1239,7 +1239,7 @@ validDerivPred tv_set pred
     check_tys cls tys
               = hasNoDups fvs
                    -- use sizePred to ignore implicit args
-                && sizePred pred == fromIntegral (length fvs)
+                && lengthIs fvs (sizePred pred)
                 && all (`elemVarSet` tv_set) fvs
       where tys' = filterOutInvisibleTypes (classTyCon cls) tys
             fvs  = fvTypes tys'
@@ -1738,7 +1738,7 @@ checkValidFamPats mb_clsinfo fam_tc tvs cvs ty_pats
          --     type family F a :: * -> *
          --     type instance F Int y = y
          -- because then the type (F Int) would be like (\y.y)
-         checkTc (length ty_pats == fam_arity) $
+         checkTc (ty_pats `lengthIs` fam_arity) $
            wrongNumberOfParmsErr (fam_arity - count isInvisibleTyConBinder fam_bndrs)
              -- report only explicit arguments
 
diff --git a/compiler/types/Class.hs b/compiler/types/Class.hs
index ecc7e2efa2..ae1047ebde 100644
--- a/compiler/types/Class.hs
+++ b/compiler/types/Class.hs
@@ -245,7 +245,7 @@ classSCSelId :: Class -> Int -> Id
 -- where n is 0-indexed, and counts
 --    *all* superclasses including equalities
 classSCSelId (Class { classBody = ConcreteClass { classSCSels = sc_sels } }) n
-  = ASSERT( n >= 0 && n < length sc_sels )
+  = ASSERT( n >= 0 && lengthExceeds sc_sels n )
     sc_sels !! n
 classSCSelId c n = pprPanic "classSCSelId" (ppr c <+> ppr n)
 
diff --git a/compiler/types/Coercion.hs b/compiler/types/Coercion.hs
index e1dcfde811..3f5036c4dd 100644
--- a/compiler/types/Coercion.hs
+++ b/compiler/types/Coercion.hs
@@ -797,7 +797,7 @@ mkAxInstCo role ax index tys cos
 -- worker function; just checks to see if it should produce Refl
 mkAxiomInstCo :: CoAxiom Branched -> BranchIndex -> [Coercion] -> Coercion
 mkAxiomInstCo ax index args
-  = ASSERT( coAxiomArity ax index == length args )
+  = ASSERT( args `lengthIs` coAxiomArity ax index )
     AxiomInstCo ax index args
 
 -- to be used only with unbranched axioms
@@ -1210,7 +1210,7 @@ promoteCoercion co = case co of
 
     NthCo n co1
       | Just (_, args) <- splitTyConAppCo_maybe co1
-      , n < length args
+      , args `lengthExceeds` n
       -> promoteCoercion (args !! n)
 
       | Just _ <- splitForAllCo_maybe co
@@ -1837,7 +1837,7 @@ coercionKind co = go co
     go (TransCo co1 co2)      = Pair (pFst $ go co1) (pSnd $ go co2)
     go g@(NthCo d co)
       | Just argss <- traverse tyConAppArgs_maybe tys
-      = ASSERT( and $ ((d <) . length) <$> argss )
+      = ASSERT( and $ (`lengthExceeds` d) <$> argss )
         (`getNth` d) <$> argss
 
       | d == 0
diff --git a/compiler/types/OptCoercion.hs b/compiler/types/OptCoercion.hs
index 871840ed13..67644094ed 100644
--- a/compiler/types/OptCoercion.hs
+++ b/compiler/types/OptCoercion.hs
@@ -583,13 +583,13 @@ opt_trans_rule is in_co1@(AppCo co1a co1b) in_co2@(AppCo co2a co2b)
 -- Eta rules
 opt_trans_rule is co1@(TyConAppCo r tc cos1) co2
   | Just cos2 <- etaTyConAppCo_maybe tc co2
-  = ASSERT( length cos1 == length cos2 )
+  = ASSERT( cos1 `equalLength` cos2 )
     fireTransRule "EtaCompL" co1 co2 $
     mkTyConAppCo r tc (opt_transList is cos1 cos2)
 
 opt_trans_rule is co1 co2@(TyConAppCo r tc cos2)
   | Just cos1 <- etaTyConAppCo_maybe tc co1
-  = ASSERT( length cos1 == length cos2 )
+  = ASSERT( cos1 `equalLength` cos2 )
     fireTransRule "EtaCompR" co1 co2 $
     mkTyConAppCo r tc (opt_transList is cos1 cos2)
 
@@ -934,7 +934,7 @@ etaTyConAppCo_maybe tc co
   , isInjectiveTyCon tc r  -- See Note [NthCo and newtypes] in TyCoRep
   , let n = length tys1
   = ASSERT( tc == tc1 )
-    ASSERT( n == length tys2 )
+    ASSERT( tys2 `lengthIs` n )
     Just (decomposeCo n co)
     -- NB: n might be <> tyConArity tc
     -- e.g.   data family T a :: * -> *
diff --git a/compiler/types/TyCoRep.hs b/compiler/types/TyCoRep.hs
index 74ebfbeb9a..e6afeceb7f 100644
--- a/compiler/types/TyCoRep.hs
+++ b/compiler/types/TyCoRep.hs
@@ -676,7 +676,7 @@ mkPiTys tbs ty = foldr mkPiTy ty tbs
 isCoercionType :: Type -> Bool
 isCoercionType (TyConApp tc tys)
   | (tc `hasKey` eqPrimTyConKey) || (tc `hasKey` eqReprPrimTyConKey)
-  , length tys == 4
+  , tys `lengthIs` 4
   = True
 isCoercionType _ = False
 
@@ -1897,7 +1897,7 @@ mkTyCoInScopeSet tys cos
 zipTvSubst :: [TyVar] -> [Type] -> TCvSubst
 zipTvSubst tvs tys
   | debugIsOn
-  , not (all isTyVar tvs) || length tvs /= length tys
+  , not (all isTyVar tvs) || neLength tvs tys
   = pprTrace "zipTvSubst" (ppr tvs $$ ppr tys) emptyTCvSubst
   | otherwise
   = mkTvSubst (mkInScopeSet (tyCoVarsOfTypes tys)) tenv
@@ -1909,7 +1909,7 @@ zipTvSubst tvs tys
 zipCvSubst :: [CoVar] -> [Coercion] -> TCvSubst
 zipCvSubst cvs cos
   | debugIsOn
-  , not (all isCoVar cvs) || length cvs /= length cos
+  , not (all isCoVar cvs) || neLength cvs cos
   = pprTrace "zipCvSubst" (ppr cvs $$ ppr cos) emptyTCvSubst
   | otherwise
   = TCvSubst (mkInScopeSet (tyCoVarsOfCos cos)) emptyTvSubstEnv cenv
@@ -2008,7 +2008,7 @@ ForAllCo tv (sym h) (sym g[tv |-> tv |> sym h])
 substTyWith :: HasCallStack => [TyVar] -> [Type] -> Type -> Type
 -- Works only if the domain of the substitution is a
 -- superset of the type being substituted into
-substTyWith tvs tys = ASSERT( length tvs == length tys )
+substTyWith tvs tys = ASSERT( tvs `equalLength` tys )
                       substTy (zipTvSubst tvs tys)
 
 -- | Type substitution, see 'zipTvSubst'. Disables sanity checks.
@@ -2018,7 +2018,7 @@ substTyWith tvs tys = ASSERT( length tvs == length tys )
 -- substTy and remove this function. Please don't use in new code.
 substTyWithUnchecked :: [TyVar] -> [Type] -> Type -> Type
 substTyWithUnchecked tvs tys
-  = ASSERT( length tvs == length tys )
+  = ASSERT( tvs `equalLength` tys )
     substTyUnchecked (zipTvSubst tvs tys)
 
 -- | Substitute tyvars within a type using a known 'InScopeSet'.
@@ -2027,13 +2027,13 @@ substTyWithUnchecked tvs tys
 -- and of 'ty' minus the domain of the subst.
 substTyWithInScope :: InScopeSet -> [TyVar] -> [Type] -> Type -> Type
 substTyWithInScope in_scope tvs tys ty =
-  ASSERT( length tvs == length tys )
+  ASSERT( tvs `equalLength` tys )
   substTy (mkTvSubst in_scope tenv) ty
   where tenv = zipTyEnv tvs tys
 
 -- | Coercion substitution, see 'zipTvSubst'
 substCoWith :: HasCallStack => [TyVar] -> [Type] -> Coercion -> Coercion
-substCoWith tvs tys = ASSERT( length tvs == length tys )
+substCoWith tvs tys = ASSERT( tvs `equalLength` tys )
                       substCo (zipTvSubst tvs tys)
 
 -- | Coercion substitution, see 'zipTvSubst'. Disables sanity checks.
@@ -2043,7 +2043,7 @@ substCoWith tvs tys = ASSERT( length tvs == length tys )
 -- substCo and remove this function. Please don't use in new code.
 substCoWithUnchecked :: [TyVar] -> [Type] -> Coercion -> Coercion
 substCoWithUnchecked tvs tys
-  = ASSERT( length tvs == length tys )
+  = ASSERT( tvs `equalLength` tys )
     substCoUnchecked (zipTvSubst tvs tys)
 
 
@@ -2054,12 +2054,12 @@ substTyWithCoVars cvs cos = substTy (zipCvSubst cvs cos)
 
 -- | Type substitution, see 'zipTvSubst'
 substTysWith :: [TyVar] -> [Type] -> [Type] -> [Type]
-substTysWith tvs tys = ASSERT( length tvs == length tys )
+substTysWith tvs tys = ASSERT( tvs `equalLength` tys )
                        substTys (zipTvSubst tvs tys)
 
 -- | Type substitution, see 'zipTvSubst'
 substTysWithCoVars :: [CoVar] -> [Coercion] -> [Type] -> [Type]
-substTysWithCoVars cvs cos = ASSERT( length cvs == length cos )
+substTysWithCoVars cvs cos = ASSERT( cvs `equalLength` cos )
                              substTys (zipCvSubst cvs cos)
 
 -- | Substitute within a 'Type' after adding the free variables of the type
diff --git a/compiler/types/TyCon.hs b/compiler/types/TyCon.hs
index 9f6486b182..7b433fab9e 100644
--- a/compiler/types/TyCon.hs
+++ b/compiler/types/TyCon.hs
@@ -891,7 +891,7 @@ okParent :: Name -> AlgTyConFlav -> Bool
 okParent _       (VanillaAlgTyCon {})            = True
 okParent _       (UnboxedAlgTyCon {})            = True
 okParent tc_name (ClassTyCon cls _)              = tc_name == tyConName (classTyCon cls)
-okParent _       (DataFamInstTyCon _ fam_tc tys) = tyConArity fam_tc == length tys
+okParent _       (DataFamInstTyCon _ fam_tc tys) = tys `lengthIs` tyConArity fam_tc
 
 isNoParent :: AlgTyConFlav -> Bool
 isNoParent (VanillaAlgTyCon {}) = True
@@ -1734,7 +1734,7 @@ isDataSumTyCon_maybe :: TyCon -> Maybe [DataCon]
 isDataSumTyCon_maybe (AlgTyCon { algTcRhs = rhs })
   = case rhs of
       DataTyCon { data_cons = cons }
-        | length cons > 1
+        | cons `lengthExceeds` 1
         , all (null . dataConExTyVars) cons -- FIXME(osa): Why do we need this?
         -> Just cons
       SumTyCon { data_cons = cons }
@@ -2024,10 +2024,10 @@ expandSynTyCon_maybe
 -- ^ Expand a type synonym application, if any
 expandSynTyCon_maybe tc tys
   | SynonymTyCon { tyConTyVars = tvs, synTcRhs = rhs, tyConArity = arity } <- tc
-  = case arity `compare` length tys of
-        LT -> Just (tvs `zip` tys, rhs, drop arity tys)
+  = case tys `listLengthCmp` arity of
+        GT -> Just (tvs `zip` tys, rhs, drop arity tys)
         EQ -> Just (tvs `zip` tys, rhs, [])
-        GT -> Nothing
+        LT -> Nothing
    | otherwise
    = Nothing
 
diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs
index 65c02ba719..8621e6cd52 100644
--- a/compiler/types/Type.hs
+++ b/compiler/types/Type.hs
@@ -1030,7 +1030,7 @@ applyTysX :: [TyVar] -> Type -> [Type] -> Type
 -- applyTyxX beta-reduces (/\tvs. body_ty) arg_tys
 -- Assumes that (/\tvs. body_ty) is closed
 applyTysX tvs body_ty arg_tys
-  = ASSERT2( length arg_tys >= n_tvs, pp_stuff )
+  = ASSERT2( arg_tys `lengthAtLeast` n_tvs, pp_stuff )
     ASSERT2( tyCoVarsOfType body_ty `subVarSet` mkVarSet tvs, pp_stuff )
     mkAppTys (substTyWith tvs (take n_tvs arg_tys) body_ty)
              (drop n_tvs arg_tys)
@@ -1094,7 +1094,7 @@ tyConAppArgN :: Int -> Type -> Type
 -- Executing Nth
 tyConAppArgN n ty
   = case tyConAppArgs_maybe ty of
-      Just tys -> ASSERT2( n < length tys, ppr n <+> ppr tys ) tys `getNth` n
+      Just tys -> ASSERT2( tys `lengthExceeds` n, ppr n <+> ppr tys ) tys `getNth` n
       Nothing  -> pprPanic "tyConAppArgN" (ppr n <+> ppr ty)
 
 -- | Attempts to tease a type apart into a type constructor and the application
@@ -1587,9 +1587,9 @@ isPredTy ty = go ty []
     go_tc :: TyCon -> [KindOrType] -> Bool
     go_tc tc args
       | tc `hasKey` eqPrimTyConKey || tc `hasKey` eqReprPrimTyConKey
-                  = length args == 4  -- ~# and ~R# sadly have result kind #
-                                      -- not Constraint; but we still want
-                                      -- isPredTy to reply True.
+                  = args `lengthIs` 4  -- ~# and ~R# sadly have result kind #
+                                       -- not Constraint; but we still want
+                                       -- isPredTy to reply True.
       | otherwise = go_k (tyConKind tc) args
 
     go_k :: Kind -> [KindOrType] -> Bool
@@ -1890,7 +1890,7 @@ mkFamilyTyConApp :: TyCon -> [Type] -> Type
 mkFamilyTyConApp tc tys
   | Just (fam_tc, fam_tys) <- tyConFamInst_maybe tc
   , let tvs = tyConTyVars tc
-        fam_subst = ASSERT2( length tvs == length tys, ppr tc <+> ppr tys )
+        fam_subst = ASSERT2( tvs `equalLength` tys, ppr tc <+> ppr tys )
                     zipTvSubst tvs tys
   = mkTyConApp fam_tc (substTys fam_subst fam_tys)
   | otherwise
diff --git a/compiler/utils/ListSetOps.hs b/compiler/utils/ListSetOps.hs
index 88af48e41a..f1aa2c3755 100644
--- a/compiler/utils/ListSetOps.hs
+++ b/compiler/utils/ListSetOps.hs
@@ -46,7 +46,7 @@ getNth xs n = ASSERT2( xs `lengthExceeds` n, ppr n $$ ppr xs )
 unionLists :: (Outputable a, Eq a) => [a] -> [a] -> [a]
 -- Assumes that the arguments contain no duplicates
 unionLists xs ys
-  = WARN(length xs > 100 || length ys > 100, ppr xs $$ ppr ys)
+  = WARN(lengthExceeds xs 100 || lengthExceeds ys 100, ppr xs $$ ppr ys)
     [x | x <- xs, isn'tIn "unionLists" x ys] ++ ys
 
 -- | Calculate the set difference of two lists. This is
diff --git a/compiler/utils/Util.hs b/compiler/utils/Util.hs
index a4bc8d4653..35a6340fd4 100644
--- a/compiler/utils/Util.hs
+++ b/compiler/utils/Util.hs
@@ -36,9 +36,10 @@ module Util (
 
         foldl1', foldl2, count, all2,
 
-        lengthExceeds, lengthIs, lengthAtLeast,
+        lengthExceeds, lengthIs, lengthIsNot,
+        lengthAtLeast, lengthAtMost, lengthLessThan,
         listLengthCmp, atLength,
-        equalLength, compareLength, leLength,
+        equalLength, neLength, compareLength, leLength, ltLength,
 
         isSingleton, only, singleton,
         notNull, snocView,
@@ -494,6 +495,7 @@ lengthExceeds lst n
   | otherwise
   = atLength notNull False lst n
 
+-- | @(lengthAtLeast xs n) = (length xs >= n)@
 lengthAtLeast :: [a] -> Int -> Bool
 lengthAtLeast = atLength (const True) False
 
@@ -505,6 +507,24 @@ lengthIs lst n
   | otherwise
   = atLength null False lst n
 
+-- | @(lengthIsNot xs n) = (length xs /= n)@
+lengthIsNot :: [a] -> Int -> Bool
+lengthIsNot lst n
+  | n < 0 = True
+  | otherwise = atLength notNull True lst n
+
+-- | @(lengthAtMost xs n) = (length xs <= n)@
+lengthAtMost :: [a] -> Int -> Bool
+lengthAtMost lst n
+  | n < 0
+  = False
+  | otherwise
+  = atLength null True lst n
+
+-- | @(lengthLessThan xs n) == (length xs < n)@
+lengthLessThan :: [a] -> Int -> Bool
+lengthLessThan = atLength (const False) True
+
 listLengthCmp :: [a] -> Int -> Ordering
 listLengthCmp = atLength atLen atEnd
  where
@@ -514,10 +534,17 @@ listLengthCmp = atLength atLen atEnd
   atLen _      = GT
 
 equalLength :: [a] -> [b] -> Bool
+-- ^ True if length xs == length ys
 equalLength []     []     = True
 equalLength (_:xs) (_:ys) = equalLength xs ys
 equalLength _      _      = False
 
+neLength :: [a] -> [b] -> Bool
+-- ^ True if length xs /= length ys
+neLength []     []     = False
+neLength (_:xs) (_:ys) = neLength xs ys
+neLength _      _      = True
+
 compareLength :: [a] -> [b] -> Ordering
 compareLength []     []     = EQ
 compareLength (_:xs) (_:ys) = compareLength xs ys
@@ -531,6 +558,13 @@ leLength xs ys = case compareLength xs ys of
                    EQ -> True
                    GT -> False
 
+ltLength :: [a] -> [b] -> Bool
+-- ^ True if length xs < length ys
+ltLength xs ys = case compareLength xs ys of
+                   LT -> True
+                   EQ -> False
+                   GT -> False
+
 ----------------------------
 singleton :: a -> [a]
 singleton x = [x]
diff --git a/compiler/vectorise/Vectorise/Type/Env.hs b/compiler/vectorise/Vectorise/Type/Env.hs
index 612c051a2c..9526feddaf 100644
--- a/compiler/vectorise/Vectorise/Type/Env.hs
+++ b/compiler/vectorise/Vectorise/Type/Env.hs
@@ -365,7 +365,7 @@ vectTypeEnv tycons vectTypeDecls vectClassDecls
         defDataCons
           | isAbstract = return ()
           | otherwise
-          = do { MASSERT(length (tyConDataCons origTyCon) == length (tyConDataCons vectTyCon))
+          = do { MASSERT(tyConDataCons origTyCon `equalLength` tyConDataCons vectTyCon)
                ; zipWithM_ defDataCon (tyConDataCons origTyCon) (tyConDataCons vectTyCon)
                }
 
diff --git a/compiler/vectorise/Vectorise/Utils/PADict.hs b/compiler/vectorise/Vectorise/Utils/PADict.hs
index 9cd740cf53..4d32f5df74 100644
--- a/compiler/vectorise/Vectorise/Utils/PADict.hs
+++ b/compiler/vectorise/Vectorise/Utils/PADict.hs
@@ -22,6 +22,7 @@ import Var
 import Outputable
 import DynFlags
 import FastString
+import Util
 import Control.Monad
 
 
@@ -199,7 +200,7 @@ prDFunApply dfun tys
   = return $ Var dfun `mkTyApps` tys
 
   | Just tycons <- ctxs
-  , length tycons == length tys
+  , tycons `equalLength` tys
   = do
       pa <- builtin paTyCon
       pr <- builtin prTyCon