X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=compiler%2Fspecialise%2FRules.lhs;h=e1dc9276765fc4c03f8ebd7821c65d2f912a1537;hb=b8ee6f14ca6e9e49015ee9b404cf8b8191fede05;hp=90485d0487a13ca0e8b8c7c8ede565071013ddbf;hpb=c86161c5cf11de77e911fcb9e1e2bd1f8bd80b42;p=ghc-hetmet.git diff --git a/compiler/specialise/Rules.lhs b/compiler/specialise/Rules.lhs index 90485d0..e1dc927 100644 --- a/compiler/specialise/Rules.lhs +++ b/compiler/specialise/Rules.lhs @@ -32,9 +32,9 @@ module Rules ( import CoreSyn -- All of it import OccurAnal ( occurAnalyseExpr ) import CoreFVs ( exprFreeVars, exprsFreeVars, bindFreeVars, rulesFreeVars ) -import CoreUtils ( exprType ) +import CoreUtils ( exprType, eqExprX ) import PprCore ( pprRules ) -import Type ( Type, TvSubstEnv, tcEqTypeX ) +import Type ( Type, TvSubstEnv ) import TcType ( tcSplitTyConApp_maybe ) import CoreTidy ( tidyRules ) import Id @@ -57,6 +57,71 @@ import Data.List \end{code} +Note [Overall plumbing for rules] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +* The ModGuts initially contains mg_rules :: [CoreRule] of rules + declared in this module. During the core-to-core pipeline, + locally-declared rules for locally-declared Ids are attached to the + IdInfo for that Id, so the mg_rules field of ModGuts now only + contains locally-declared rules for *imported* Ids. TidyPgm restores + the original setup, so that the ModGuts again has *all* the + locally-declared rules. See Note [Attach rules to local ids] in + SimplCore + +* The HomePackageTable contains a ModDetails for each home package + module. Each contains md_rules :: [CoreRule] of rules declared in + that module. The HomePackageTable grows as ghc --make does its + up-sweep. In batch mode (ghc -c), the HPT is empty; all imported modules + are treated by the "external" route, discussed next, regardless of + which package they come from. + +* The ExternalPackageState has a single eps_rule_base :: RuleBase for + Ids in other packages. This RuleBase simply grow monotonically, as + ghc --make compiles one module after another. + + During simplification, interface files may get demand-loaded, + as the simplifier explores the unfoldings for Ids it has in + its hand. (Via an unsafePerformIO; the EPS is really a cache.) + That in turn may make the EPS rule-base grow. In contrast, the + HPT never grows in this way. + +* The result of all this is that during Core-to-Core optimisation + there are four sources of rules: + + (a) Rules in the IdInfo of the Id they are a rule for. These are + easy: fast to look up, and if you apply a substitution then + it'll be applied to the IdInfo as a matter of course. + + (b) Rules declared in this module for imported Ids, kept in the + ModGuts. If you do a substitution, you'd better apply the + substitution to these. There are seldom many of these. + + (c) Rules declared in the HomePackageTable. These never change. + + (d) Rules in the ExternalPackageTable. These can grow in response + to lazy demand-loading of interfaces. + +* At the moment (c) is carried in a reader-monad way by the CoreMonad. + 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 + from HscEnv. + + [NB: we are inconsistent here. We should do the same for external + pacakges, but we don't. Same for type-class instances.] + +* So in the outer simplifier loop, we combine (b-d) into a single + RuleBase, reading + (b) from the ModGuts, + (c) from the CoreMonad, and + (d) from its mutable variable + [Of coures this means that we won't see new EPS rules that come in + during a single simplifier iteration, but that probably does not + matter.] + + %************************************************************************ %* * \subsection[specialisation-IdInfo]{Specialisation info about an @Id@} @@ -522,8 +587,8 @@ match idu menv subst e1 (Note _ e2) = match idu menv subst e1 e2 -- See Note [Notes in RULE matching] match id_unfolding_fun menv subst e1 (Var v2) -- Note [Expanding variables] - | not (locallyBoundR rn_env v2) -- Note [Do not expand locally-bound variables] - , Just e2' <- expandUnfolding (id_unfolding_fun v2') + | not (inRnEnvR rn_env v2) -- Note [Do not expand locally-bound variables] + , Just e2' <- expandUnfolding_maybe (id_unfolding_fun v2') = match id_unfolding_fun (menv { me_env = nukeRnEnvR rn_env }) subst e1 e2' where v2' = lookupRnInScope rn_env v2 @@ -531,11 +596,11 @@ match id_unfolding_fun menv subst e1 (Var v2) -- Note [Expanding variables] -- Notice that we look up v2 in the in-scope set -- See Note [Lookup in-scope] -- No need to apply any renaming first (hence no rnOccR) - -- becuase of the not-locallyBoundR + -- because of the not-inRnEnvR match idu menv (tv_subst, id_subst, binds) e1 (Let bind e2) | all freshly_bound bndrs -- See Note [Matching lets] - , not (any (locallyBoundR rn_env) bind_fvs) + , not (any (inRnEnvR rn_env) bind_fvs) = match idu (menv { me_env = rn_env' }) (tv_subst, id_subst, binds `snocOL` bind') e1 e2' @@ -628,7 +693,7 @@ match_var idu menv subst@(tv_subst, id_subst, binds) v1 e2 -- c.f. match_ty below ; return (tv_subst', extendVarEnv id_subst v1' e2, binds) } - Just e1' | eqExpr idu (nukeRnEnvL rn_env) e1' e2 + Just e1' | eqExprX idu (nukeRnEnvL rn_env) e1' e2 -> Just subst | otherwise @@ -802,77 +867,6 @@ at all. That is why the 'lookupRnInScope' call in the (Var v2) case of 'match' is so important. -\begin{code} -eqExpr :: IdUnfoldingFun -> RnEnv2 -> CoreExpr -> CoreExpr -> Bool --- ^ A kind of shallow equality used in rule matching, so does --- /not/ look through newtypes or predicate types - -eqExpr _ env (Var v1) (Var v2) - | rnOccL env v1 == rnOccR env v2 - = True - --- The next two rules expand non-local variables --- C.f. Note [Expanding variables] --- and Note [Do not expand locally-bound variables] -eqExpr id_unfolding_fun env (Var v1) e2 - | not (locallyBoundL env v1) - , Just e1' <- expandUnfolding (id_unfolding_fun (lookupRnInScope env v1)) - = eqExpr id_unfolding_fun (nukeRnEnvL env) e1' e2 - -eqExpr id_unfolding_fun env e1 (Var v2) - | not (locallyBoundR env v2) - , Just e2' <- expandUnfolding (id_unfolding_fun (lookupRnInScope env v2)) - = eqExpr id_unfolding_fun (nukeRnEnvR env) e1 e2' - -eqExpr _ _ (Lit lit1) (Lit lit2) = lit1 == lit2 -eqExpr idu env (App f1 a1) (App f2 a2) = eqExpr idu env f1 f2 && eqExpr idu env a1 a2 -eqExpr idu env (Lam v1 e1) (Lam v2 e2) = eqExpr idu (rnBndr2 env v1 v2) e1 e2 -eqExpr idu env (Note n1 e1) (Note n2 e2) = eq_note env n1 n2 && eqExpr idu env e1 e2 -eqExpr idu env (Cast e1 co1) (Cast e2 co2) = tcEqTypeX env co1 co2 && eqExpr idu env e1 e2 -eqExpr _ env (Type t1) (Type t2) = tcEqTypeX env t1 t2 - -eqExpr idu env (Let (NonRec v1 r1) e1) - (Let (NonRec v2 r2) e2) = eqExpr idu env r1 r2 - && eqExpr idu (rnBndr2 env v1 v2) e1 e2 -eqExpr idu env (Let (Rec ps1) e1) - (Let (Rec ps2) e2) = equalLength ps1 ps2 - && and (zipWith eq_rhs ps1 ps2) - && eqExpr idu env' e1 e2 - where - env' = foldl2 rn_bndr2 env ps2 ps2 - rn_bndr2 env (b1,_) (b2,_) = rnBndr2 env b1 b2 - eq_rhs (_,r1) (_,r2) = eqExpr idu env' r1 r2 -eqExpr idu env (Case e1 v1 t1 a1) - (Case e2 v2 t2 a2) = eqExpr idu env e1 e2 - && tcEqTypeX env t1 t2 - && equalLength a1 a2 - && and (zipWith eq_alt a1 a2) - where - env' = rnBndr2 env v1 v2 - eq_alt (c1,vs1,r1) (c2,vs2,r2) - = c1==c2 && eqExpr idu (rnBndrs2 env' vs1 vs2) r1 r2 -eqExpr _ _ _ _ = False - -eq_note :: RnEnv2 -> Note -> Note -> Bool -eq_note _ (SCC cc1) (SCC cc2) = cc1 == cc2 -eq_note _ (CoreNote s1) (CoreNote s2) = s1 == s2 -eq_note _ _ _ = False -\end{code} - -Auxiliary functions - -\begin{code} -locallyBoundL, locallyBoundR :: RnEnv2 -> Var -> Bool -locallyBoundL rn_env v = inRnEnvL rn_env v -locallyBoundR rn_env v = inRnEnvR rn_env v - - -expandUnfolding :: Unfolding -> Maybe CoreExpr -expandUnfolding unfolding - | isExpandableUnfolding unfolding = Just (unfoldingTemplate unfolding) - | otherwise = Nothing -\end{code} - %************************************************************************ %* * Rule-check the program