X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fspecialise%2FRules.lhs;h=2d95ae7d81595da23ba7ab9b51100d13de4bed61;hb=baa26ed728b6164f2827a97133306131aa89ed6f;hp=66442ebb55ed4c068024669c04ef35b8844c3b17;hpb=10f18550c3684368b9d8e5b7adcccc14994cf170;p=ghc-hetmet.git

diff --git a/compiler/specialise/Rules.lhs b/compiler/specialise/Rules.lhs
index 66442eb..2d95ae7 100644
--- a/compiler/specialise/Rules.lhs
+++ b/compiler/specialise/Rules.lhs
@@ -29,7 +29,7 @@ module Rules (
 	addIdSpecialisations, 
 	
 	-- * Misc. CoreRule helpers
-        rulesOfBinds, pprRulesForUser,
+        rulesOfBinds, getRules, pprRulesForUser,
         
         lookupRule, mkLocalRule, roughTopNames
     ) where
@@ -196,6 +196,18 @@ addIdSpecialisations id rules
 -- | Gather all the rules for locally bound identifiers from the supplied bindings
 rulesOfBinds :: [CoreBind] -> [CoreRule]
 rulesOfBinds binds = concatMap (concatMap idCoreRules . bindersOf) binds
+
+getRules :: RuleBase -> Id -> [CoreRule]
+	-- The rules for an Id come from two places:
+	--	(a) the ones it is born with (idCoreRules fn)
+	--	(b) rules added in subsequent modules (extra_rules)
+	-- PrimOps, for example, are born with a bunch of rules under (a)
+getRules rule_base fn
+  | isLocalId fn  = idCoreRules fn
+  | otherwise     = WARN( not (isPrimOpId fn) && notNull (idCoreRules fn), 
+ 			  ppr fn <+> ppr (idCoreRules fn) )
+		    idCoreRules fn ++ (lookupNameEnv rule_base (idName fn) `orElse` [])
+	-- Only PrimOpIds have rules inside themselves, and perhaps more besides
 \end{code}
 
 
@@ -256,37 +268,17 @@ in the Simplifier works better as it is.  Reason: the 'args' passed
 to lookupRule are the result of a lazy substitution
 
 \begin{code}
--- | The main rule matching function. Attempts to apply all the active
--- rules in a given 'RuleBase' to this instance of an application
--- in a given context, returning the rule applied and the resulting
--- expression if successful.
-lookupRule :: (Activation -> Bool)  -- ^ Activation test
-           -> InScopeSet                -- ^ Variables that are in scope at this point
-	   -> RuleBase	                -- ^ Imported rules
-	   -> Id                        -- ^ Function 'Id' to lookup a rule by
-	   -> [CoreExpr]                -- ^ Arguments to function
-	   -> Maybe (CoreRule, CoreExpr)
--- See Note [Extra argsin rule matching]
-lookupRule is_active in_scope rule_base fn args
-  = matchRules is_active in_scope fn args (getRules rule_base fn)
-
-getRules :: RuleBase -> Id -> [CoreRule]
-	-- The rules for an Id come from two places:
-	--	(a) the ones it is born with (idCoreRules fn)
-	--	(b) rules added in subsequent modules (extra_rules)
-	-- PrimOps, for example, are born with a bunch of rules under (a)
-getRules rule_base fn
-  | isLocalId fn  = idCoreRules fn
-  | otherwise     = WARN( not (isPrimOpId fn) && notNull (idCoreRules fn), 
- 			  ppr fn <+> ppr (idCoreRules fn) )
-		    idCoreRules fn ++ (lookupNameEnv rule_base (idName fn) `orElse` [])
-	-- Only PrimOpIds have rules inside themselves, and perhaps more besides
-
-matchRules :: (Activation -> Bool) -> InScopeSet
-	   -> Id -> [CoreExpr]
-	   -> [CoreRule] -> Maybe (CoreRule, CoreExpr)
+-- | The main rule matching function. Attempts to apply all (active)
+-- supplied rules to this instance of an application in a given
+-- context, returning the rule applied and the resulting expression if
+-- successful.
+lookupRule :: (Activation -> Bool) -> InScopeSet
+	    -> Id -> [CoreExpr]
+	    -> [CoreRule] -> Maybe (CoreRule, CoreExpr)
+
+-- See Note [Extra args in rule matching]
 -- See comments on matchRule
-matchRules is_active in_scope fn args rules
+lookupRule is_active in_scope fn args rules
   = -- pprTrace "matchRules" (ppr fn <+> ppr rules) $
     case go [] rules of
 	[]     -> Nothing
@@ -299,7 +291,7 @@ matchRules is_active in_scope fn args rules
     go ms (r:rs) = case (matchRule is_active in_scope args rough_args r) of
 			Just e  -> go ((r,e):ms) rs
 			Nothing -> -- pprTrace "match failed" (ppr r $$ ppr args $$ 
-				   --	ppr [(arg_id, unfoldingTemplate unf) | Var arg_id <- args, let unf = idUnfolding arg_id, isCheapUnfolding unf] )
+				   -- 	ppr [(arg_id, unfoldingTemplate unf) | Var arg_id <- args, let unf = idUnfolding arg_id, isCheapUnfolding unf] )
 				   go ms         rs
 
 findBest :: (Id, [CoreExpr])