X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fspecialise%2FRules.lhs;h=ce9f64aff26af0da07ad322fab6a81b803297a53;hb=92267aa26adb1ab5a6d8004a80fdf6aa06ea4e44;hp=87999a4dfd29779206122fff41eef4c856c095dc;hpb=d2ce0f52d42edf32bb9f13796e6ba6edba8bd516;p=ghc-hetmet.git diff --git a/compiler/specialise/Rules.lhs b/compiler/specialise/Rules.lhs index 87999a4..ce9f64a 100644 --- a/compiler/specialise/Rules.lhs +++ b/compiler/specialise/Rules.lhs @@ -24,7 +24,7 @@ module Rules ( -- * Misc. CoreRule helpers rulesOfBinds, getRules, pprRulesForUser, - lookupRule, mkRule, mkLocalRule, roughTopNames + lookupRule, mkRule, roughTopNames ) where #include "HsVersions.h" @@ -105,7 +105,7 @@ Note [Overall plumbing for rules] The HomePackageTable doesn't have a single RuleBase because technically we should only be able to "see" rules "below" this module; so we generate a RuleBase for (c) by combing rules from all the modules - "below" us. That's whye we can't just select the home-package RuleBase + "below" us. That's why we can't just select the home-package RuleBase from HscEnv. [NB: we are inconsistent here. We should do the same for external @@ -156,22 +156,16 @@ might have a specialisation where pi' :: Lift Int# is the specialised version of pi. \begin{code} -mkLocalRule :: RuleName -> Activation - -> Name -> [CoreBndr] -> [CoreExpr] -> CoreExpr -> CoreRule --- ^ Used to make 'CoreRule' for an 'Id' defined in the module being --- compiled. See also 'CoreSyn.CoreRule' -mkLocalRule = mkRule True - -mkRule :: Bool -> RuleName -> Activation +mkRule :: Bool -> Bool -> RuleName -> Activation -> Name -> [CoreBndr] -> [CoreExpr] -> CoreExpr -> CoreRule -- ^ Used to make 'CoreRule' for an 'Id' defined in the module being -- compiled. See also 'CoreSyn.CoreRule' -mkRule is_local name act fn bndrs args rhs +mkRule is_auto is_local name act fn bndrs args rhs = Rule { ru_name = name, ru_fn = fn, ru_act = act, ru_bndrs = bndrs, ru_args = args, ru_rhs = occurAnalyseExpr rhs, ru_rough = roughTopNames args, - ru_local = is_local } + ru_auto = is_auto, ru_local = is_local } -------------- roughTopNames :: [CoreExpr] -> [Maybe Name] @@ -652,7 +646,7 @@ match idu menv subst (Lam x1 e1) (Lam x2 e2) match idu menv subst (Lam x1 e1) e2 = match idu menv' subst e1 (App e2 (varToCoreExpr new_x)) where - (rn_env', new_x) = rnBndrL (me_env menv) x1 + (rn_env', new_x) = rnEtaL (me_env menv) x1 menv' = menv { me_env = rn_env' } -- Eta expansion the other way @@ -660,7 +654,7 @@ match idu menv subst (Lam x1 e1) e2 match idu menv subst e1 (Lam x2 e2) = match idu menv' subst (App e1 (varToCoreExpr new_x)) e2 where - (rn_env', new_x) = rnBndrR (me_env menv) x2 + (rn_env', new_x) = rnEtaR (me_env menv) x2 menv' = menv { me_env = rn_env' } match idu menv subst (Case e1 x1 ty1 alts1) (Case e2 x2 ty2 alts2) @@ -759,21 +753,19 @@ match_alts idu menv subst ((c1,vs1,r1):alts1) ((c2,vs2,r2):alts2) match_alts _ _ _ _ _ = Nothing -\end{code} -Matching Core types: use the matcher in TcType. -Notice that we treat newtypes as opaque. For example, suppose -we have a specialised version of a function at a newtype, say - newtype T = MkT Int -We only want to replace (f T) with f', not (f Int). - -\begin{code} ------------------------------------------ match_ty :: MatchEnv -> SubstEnv -> Type -- Template -> Type -- Target -> Maybe SubstEnv +-- Matching Core types: use the matcher in TcType. +-- Notice that we treat newtypes as opaque. For example, suppose +-- we have a specialised version of a function at a newtype, say +-- newtype T = MkT Int +-- We only want to replace (f T) with f', not (f Int). + match_ty menv (tv_subst, id_subst, binds) ty1 ty2 = do { tv_subst' <- Unify.ruleMatchTyX menv tv_subst ty1 ty2 ; return (tv_subst', id_subst, binds) }