Commit 6f074a37 authored by simonpj@microsoft.com's avatar simonpj@microsoft.com

Various debugging print changes; nothing exciting

parent 94b170a0
......@@ -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}
......
......@@ -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
......
......@@ -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
......
......@@ -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])
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment