diff options
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) |