diff options
| author | Krzysztof Gogolewski <krzysztof.gogolewski@tweag.io> | 2020-03-28 14:18:17 +0100 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2020-04-14 07:55:20 -0400 |
| commit | 0da186c1b5a47e08e91c1c674d46c040c83932fc (patch) | |
| tree | 9c995882cf7f8733d370212c27d96c693b8df1ba /compiler/GHC/Tc | |
| parent | e8029816fda7602a8163c4d2703ff02982a3e48c (diff) | |
| download | haskell-0da186c1b5a47e08e91c1c674d46c040c83932fc.tar.gz | |
Change zipWith to zipWithEqual in a few places
Diffstat (limited to 'compiler/GHC/Tc')
| -rw-r--r-- | compiler/GHC/Tc/Deriv/Generate.hs | 2 | ||||
| -rw-r--r-- | compiler/GHC/Tc/Errors.hs | 9 | ||||
| -rw-r--r-- | compiler/GHC/Tc/Gen/Match.hs | 2 | ||||
| -rw-r--r-- | compiler/GHC/Tc/Utils/Zonk.hs | 3 |
4 files changed, 10 insertions, 6 deletions
diff --git a/compiler/GHC/Tc/Deriv/Generate.hs b/compiler/GHC/Tc/Deriv/Generate.hs index 27e73b6330..54d73d9f12 100644 --- a/compiler/GHC/Tc/Deriv/Generate.hs +++ b/compiler/GHC/Tc/Deriv/Generate.hs @@ -1183,7 +1183,7 @@ gen_Show_binds get_fixity loc tycon where nm = wrapOpParens (unpackFS l) - show_args = zipWith show_arg bs_needed arg_tys + show_args = zipWithEqual "gen_Show_binds" show_arg bs_needed arg_tys (show_arg1:show_arg2:_) = show_args show_prefix_args = intersperse (nlHsVar showSpace_RDR) show_args diff --git a/compiler/GHC/Tc/Errors.hs b/compiler/GHC/Tc/Errors.hs index 74eb1cf45a..333e442803 100644 --- a/compiler/GHC/Tc/Errors.hs +++ b/compiler/GHC/Tc/Errors.hs @@ -2053,11 +2053,14 @@ expandSynonymsToMatch ty1 ty2 = (ty1_ret, ty2_ret) (t1, t2) go (TyConApp tc1 tys1) (TyConApp tc2 tys2) - | tc1 == tc2 = + | tc1 == tc2 + , tys1 `equalLength` tys2 = -- Type constructors are same. They may be synonyms, but we don't - -- expand further. + -- expand further. The lengths of tys1 and tys2 must be equal; + -- for example, with type S a = a, we don't want + -- to zip (S Monad Int) and (S Bool). let (tys1', tys2') = - unzip (zipWith (\ty1 ty2 -> go ty1 ty2) tys1 tys2) + unzip (zipWithEqual "expandSynonymsToMatch" go tys1 tys2) in (TyConApp tc1 tys1', TyConApp tc2 tys2') go (AppTy t1_1 t1_2) (AppTy t2_1 t2_2) = diff --git a/compiler/GHC/Tc/Gen/Match.hs b/compiler/GHC/Tc/Gen/Match.hs index 8ef022edbe..7308a594e6 100644 --- a/compiler/GHC/Tc/Gen/Match.hs +++ b/compiler/GHC/Tc/Gen/Match.hs @@ -707,7 +707,7 @@ tcMcStmt ctxt (TransStmt { trS_stmts = stmts, trS_bndrs = bindersMap -- Ensure that every old binder of type `b` is linked up with its -- new binder which should have type `n b` -- See Note [GroupStmt binder map] in GHC.Hs.Expr - n_bndr_ids = zipWith mk_n_bndr n_bndr_names bndr_ids + n_bndr_ids = zipWithEqual "tcMcStmt" mk_n_bndr n_bndr_names bndr_ids bindersMap' = bndr_ids `zip` n_bndr_ids -- Type check the thing in the environment with diff --git a/compiler/GHC/Tc/Utils/Zonk.hs b/compiler/GHC/Tc/Utils/Zonk.hs index 7fb9fa68f0..ede45e058b 100644 --- a/compiler/GHC/Tc/Utils/Zonk.hs +++ b/compiler/GHC/Tc/Utils/Zonk.hs @@ -1226,7 +1226,8 @@ zonkStmt env _zBody (ApplicativeStmt body_ty args mb_join) zonk_args env args = do { (env1, new_args_rev) <- zonk_args_rev env (reverse args) ; (env2, new_pats) <- zonkPats env1 (map get_pat args) - ; return (env2, zipWith replace_pat new_pats (reverse new_args_rev)) } + ; return (env2, zipWithEqual "zonkStmt" replace_pat + new_pats (reverse new_args_rev)) } -- these need to go backward, because if any operators are higher-rank, -- later operators may introduce skolems that are in scope for earlier |