X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fspecialise%2FRules.lhs;h=ce9f64aff26af0da07ad322fab6a81b803297a53;hb=92267aa26adb1ab5a6d8004a80fdf6aa06ea4e44;hp=1219d1c6c9ba56cd4f1fddfe66607fdcf45397b0;hpb=aaae1a912d4e82de81a02ff03328e3ad363c77cb;p=ghc-hetmet.git

diff --git a/compiler/specialise/Rules.lhs b/compiler/specialise/Rules.lhs
index 1219d1c..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"
@@ -58,15 +58,15 @@ import Data.List
 
 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
+* After the desugarer:
+   - The ModGuts initially contains mg_rules :: [CoreRule] of
+     locally-declared rules for imported Ids.  
+   - Locally-declared rules for locally-declared Ids are attached to
+     the IdInfo for that Id.  See Note [Attach rules to local ids] in
+     DsBinds
+ 
+* TidyPgm strips off all the rules from local Ids and adds them to
+  mg_rules, so that the ModGuts has *all* the locally-declared rules.
 
 * The HomePackageTable contains a ModDetails for each home package
   module.  Each contains md_rules :: [CoreRule] of rules declared in
@@ -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]
@@ -500,7 +494,7 @@ matchN id_unf in_scope tmpl_vars tmpl_es target_es
 
     lookup_tmpl :: TvSubstEnv -> IdSubstEnv -> Var -> CoreExpr
     lookup_tmpl tv_subst id_subst tmpl_var'
-	| isTyVar tmpl_var' = case lookupVarEnv tv_subst tmpl_var' of
+	| isTyCoVar tmpl_var' = case lookupVarEnv tv_subst tmpl_var' of
 				Just ty 	-> Type ty
 				Nothing 	-> unbound tmpl_var'
 	| otherwise	    = case lookupVarEnv id_subst tmpl_var' of
@@ -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) }