X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fspecialise%2FRules.lhs;h=ce9f64aff26af0da07ad322fab6a81b803297a53;hp=b4b996248b0545875cd8ca5d57bc617177a8d047;hb=92267aa26adb1ab5a6d8004a80fdf6aa06ea4e44;hpb=861e1d55126391785e93493080d3c7516812675e diff --git a/compiler/specialise/Rules.lhs b/compiler/specialise/Rules.lhs index b4b9962..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] @@ -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) }