summaryrefslogtreecommitdiff
path: root/compiler/codeGen
diff options
context:
space:
mode:
authorRyan Scott <ryan.gl.scott@gmail.com>2017-06-02 13:12:11 -0400
committerBen Gamari <ben@smart-cactus.org>2017-06-02 13:12:13 -0400
commita786b136f48dfcf907dad55bcdbc4fcd247f2794 (patch)
tree9c6abee43aa398fdd8168b1cb7bd2d3fb5e6bacf /compiler/codeGen
parent811a2986475d88f73bb22b4600970039e1b582d6 (diff)
downloadhaskell-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.hs2
-rw-r--r--compiler/codeGen/StgCmmExpr.hs2
-rw-r--r--compiler/codeGen/StgCmmLayout.hs2
-rw-r--r--compiler/codeGen/StgCmmPrim.hs4
-rw-r--r--compiler/codeGen/StgCmmTicky.hs5
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"