X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Frename%2FRnExpr.lhs;h=421a0f32d1c0a8962c6734eab1d6f9bf34589150;hb=3c4a732b0b011cf356eed1ecd4fdc4d5f1aab193;hp=bfd644f0fba5c5004d9c2970734a6bb854028b1a;hpb=102b73a3f2a2f63d3835726be625dca8053dd88c;p=ghc-hetmet.git diff --git a/compiler/rename/RnExpr.lhs b/compiler/rename/RnExpr.lhs index bfd644f..421a0f3 100644 --- a/compiler/rename/RnExpr.lhs +++ b/compiler/rename/RnExpr.lhs @@ -24,7 +24,6 @@ import RnHsSyn import TcRnMonad import RnEnv import HscTypes ( availNames ) -import OccName ( plusOccEnv ) import RnNames ( getLocalDeclBinders, extendRdrEnvRn ) import RnTypes ( rnHsTypeFVs, rnLPat, rnOverLit, rnPatsAndThen, rnLit, mkOpFormRn, mkOpAppRn, mkNegAppRn, checkSectionPrec, @@ -91,19 +90,15 @@ rnExpr :: HsExpr RdrName -> RnM (HsExpr Name, FreeVars) rnExpr (HsVar v) = do name <- lookupOccRn v - localRdrEnv <- getLocalRdrEnv - lclEnv <- getLclEnv ignore_asserts <- doptM Opt_IgnoreAsserts - ignore_breakpoints <- doptM Opt_IgnoreBreakpoints - ghcMode <- getGhcMode - let conds = [ (name `hasKey` assertIdKey - && not ignore_asserts, - do (e, fvs) <- mkAssertErrorExpr - return (e, fvs `addOneFV` name)) - ] - case lookup True conds of - Just action -> action - Nothing -> return (HsVar name, unitFV name) + finish_var ignore_asserts name + where + finish_var ignore_asserts name + | ignore_asserts || not (name `hasKey` assertIdKey) + = return (HsVar name, unitFV name) + | otherwise + = do { (e, fvs) <- mkAssertErrorExpr + ; return (e, fvs `addOneFV` name) } rnExpr (HsIPVar v) = newIPNameRn v `thenM` \ name -> @@ -214,19 +209,16 @@ rnExpr e@(HsDo do_or_lc stmts body _) rnExpr (ExplicitList _ exps) = rnExprs exps `thenM` \ (exps', fvs) -> - returnM (ExplicitList placeHolderType exps', fvs `addOneFV` listTyCon_name) + returnM (ExplicitList placeHolderType exps', fvs) rnExpr (ExplicitPArr _ exps) = rnExprs exps `thenM` \ (exps', fvs) -> returnM (ExplicitPArr placeHolderType exps', fvs) rnExpr e@(ExplicitTuple exps boxity) - = checkTupSize tup_size `thenM_` + = checkTupSize (length exps) `thenM_` rnExprs exps `thenM` \ (exps', fvs) -> - returnM (ExplicitTuple exps' boxity, fvs `addOneFV` tycon_name) - where - tup_size = length exps - tycon_name = tupleTyCon_name boxity tup_size + returnM (ExplicitTuple exps' boxity, fvs) rnExpr (RecordCon con_id _ (HsRecordBinds rbinds)) = lookupLocatedOccRn con_id `thenM` \ conname -> @@ -234,10 +226,10 @@ rnExpr (RecordCon con_id _ (HsRecordBinds rbinds)) returnM (RecordCon conname noPostTcExpr (HsRecordBinds rbinds'), fvRbinds `addOneFV` unLoc conname) -rnExpr (RecordUpd expr (HsRecordBinds rbinds) _ _) +rnExpr (RecordUpd expr (HsRecordBinds rbinds) _ _ _) = rnLExpr expr `thenM` \ (expr', fvExpr) -> rnRbinds "update" rbinds `thenM` \ (rbinds', fvRbinds) -> - returnM (RecordUpd expr' (HsRecordBinds rbinds') placeHolderType placeHolderType, + returnM (RecordUpd expr' (HsRecordBinds rbinds') [] [] [], fvExpr `plusFV` fvRbinds) rnExpr (ExprWithTySig expr pty)