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/coreSyn/CoreUtils.hs | |
| 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/coreSyn/CoreUtils.hs')
| -rw-r--r-- | compiler/coreSyn/CoreUtils.hs | 8 |
1 files changed, 4 insertions, 4 deletions
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) |