diff options
Diffstat (limited to 'compiler/rename/RnBinds.hs')
| -rw-r--r-- | compiler/rename/RnBinds.hs | 27 |
1 files changed, 15 insertions, 12 deletions
diff --git a/compiler/rename/RnBinds.hs b/compiler/rename/RnBinds.hs index 4ce3a58539..d7790ca419 100644 --- a/compiler/rename/RnBinds.hs +++ b/compiler/rename/RnBinds.hs @@ -299,7 +299,7 @@ rnValBindsRHS ctxt (ValBinds _ mbinds sigs) ; binds_w_dus <- mapBagM (rnLBind (mkSigTvFn sigs')) mbinds ; let !(anal_binds, anal_dus) = depAnalBinds binds_w_dus - ; let patsyn_fvs = foldr (unionNameSet . psb_fvs) emptyNameSet $ + ; let patsyn_fvs = foldr (unionNameSet . psb_ext) emptyNameSet $ getPatSynBinds anal_binds -- The uses in binds_w_dus for PatSynBinds do not include -- variables used in the patsyn builders; see @@ -705,11 +705,10 @@ rnPatSynBind sig_fn bind@(PSB { psb_id = L l name -- As well as dependency analysis, we need these for the -- MonoLocalBinds test in TcBinds.decideGeneralisationPlan - bind' = bind{ psb_ext = noExt - , psb_args = details' + bind' = bind{ psb_args = details' , psb_def = pat' , psb_dir = dir' - , psb_fvs = fvs' } + , psb_ext = fvs' } selector_names = case details' of RecCon names -> map (unLoc . recordPatSynSelectorId) names @@ -1155,6 +1154,7 @@ rnMatchGroup ctxt rnBody (MG { mg_alts = L _ ms, mg_origin = origin }) ; when (null ms && not empty_case_ok) (addErr (emptyCaseErr ctxt)) ; (new_ms, ms_fvs) <- mapFvRn (rnMatch ctxt rnBody) ms ; return (mkMatchGroup origin new_ms, ms_fvs) } +rnMatchGroup _ _ (XMatchGroup {}) = panic "rnMatchGroup" rnMatch :: Outputable (body GhcPs) => HsMatchContext Name -> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)) @@ -1174,8 +1174,9 @@ rnMatch' ctxt rnBody (Match { m_ctxt = mf, m_pats = pats, m_grhss = grhss }) (FunRhs { mc_fun = L _ funid }, FunRhs { mc_fun = L lf _ }) -> mf { mc_fun = L lf funid } _ -> ctxt - ; return (Match { m_ctxt = mf', m_pats = pats' + ; return (Match { m_ext = noExt, m_ctxt = mf', m_pats = pats' , m_grhss = grhss'}, grhss_fvs ) }} +rnMatch' _ _ (XMatch _) = panic "rnMatch'" emptyCaseErr :: HsMatchContext Name -> SDoc emptyCaseErr ctxt = hang (text "Empty list of alternatives in" <+> pp_ctxt) @@ -1198,10 +1199,11 @@ rnGRHSs :: HsMatchContext Name -> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)) -> GRHSs GhcPs (Located (body GhcPs)) -> RnM (GRHSs GhcRn (Located (body GhcRn)), FreeVars) -rnGRHSs ctxt rnBody (GRHSs grhss (L l binds)) +rnGRHSs ctxt rnBody (GRHSs _ grhss (L l binds)) = rnLocalBindsAndThen binds $ \ binds' _ -> do (grhss', fvGRHSs) <- mapFvRn (rnGRHS ctxt rnBody) grhss - return (GRHSs grhss' (L l binds'), fvGRHSs) + return (GRHSs noExt grhss' (L l binds'), fvGRHSs) +rnGRHSs _ _ (XGRHSs _) = panic "rnGRHSs" rnGRHS :: HsMatchContext Name -> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)) @@ -1213,7 +1215,7 @@ rnGRHS' :: HsMatchContext Name -> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)) -> GRHS GhcPs (Located (body GhcPs)) -> RnM (GRHS GhcRn (Located (body GhcRn)), FreeVars) -rnGRHS' ctxt rnBody (GRHS guards rhs) +rnGRHS' ctxt rnBody (GRHS _ guards rhs) = do { pattern_guards_allowed <- xoptM LangExt.PatternGuards ; ((guards', rhs'), fvs) <- rnStmts (PatGuard ctxt) rnLExpr guards $ \ _ -> rnBody rhs @@ -1221,14 +1223,15 @@ rnGRHS' ctxt rnBody (GRHS guards rhs) ; unless (pattern_guards_allowed || is_standard_guard guards') (addWarn NoReason (nonStdGuardErr guards')) - ; return (GRHS guards' rhs', fvs) } + ; return (GRHS noExt guards' rhs', fvs) } where -- Standard Haskell 1.4 guards are just a single boolean -- expression, rather than a list of qualifiers as in the -- Glasgow extension - is_standard_guard [] = True - is_standard_guard [L _ (BodyStmt _ _ _ _)] = True - is_standard_guard _ = False + is_standard_guard [] = True + is_standard_guard [L _ (BodyStmt {})] = True + is_standard_guard _ = False +rnGRHS' _ _ (XGRHS _) = panic "rnGRHS'" {- ********************************************************* |