projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Refactor PackageTarget back into StaticTarget
[ghc-hetmet.git]
/
compiler
/
coreSyn
/
CoreSubst.lhs
diff --git
a/compiler/coreSyn/CoreSubst.lhs
b/compiler/coreSyn/CoreSubst.lhs
index
b5d7fde
..
9f1e20d
100644
(file)
--- a/
compiler/coreSyn/CoreSubst.lhs
+++ b/
compiler/coreSyn/CoreSubst.lhs
@@
-39,6
+39,7
@@
import OccurAnal( occurAnalyseExpr )
import qualified Type
import Type ( Type, TvSubst(..), TvSubstEnv )
import qualified Type
import Type ( Type, TvSubst(..), TvSubstEnv )
+import OptCoercion ( optCoercion )
import VarSet
import VarEnv
import Id
import VarSet
import VarEnv
import Id
@@
-290,7
+291,10
@@
substExpr subst expr
go (Lit lit) = Lit lit
go (App fun arg) = App (go fun) (go arg)
go (Note note e) = Note (go_note note) (go e)
go (Lit lit) = Lit lit
go (App fun arg) = App (go fun) (go arg)
go (Note note e) = Note (go_note note) (go e)
- go (Cast e co) = Cast (go e) (substTy subst co)
+ go (Cast e co) = Cast (go e) (optCoercion (getTvSubst subst) co)
+ -- Optimise coercions as we go; this is good, for example
+ -- in the RHS of rules, which are only substituted in
+
go (Lam bndr body) = Lam bndr' (substExpr subst' body)
where
(subst', bndr') = substBndr subst bndr
go (Lam bndr body) = Lam bndr' (substExpr subst' body)
where
(subst', bndr') = substBndr subst bndr
@@
-463,8
+467,10
@@
substTyVarBndr (Subst in_scope id_env tv_env) tv
-- | See 'Type.substTy'
substTy :: Subst -> Type -> Type
-- | See 'Type.substTy'
substTy :: Subst -> Type -> Type
-substTy (Subst in_scope _id_env tv_env) ty
- = Type.substTy (TvSubst in_scope tv_env) ty
+substTy subst ty = Type.substTy (getTvSubst subst) ty
+
+getTvSubst :: Subst -> TvSubst
+getTvSubst (Subst in_scope _id_env tv_env) = TvSubst in_scope tv_env
\end{code}
\end{code}
@@
-528,7
+534,8
@@
substUnfoldingSource (Subst in_scope ids _) (InlineWrapper wkr)
= case wkr_expr of
Var w1 -> InlineWrapper w1
_other -> WARN( True, text "Interesting! CoreSubst.substWorker1:" <+> ppr wkr
= case wkr_expr of
Var w1 -> InlineWrapper w1
_other -> WARN( True, text "Interesting! CoreSubst.substWorker1:" <+> ppr wkr
- <+> equals <+> ppr wkr_expr ) -- Note [Worker inlining]
+ <+> ifPprDebug (equals <+> ppr wkr_expr) )
+ -- Note [Worker inlining]
InlineRule -- It's not a wrapper any more, but still inline it!
| Just w1 <- lookupInScope in_scope wkr = InlineWrapper w1
InlineRule -- It's not a wrapper any more, but still inline it!
| Just w1 <- lookupInScope in_scope wkr = InlineWrapper w1