diff options
author | simonpj@microsoft.com <unknown> | 2006-10-04 13:51:55 +0000 |
---|---|---|
committer | simonpj@microsoft.com <unknown> | 2006-10-04 13:51:55 +0000 |
commit | 21174275446082358e427adec454d7e1c183fd37 (patch) | |
tree | 27ba6565888ce99df91815f4407e8362db4df40f /compiler/simplCore | |
parent | d3ff6e08657a785616eb45860bae07de3032a950 (diff) | |
download | haskell-21174275446082358e427adec454d7e1c183fd37.tar.gz |
Improve liberate-case to take account of coercions
Note [Scrutinee with cast]
~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider this:
f = \ t -> case (v `cast` co) of
V a b -> a : f t
Exactly the same optimistaion (unrolling one call to f) will work here,
despite the cast. See mk_alt_env in the Case branch of libCase.
This patch does the job. For a change, it was really easy.
Diffstat (limited to 'compiler/simplCore')
-rw-r--r-- | compiler/simplCore/LiberateCase.lhs | 17 |
1 files changed, 13 insertions, 4 deletions
diff --git a/compiler/simplCore/LiberateCase.lhs b/compiler/simplCore/LiberateCase.lhs index eebb11c587..afda3b3fec 100644 --- a/compiler/simplCore/LiberateCase.lhs +++ b/compiler/simplCore/LiberateCase.lhs @@ -81,6 +81,15 @@ Similarly drop: Would like to pass n along unboxed. +Note [Scrutinee with cast] +~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider this: + f = \ t -> case (v `cast` co) of + V a b -> a : f t + +Exactly the same optimistaion (unrolling one call to f) will work here, +despite the cast. See mk_alt_env in the Case branch of libCase. + To think about (Apr 94) ~~~~~~~~~~~~~~ @@ -238,10 +247,10 @@ libCase env (Let bind body) libCase env (Case scrut bndr ty alts) = Case (libCase env scrut) bndr ty (map (libCaseAlt env_alts) alts) where - env_alts = addBinders env_with_scrut [bndr] - env_with_scrut = case scrut of - Var scrut_var -> addScrutedVar env scrut_var - other -> env + env_alts = addBinders (mk_alt_env scrut) [bndr] + mk_alt_env (Var scrut_var) = addScrutedVar env scrut_var + mk_alt_env (Cast scrut _) = mk_alt_env scrut -- Note [Scrutinee with cast] + mk_alt_env otehr = env libCaseAlt env (con,args,rhs) = (con, args, libCase (addBinders env args) rhs) \end{code} |