X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Frename%2FRnExpr.lhs;h=d11249aea9fccfd7e64595945b584b760edb77ac;hb=ada48bbc7f6a43b2c042df629327902d82cea681;hp=4b5071f8d1a969125c1e2133ef16dd4ef1ff6a70;hpb=ba05282d3915e7051b3f016366b971a8506b0093;p=ghc-hetmet.git diff --git a/compiler/rename/RnExpr.lhs b/compiler/rename/RnExpr.lhs index 4b5071f..d11249a 100644 --- a/compiler/rename/RnExpr.lhs +++ b/compiler/rename/RnExpr.lhs @@ -131,8 +131,8 @@ rnExpr (HsApp fun arg) rnLExpr arg `thenM` \ (arg',fvArg) -> return (HsApp fun' arg', fvFun `plusFV` fvArg) -rnExpr (OpApp e1 (L op_loc (HsVar op_rdr)) _ e2) - = do { (e1', fv_e1) <- rnLExpr e1 +rnExpr (OpApp e1 (L op_loc (HsVar op_rdr)) _ e2) + = do { (e1', fv_e1) <- rnLExpr e1 ; (e2', fv_e2) <- rnLExpr e2 ; op_name <- setSrcSpan op_loc (lookupOccRn op_rdr) ; (op', fv_op) <- finishHsVar op_name @@ -146,6 +146,10 @@ rnExpr (OpApp e1 (L op_loc (HsVar op_rdr)) _ e2) ; fixity <- lookupFixityRn op_name ; final_e <- mkOpAppRn e1' (L op_loc op') fixity e2' ; return (final_e, fv_e1 `plusFV` fv_op `plusFV` fv_e2) } +rnExpr (OpApp _ other_op _ _) + = failWith (vcat [ hang (ptext (sLit "Operator application with a non-variable operator:")) + 2 (ppr other_op) + , ptext (sLit "(Probably resulting from a Template Haskell splice)") ]) rnExpr (NegApp e _) = rnLExpr e `thenM` \ (e', fv_e) -> @@ -264,13 +268,10 @@ rnExpr (ExprWithTySig expr pty) rnExpr (HsIf _ p b1 b2) = do { (p', fvP) <- rnLExpr p - ; (b1', fvB1) <- rnLExpr b1 - ; (b2', fvB2) <- rnLExpr b2 - ; rebind <- xoptM Opt_RebindableSyntax - ; if not rebind - then return (HsIf Nothing p' b1' b2', plusFVs [fvP, fvB1, fvB2]) - else do { c <- liftM HsVar (lookupOccRn (mkVarUnqual (fsLit "ifThenElse"))) - ; return (HsIf (Just c) p' b1' b2', plusFVs [fvP, fvB1, fvB2]) }} + ; (b1', fvB1) <- rnLExpr b1 + ; (b2', fvB2) <- rnLExpr b2 + ; (mb_ite, fvITE) <- lookupIfThenElse + ; return (HsIf mb_ite p' b1' b2', plusFVs [fvITE, fvP, fvB1, fvB2]) } rnExpr (HsType a) = rnHsTypeFVs doc a `thenM` \ (t, fvT) -> @@ -870,13 +871,15 @@ rnRecStmtsAndThen s cont -- ...bring them and their fixities into scope ; let bound_names = collectLStmtsBinders (map fst new_lhs_and_fv) + -- Fake uses of variables introduced implicitly (warning suppression, see #4404) + implicit_uses = lStmtsImplicits (map fst new_lhs_and_fv) ; 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 ; (res, fvs) <- cont segs - ; warnUnusedLocalBinds bound_names fvs + ; warnUnusedLocalBinds bound_names (fvs `unionNameSets` implicit_uses) ; return (res, fvs) }} -- get all the fixity decls in any Let stmt