diff options
Diffstat (limited to 'compiler/typecheck/TcHsSyn.hs')
| -rw-r--r-- | compiler/typecheck/TcHsSyn.hs | 31 |
1 files changed, 21 insertions, 10 deletions
diff --git a/compiler/typecheck/TcHsSyn.hs b/compiler/typecheck/TcHsSyn.hs index 1ce29ea551..789725f060 100644 --- a/compiler/typecheck/TcHsSyn.hs +++ b/compiler/typecheck/TcHsSyn.hs @@ -418,18 +418,22 @@ zonkLocalBinds env (HsValBinds x (XValBindsLR (NValBinds binds sigs))) ; (env2, bs') <- go env1 bs ; return (env2, (r,b'):bs') } -zonkLocalBinds env (HsIPBinds x (IPBinds binds dict_binds)) = do +zonkLocalBinds env (HsIPBinds x (IPBinds dict_binds binds )) = do new_binds <- mapM (wrapLocM zonk_ip_bind) binds let - env1 = extendIdZonkEnvRec env [ n | L _ (IPBind (Right n) _) <- new_binds] + env1 = extendIdZonkEnvRec env [ n + | L _ (IPBind _ (Right n) _) <- new_binds] (env2, new_dict_binds) <- zonkTcEvBinds env1 dict_binds - return (env2, HsIPBinds x (IPBinds new_binds new_dict_binds)) + return (env2, HsIPBinds x (IPBinds new_dict_binds new_binds)) where - zonk_ip_bind (IPBind n e) + zonk_ip_bind (IPBind x n e) = do n' <- mapIPNameTc (zonkIdBndr env) n e' <- zonkLExpr env e - return (IPBind n' e') + return (IPBind x n' e') + zonk_ip_bind (XCIPBind _) = panic "zonkLocalBinds : XCIPBind" +zonkLocalBinds _ (HsIPBinds _ (XHsIPBinds _)) + = panic "zonkLocalBinds" -- Not in typechecker output zonkLocalBinds _ (XHsLocalBindsLR _) = panic "zonkLocalBinds" -- Not in typechecker output @@ -449,11 +453,13 @@ zonk_lbind :: ZonkEnv -> LHsBind GhcTcId -> TcM (LHsBind GhcTc) zonk_lbind env = wrapLocM (zonk_bind env) zonk_bind :: ZonkEnv -> HsBind GhcTcId -> TcM (HsBind GhcTc) -zonk_bind env bind@(PatBind { pat_lhs = pat, pat_rhs = grhss, pat_rhs_ty = ty}) +zonk_bind env bind@(PatBind { pat_lhs = pat, pat_rhs = grhss + , pat_ext = NPatBindTc fvs ty}) = do { (_env, new_pat) <- zonkPat env pat -- Env already extended ; new_grhss <- zonkGRHSs env zonkLExpr grhss ; new_ty <- zonkTcTypeToType env ty - ; return (bind { pat_lhs = new_pat, pat_rhs = new_grhss, pat_rhs_ty = new_ty }) } + ; return (bind { pat_lhs = new_pat, pat_rhs = new_grhss + , pat_ext = NPatBindTc fvs new_ty }) } zonk_bind env (VarBind { var_ext = x , var_id = var, var_rhs = expr, var_inline = inl }) @@ -510,17 +516,20 @@ zonk_bind env (AbsBinds { abs_tvs = tyvars, abs_ev_vars = evs | otherwise = zonk_lbind env lbind -- The normal case - zonk_export env (ABE{ abe_wrap = wrap + zonk_export env (ABE{ abe_ext = x + , abe_wrap = wrap , abe_poly = poly_id , abe_mono = mono_id , abe_prags = prags }) = do new_poly_id <- zonkIdBndr env poly_id (_, new_wrap) <- zonkCoFn env wrap new_prags <- zonkSpecPrags env prags - return (ABE{ abe_wrap = new_wrap + return (ABE{ abe_ext = x + , abe_wrap = new_wrap , abe_poly = new_poly_id , abe_mono = zonkIdOcc env mono_id , abe_prags = new_prags }) + zonk_export _ (XABExport _) = panic "zonk_bind: XABExport" zonk_bind env (PatSynBind x bind@(PSB { psb_id = L loc id , psb_args = details @@ -535,7 +544,9 @@ zonk_bind env (PatSynBind x bind@(PSB { psb_id = L loc id , psb_args = details' , psb_def = lpat' , psb_dir = dir' } } -zonk_bind _ (XHsBindsLR _) = panic "zonk_bind" + +zonk_bind _ (PatSynBind _ (XPatSynBind _)) = panic "zonk_bind" +zonk_bind _ (XHsBindsLR _) = panic "zonk_bind" zonkPatSynDetails :: ZonkEnv -> HsPatSynDetails (Located TcId) |