X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FdeSugar%2FDesugar.lhs;h=8387146f17a89bcead7809cef9456f5547d3de27;hp=ab9f8c7c26afe437a282d2c1f25ceac6ee0dfbda;hb=9bcd95bad83ee937c178970e8b729732e680fe1e;hpb=3b2cd7b311da1e7056ef66b42efc2571add5a8aa diff --git a/compiler/deSugar/Desugar.lhs b/compiler/deSugar/Desugar.lhs index ab9f8c7..8387146 100644 --- a/compiler/deSugar/Desugar.lhs +++ b/compiler/deSugar/Desugar.lhs @@ -17,7 +17,6 @@ import MkIface import Id import Name import CoreSyn -import OccurAnal import PprCore import DsMonad import DsExpr @@ -64,7 +63,8 @@ deSugar hsc_env tcg_fix_env = fix_env, tcg_inst_env = inst_env, tcg_fam_inst_env = fam_inst_env, - tcg_warns = warns, + tcg_warns = warns, + tcg_anns = anns, tcg_binds = binds, tcg_fords = fords, tcg_rules = rules, @@ -134,6 +134,7 @@ deSugar hsc_env mg_rdr_env = rdr_env, mg_fix_env = fix_env, mg_warns = warns, + mg_anns = anns, mg_types = type_env, mg_insts = insts, mg_fam_insts = fam_insts, @@ -255,16 +256,16 @@ ppr_ds_rules rules dsRule :: LRuleDecl Id -> DsM (Maybe CoreRule) dsRule (L loc (HsRule name act vars lhs _tv_lhs rhs _fv_rhs)) = putSrcSpanDs loc $ - do { let bndrs = [var | RuleBndr (L _ var) <- vars] + do { let bndrs' = [var | RuleBndr (L _ var) <- vars] ; lhs' <- dsLExpr lhs ; rhs' <- dsLExpr rhs - ; case decomposeRuleLhs (occurAnalyseExpr lhs') of { - Nothing -> do { warnDs msg; return Nothing } ; - Just (fn_id, args) -> do - -- Substitute the dict bindings eagerly, -- and take the body apart into a (f args) form + ; case decomposeRuleLhs (mkLams bndrs' lhs') of { + Nothing -> do { warnDs msg; return Nothing } ; + Just (bndrs, fn_id, args) -> do + { let local_rule = isLocalId fn_id -- NB: isLocalId is False of implicit Ids. This is good becuase -- we don't want to attach rules to the bindings of implicit Ids,