setEnclosingCC, getEnclosingCC,
-- Environments
- SimplEnv(..), -- Temp not abstract
+ SimplEnv(..), pprSimplEnv, -- Temp not abstract
mkSimplEnv, extendIdSubst, SimplEnv.extendTvSubst,
zapSubstEnv, setSubstEnv,
getInScope, setInScope, setInScopeSet, modifyInScope, addNewInScopeIds,
}
+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
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}
import DynFlags
import StaticFlags
import CoreSyn
+import PprCore
import CoreFVs
import CoreUtils
import Literal
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
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
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])