summaryrefslogtreecommitdiff
path: root/compiler/deSugar/Check.hs
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/deSugar/Check.hs
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/deSugar/Check.hs')
-rw-r--r--compiler/deSugar/Check.hs12
1 files changed, 4 insertions, 8 deletions
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]