Don't dump simplifier iterations with -dverbose-core2core

[ghc-hetmet.git] / compiler / simplCore / SimplEnv.lhs

diff --git a/compiler/simplCore/SimplEnv.lhs b/compiler/simplCore/SimplEnv.lhs
index d0240fb..762758f 100644 (file)
--- a/compiler/simplCore/SimplEnv.lhs
+++ b/compiler/simplCore/SimplEnv.lhs
@@ -455,7 +455,7 @@ floatBinds (Floats bs _) = fromOL bs
 
 
 \begin{code}
-substId :: SimplEnv -> Id -> SimplSR
+substId :: SimplEnv -> InId -> SimplSR
 -- Returns DoneEx only on a non-Var expression
 substId (SimplEnv { seInScope = in_scope, seIdSubst = ids }) v 
   | not (isLocalId v) 
@@ -464,7 +464,9 @@ substId (SimplEnv { seInScope = in_scope, seIdSubst = ids }) v
   = case lookupVarEnv ids v of
        Nothing               -> DoneId (refine in_scope v)
        Just (DoneId v)       -> DoneId (refine in_scope v)
-       Just (DoneEx (Var v)) -> DoneId (refine in_scope v)
+       Just (DoneEx (Var v)) 
+              | isLocalId v  -> DoneId (refine in_scope v)
+              | otherwise    -> DoneId v
        Just res              -> res    -- DoneEx non-var, or ContEx
   where
 
@@ -475,7 +477,7 @@ refine in_scope v = case lookupInScope in_scope v of
                         Just v' -> v'
                         Nothing -> WARN( True, ppr v ) v       -- This is an error!
 
-lookupRecBndr :: SimplEnv -> Id -> Id
+lookupRecBndr :: SimplEnv -> InId -> OutId
 -- Look up an Id which has been put into the envt by simplRecBndrs,
 -- but where we have not yet done its RHS
 lookupRecBndr (SimplEnv { seInScope = in_scope, seIdSubst = ids }) v
@@ -619,7 +621,7 @@ Can we eta-expand f?  Only if we see that f has arity 1, and then we
 take advantage of the 'state hack' on the result of
 (f y) :: State# -> (State#, Int) to expand the arity one more.
 
-There is a disadvantage though.  Making the arity visible in the RHA
+There is a disadvantage though.  Making the arity visible in the RHS
 allows us to eta-reduce
        f = \x -> f x
 to
@@ -657,7 +659,7 @@ addBndrRules env in_id out_id
   where
     subst     = mkCoreSubst env
     old_rules = idSpecialisation in_id
-    new_rules = CoreSubst.substSpec subst old_rules
+    new_rules = CoreSubst.substSpec subst out_id old_rules
     final_id  = out_id `setIdSpecialisation` new_rules
 
 ------------------