X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FsimplCore%2FSimplify.lhs;h=e1a8492ee07f290e38a025872fb72d2e07aa7fc6;hb=3e597db13ccc44fdb7791e346ba23f11b27ec9f9;hp=8c34873787907c2c64295806c16e20c05f63e1d9;hpb=159946caca9c7ef84af7eb0e575ff2220e803e28;p=ghc-hetmet.git

diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs
index 8c34873..e1a8492 100644
--- a/compiler/simplCore/Simplify.lhs
+++ b/compiler/simplCore/Simplify.lhs
@@ -25,7 +25,7 @@ import NewDemand        ( isStrictDmd )
 import PprCore          ( pprParendExpr, pprCoreExpr )
 import CoreUnfold       ( mkUnfolding, callSiteInline, CallCtxt(..) )
 import CoreUtils
-import Rules            ( lookupRule )
+import Rules            ( lookupRule, getRules )
 import BasicTypes       ( isMarkedStrict )
 import CostCentre       ( currentCCS )
 import TysPrim          ( realWorldStatePrimTy )
@@ -566,7 +566,10 @@ completeBind env top_lvl old_bndr new_bndr new_rhs
     old_info    = idInfo old_bndr
     occ_info    = occInfo old_info
     wkr		= substWorker env (workerInfo old_info)
-    omit_unfolding = isNonRuleLoopBreaker occ_info || not (activeInline env old_bndr)
+    omit_unfolding = isNonRuleLoopBreaker occ_info 
+		   --       or not (activeInline env old_bndr)
+    		   -- Do *not* trim the unfolding in SimplGently, else
+		   -- the specialiser can't see it!
 
 -----------------
 addPolyBind :: TopLevelFlag -> SimplEnv -> OutBind -> SimplEnv
@@ -1033,12 +1036,13 @@ completeCall env var cont
         -- is recursive, and hence a loop breaker:
         --      foldr k z (build g) = g k z
         -- So it's up to the programmer: rules can cause divergence
-        ; rules <- getRules
+        ; rule_base <- getSimplRules
         ; let   in_scope   = getInScope env
+	  	rules      = getRules rule_base var
                 maybe_rule = case activeRule dflags env of
                                 Nothing     -> Nothing  -- No rules apply
                                 Just act_fn -> lookupRule act_fn in_scope
-                                                          rules var args
+                                                          var args rules 
         ; case maybe_rule of {
             Just (rule, rule_rhs) -> do
                 tick (RuleFired (ru_name rule))