Various debugging print changes; nothing exciting

4 files changed, 20 insertions, 10 deletions

diff --git a/compiler/simplCore/SimplEnv.lhs b/compiler/simplCore/SimplEnv.lhs
index 765fd004d7..c9fb4fbb8b 100644
--- a/compiler/simplCore/SimplEnv.lhs
+++ b/compiler/simplCore/SimplEnv.lhs
@@ -21,7 +21,7 @@ module SimplEnv (
 	setEnclosingCC, getEnclosingCC,
 
 	-- Environments
-	SimplEnv(..), 	-- Temp not abstract
+	SimplEnv(..), pprSimplEnv,	-- Temp not abstract
 	mkSimplEnv, extendIdSubst, SimplEnv.extendTvSubst, 
 	zapSubstEnv, setSubstEnv, 
 	getInScope, setInScope, setInScopeSet, modifyInScope, addNewInScopeIds,
@@ -129,6 +129,12 @@ data SimplEnv
 
     }
 
+pprSimplEnv :: SimplEnv -> SDoc
+-- Used for debugging; selective
+pprSimplEnv env
+  = vcat [ptext SLIT("TvSubst:") <+> ppr (seTvSubst env),
+ 	  ptext SLIT("IdSubst:") <+> ppr (seIdSubst env) ]
+
 type SimplIdSubst = IdEnv SimplSR	-- IdId |--> OutExpr
 	-- See Note [Extending the Subst] in CoreSubst
 
@@ -144,10 +150,10 @@ instance Outputable SimplSR where
   ppr (DoneId v) = ptext SLIT("DoneId") <+> ppr v
   ppr (ContEx tv id e) = vcat [ptext SLIT("ContEx") <+> ppr e {-,
 				ppr (filter_env tv), ppr (filter_env id) -}]
-	where
-	  fvs = exprFreeVars e
-	  filter_env env = filterVarEnv_Directly keep env
-	  keep uniq _ = uniq `elemUFM_Directly` fvs
+	-- where
+	-- fvs = exprFreeVars e
+	-- filter_env env = filterVarEnv_Directly keep env
+	-- keep uniq _ = uniq `elemUFM_Directly` fvs
 \end{code}
 
 
diff --git a/compiler/simplCore/SimplUtils.lhs b/compiler/simplCore/SimplUtils.lhs
index 60d5eb2ae6..fbe5f18b89 100644
--- a/compiler/simplCore/SimplUtils.lhs
+++ b/compiler/simplCore/SimplUtils.lhs
@@ -28,6 +28,7 @@ import SimplEnv
 import DynFlags
 import StaticFlags
 import CoreSyn
+import PprCore
 import CoreFVs
 import CoreUtils
 import Literal	
@@ -120,11 +121,12 @@ instance Outputable LetRhsFlag where
 
 instance Outputable SimplCont where
   ppr (Stop ty is_rhs _)  	     = ptext SLIT("Stop") <> brackets (ppr is_rhs) <+> ppr ty
-  ppr (ApplyTo dup arg se cont)      = (ptext SLIT("ApplyTo") <+> ppr dup <+> ppr arg) $$ ppr cont
+  ppr (ApplyTo dup arg se cont)      = ((ptext SLIT("ApplyTo") <+> ppr dup <+> pprParendExpr arg) $$ 
+					  nest 2 (pprSimplEnv se)) $$ ppr cont
   ppr (StrictBind b _ _ _ cont)      = (ptext SLIT("StrictBind") <+> ppr b) $$ ppr cont
   ppr (StrictArg f _ _ cont)         = (ptext SLIT("StrictArg") <+> ppr f) $$ ppr cont
   ppr (Select dup bndr alts se cont) = (ptext SLIT("Select") <+> ppr dup <+> ppr bndr) $$ 
-				       (nest 4 (ppr alts $$ ppr (seIdSubst se))) $$ ppr cont
+				       (nest 4 (ppr alts $$ pprSimplEnv se)) $$ ppr cont
   ppr (CoerceIt co cont)	     = (ptext SLIT("CoerceIt") <+> ppr co) $$ ppr cont
 
 data DupFlag = OkToDup | NoDup
diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs
index 1be1ae375c..5b68cc5f5d 100644
--- a/compiler/simplCore/Simplify.lhs
+++ b/compiler/simplCore/Simplify.lhs
@@ -626,8 +626,9 @@ simplExprC env expr cont
 simplExprF :: SimplEnv -> InExpr -> SimplCont
 	   -> SimplM (SimplEnv, OutExpr)
 
-simplExprF env e cont = -- pprTrace "simplExprF" (ppr e $$ ppr cont {- $$ ppr (seIdSubst env) -} $$ ppr (seFloats env) ) $
-			simplExprF' env e cont
+simplExprF env e cont 
+  = -- pprTrace "simplExprF" (ppr e $$ ppr cont $$ ppr (seTvSubst env) $$ ppr (seIdSubst env) {- $$ ppr (seFloats env) -} ) $
+    simplExprF' env e cont
     				     
 simplExprF' env (Var v)	      cont = simplVar env v cont
 simplExprF' env (Lit lit)      cont = rebuild env (Lit lit) cont
diff --git a/compiler/specialise/Rules.lhs b/compiler/specialise/Rules.lhs
index 0a06854237..1ab02bb4fb 100644
--- a/compiler/specialise/Rules.lhs
+++ b/compiler/specialise/Rules.lhs
@@ -231,7 +231,8 @@ matchRules is_active in_scope fn args rules
     go ms []	       = ms
     go ms (r:rs) = case (matchRule is_active in_scope args rough_args r) of
 			Just e  -> go ((r,e):ms) rs
-			Nothing -> -- pprTrace "Failed match" ((ppr r) $$ (ppr args)) $
+			Nothing -> -- pprTrace "match failed" (ppr r $$ ppr args $$ 
+				   --	ppr [(arg_id, unfoldingTemplate unf) | Var arg_id <- args, let unf = idUnfolding arg_id, isCheapUnfolding unf] )
 				   go ms         rs
 
 findBest :: (Id, [CoreExpr])