diff options
author | simonpj@microsoft.com <unknown> | 2009-12-16 08:47:06 +0000 |
---|---|---|
committer | simonpj@microsoft.com <unknown> | 2009-12-16 08:47:06 +0000 |
commit | 064812423073e89805c16311728cfded5d50e306 (patch) | |
tree | e38fb4d7a95eb06abb01351d551dbd4683db846a /compiler/coreSyn/CoreSubst.lhs | |
parent | 455302c1fd5dba0047e76ad83ec21d2edb9864de (diff) | |
download | haskell-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.lhs | 12 |
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} |