diff options
author | Ryan Scott <ryan.gl.scott@gmail.com> | 2017-06-02 13:12:11 -0400 |
---|---|---|
committer | Ben Gamari <ben@smart-cactus.org> | 2017-06-02 13:12:13 -0400 |
commit | a786b136f48dfcf907dad55bcdbc4fcd247f2794 (patch) | |
tree | 9c6abee43aa398fdd8168b1cb7bd2d3fb5e6bacf /compiler/codeGen | |
parent | 811a2986475d88f73bb22b4600970039e1b582d6 (diff) | |
download | haskell-a786b136f48dfcf907dad55bcdbc4fcd247f2794.tar.gz |
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
Diffstat (limited to 'compiler/codeGen')
-rw-r--r-- | compiler/codeGen/StgCmmClosure.hs | 2 | ||||
-rw-r--r-- | compiler/codeGen/StgCmmExpr.hs | 2 | ||||
-rw-r--r-- | compiler/codeGen/StgCmmLayout.hs | 2 | ||||
-rw-r--r-- | compiler/codeGen/StgCmmPrim.hs | 4 | ||||
-rw-r--r-- | compiler/codeGen/StgCmmTicky.hs | 5 |
5 files changed, 8 insertions, 7 deletions
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" |