projects
/
ghc-hetmet.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
94b170a
)
Various debugging print changes; nothing exciting
author
simonpj@microsoft.com
<unknown>
Mon, 6 Nov 2006 16:02:44 +0000
(16:02 +0000)
committer
simonpj@microsoft.com
<unknown>
Mon, 6 Nov 2006 16:02:44 +0000
(16:02 +0000)
compiler/simplCore/SimplEnv.lhs
patch
|
blob
|
history
compiler/simplCore/SimplUtils.lhs
patch
|
blob
|
history
compiler/simplCore/Simplify.lhs
patch
|
blob
|
history
compiler/specialise/Rules.lhs
patch
|
blob
|
history
diff --git
a/compiler/simplCore/SimplEnv.lhs
b/compiler/simplCore/SimplEnv.lhs
index
765fd00
..
c9fb4fb
100644
(file)
--- a/
compiler/simplCore/SimplEnv.lhs
+++ b/
compiler/simplCore/SimplEnv.lhs
@@
-21,7
+21,7
@@
module SimplEnv (
setEnclosingCC, getEnclosingCC,
-- Environments
setEnclosingCC, getEnclosingCC,
-- Environments
- SimplEnv(..), -- Temp not abstract
+ SimplEnv(..), pprSimplEnv, -- Temp not abstract
mkSimplEnv, extendIdSubst, SimplEnv.extendTvSubst,
zapSubstEnv, setSubstEnv,
getInScope, setInScope, setInScopeSet, modifyInScope, addNewInScopeIds,
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
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) -}]
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}
\end{code}
diff --git
a/compiler/simplCore/SimplUtils.lhs
b/compiler/simplCore/SimplUtils.lhs
index
60d5eb2
..
fbe5f18
100644
(file)
--- a/
compiler/simplCore/SimplUtils.lhs
+++ b/
compiler/simplCore/SimplUtils.lhs
@@
-28,6
+28,7
@@
import SimplEnv
import DynFlags
import StaticFlags
import CoreSyn
import DynFlags
import StaticFlags
import CoreSyn
+import PprCore
import CoreFVs
import CoreUtils
import Literal
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
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) $$
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
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
1be1ae3
..
5b68cc5
100644
(file)
--- 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 :: 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
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
0a06854
..
1ab02bb
100644
(file)
--- 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
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])
go ms rs
findBest :: (Id, [CoreExpr])