summaryrefslogtreecommitdiff
path: root/compiler/coreSyn/CoreSubst.lhs
diff options
context:
space:
mode:
authorsimonpj@microsoft.com <unknown>2009-12-16 08:47:06 +0000
committersimonpj@microsoft.com <unknown>2009-12-16 08:47:06 +0000
commit064812423073e89805c16311728cfded5d50e306 (patch)
treee38fb4d7a95eb06abb01351d551dbd4683db846a /compiler/coreSyn/CoreSubst.lhs
parent455302c1fd5dba0047e76ad83ec21d2edb9864de (diff)
downloadhaskell-064812423073e89805c16311728cfded5d50e306.tar.gz
Two improvements to optCoercion
* Fix a bug that meant that (right (inst (forall tv.co) ty)) wasn't getting optimised. This showed up in the compiled code for ByteCodeItbls * Add a substitution to optCoercion, so that it simultaneously substitutes and optimises. Both call sites wanted this, and optCoercion itself can use it, so it seems a win all round.
Diffstat (limited to 'compiler/coreSyn/CoreSubst.lhs')
-rw-r--r--compiler/coreSyn/CoreSubst.lhs12
1 files changed, 9 insertions, 3 deletions
diff --git a/compiler/coreSyn/CoreSubst.lhs b/compiler/coreSyn/CoreSubst.lhs
index b5d7fde99d..8ca99fa18a 100644
--- 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 Coercion ( optCoercion )
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 (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
@@ -463,8 +467,10 @@ substTyVarBndr (Subst in_scope id_env tv_env) tv
-- | 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}