X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Frename%2FRnExpr.lhs;h=a3698352e0aebc8289cce467be4152a8e346b122;hb=27286cf2ce6733cbbf008972c6bea30ea2e562ee;hp=78088d52cef6c39e52e1fe3bac22ec0d89aca487;hpb=f1cc3eb980a634e62f2739a7a25387c902fa9d8a;p=ghc-hetmet.git diff --git a/compiler/rename/RnExpr.lhs b/compiler/rename/RnExpr.lhs index 78088d5..a369835 100644 --- a/compiler/rename/RnExpr.lhs +++ b/compiler/rename/RnExpr.lhs @@ -30,7 +30,7 @@ import RnEnv import RnTypes ( rnHsTypeFVs, rnSplice, checkTH, mkOpFormRn, mkOpAppRn, mkNegAppRn, checkSectionPrec) import RnPat -import DynFlags ( DynFlag(..) ) +import DynFlags import BasicTypes ( FixityDirection(..) ) import PrelNames @@ -605,7 +605,7 @@ rnBracket (DecBrL decls) = do { (group, mb_splice) <- findSplice decls ; case mb_splice of Nothing -> return () - Just (SpliceDecl (L loc _), _) + Just (SpliceDecl (L loc _) _, _) -> setSrcSpan loc $ addErr (ptext (sLit "Declaration splices are not permitted inside declaration brackets")) -- Why not? See Section 7.3 of the TH paper. @@ -618,8 +618,9 @@ rnBracket (DecBrL decls) setStage thRnBrack $ rnSrcDecls group - -- Discard the tcg_env; it contains only extra info about fixity - ; return (DecBrG group', allUses (tcg_dus tcg_env)) } + -- Discard the tcg_env; it contains only extra info about fixity + ; traceRn (text "rnBracket dec" <+> (ppr (tcg_dus tcg_env) $$ ppr (duUses (tcg_dus tcg_env)))) + ; return (DecBrG group', duUses (tcg_dus tcg_env)) } rnBracket (DecBrG _) = panic "rnBracket: unexpected DecBrG" \end{code} @@ -780,6 +781,7 @@ rnStmt ctxt (L loc (GroupStmt stmts _ by using)) thing_inside ; let all_fvs = fvs1 `plusFV` fvs2 bndr_map = used_bndrs `zip` used_bndrs + -- See Note [GroupStmt binder map] in HsExpr ; traceRn (text "rnStmt: implicitly rebound these used binders:" <+> ppr bndr_map) ; return (([L loc (GroupStmt stmts' bndr_map by' using')], thing), all_fvs) } @@ -885,7 +887,8 @@ rn_rec_stmts_and_then s cont -- ...bring them and their fixities into scope ; let bound_names = collectLStmtsBinders (map fst new_lhs_and_fv) - ; bindLocalNamesFV_WithFixities bound_names fix_env $ do + ; bindLocalNamesFV bound_names $ + addLocalFixities fix_env bound_names $ do -- (C) do the right-hand-sides and thing-inside { segs <- rn_rec_stmts bound_names new_lhs_and_fv @@ -992,8 +995,8 @@ rn_rec_stmt all_bndrs (L loc (LetStmt (HsValBinds binds'))) _ = do (binds', du_binds) <- -- fixities and unused are handled above in rn_rec_stmts_and_then rnValBindsRHS (mkNameSet all_bndrs) binds' - return [(duDefs du_binds, duUses du_binds, - emptyNameSet, L loc (LetStmt (HsValBinds binds')))] + return [(duDefs du_binds, allUses du_binds, + emptyNameSet, L loc (LetStmt (HsValBinds binds')))] -- no RecStmt case becuase they get flattened above when doing the LHSes rn_rec_stmt _ stmt@(L _ (RecStmt {})) _