Commit 50c98638 authored by simonpj's avatar simonpj
Browse files

[project @ 2003-04-10 16:52:26 by simonpj]

Wibble to arity fix
parent 8a86866e
...@@ -56,6 +56,7 @@ import Id ( idType, idInfo, setIdInfo, setIdType, ...@@ -56,6 +56,7 @@ import Id ( idType, idInfo, setIdInfo, setIdType,
import IdInfo ( IdInfo, vanillaIdInfo, import IdInfo ( IdInfo, vanillaIdInfo,
occInfo, isFragileOcc, setOccInfo, occInfo, isFragileOcc, setOccInfo,
specInfo, setSpecInfo, specInfo, setSpecInfo,
setArityInfo, unknownArity,
unfoldingInfo, setUnfoldingInfo, unfoldingInfo, setUnfoldingInfo,
WorkerInfo(..), workerExists, workerInfo, setWorkerInfo, WorkerInfo, WorkerInfo(..), workerExists, workerInfo, setWorkerInfo, WorkerInfo,
lbvarInfo, LBVarInfo(..), setLBVarInfo, hasNoLBVarInfo lbvarInfo, LBVarInfo(..), setLBVarInfo, hasNoLBVarInfo
...@@ -621,9 +622,13 @@ simplIdInfo :: Subst -> IdInfo -> IdInfo ...@@ -621,9 +622,13 @@ simplIdInfo :: Subst -> IdInfo -> IdInfo
-- Used by the simplifier to compute new IdInfo for a let(rec) binder, -- Used by the simplifier to compute new IdInfo for a let(rec) binder,
-- subsequent to simplLetId having zapped its IdInfo -- subsequent to simplLetId having zapped its IdInfo
simplIdInfo subst old_info simplIdInfo subst old_info
= case substIdInfo subst isFragileOcc old_info of = case substIdInfo subst isFragileOcc zapped_old_info of
Just new_info -> new_info Just new_info -> new_info
Nothing -> old_info Nothing -> old_info
where
zapped_old_info = old_info `setArityInfo` unknownArity
-- Like unfolding, arity gets set later
-- Maybe we should do this in substIdInfo?
\end{code} \end{code}
\begin{code} \begin{code}
......
...@@ -305,17 +305,17 @@ simplNonRecBind env bndr rhs rhs_se cont_ty thing_inside ...@@ -305,17 +305,17 @@ simplNonRecBind env bndr rhs rhs_se cont_ty thing_inside
| isStrictDmd (idNewDemandInfo bndr) || isStrictType (idType bndr) -- A strict let | isStrictDmd (idNewDemandInfo bndr) || isStrictType (idType bndr) -- A strict let
= -- Don't use simplBinder because that doesn't keep = -- Don't use simplBinder because that doesn't keep
-- fragile occurrence info in the substitution -- fragile occurrence info in the substitution
simplLetBndr env bndr `thenSmpl` \ (env, bndr') -> simplLetBndr env bndr `thenSmpl` \ (env, bndr1) ->
simplStrictArg AnRhs env rhs rhs_se (idType bndr1) cont_ty $ \ env1 rhs1 ->
-- Now complete the binding and simplify the body
let let
-- simplLetBndr doesn't deal with the IdInfo, so we must -- simplLetBndr doesn't deal with the IdInfo, so we must
-- do so here (c.f. simplLazyBind) -- do so here (c.f. simplLazyBind)
bndr'' = bndr' `setIdInfo` simplIdInfo (getSubst env) (idInfo bndr) bndr2 = bndr1 `setIdInfo` simplIdInfo (getSubst env) (idInfo bndr)
env1 = modifyInScope env bndr'' bndr'' env2 = modifyInScope env1 bndr2 bndr2
in in
simplStrictArg AnRhs env1 rhs rhs_se (idType bndr') cont_ty $ \ env rhs1 -> completeNonRecX env2 True {- strict -} bndr bndr2 rhs1 thing_inside
-- Now complete the binding and simplify the body
completeNonRecX env True {- strict -} bndr bndr'' rhs1 thing_inside
| otherwise -- Normal, lazy case | otherwise -- Normal, lazy case
= -- Don't use simplBinder because that doesn't keep = -- Don't use simplBinder because that doesn't keep
...@@ -473,8 +473,7 @@ simplLazyBind env top_lvl is_rec bndr bndr1 rhs rhs_se ...@@ -473,8 +473,7 @@ simplLazyBind env top_lvl is_rec bndr bndr1 rhs rhs_se
-- which isn't sound. And it makes the arity in f's IdInfo greater than -- which isn't sound. And it makes the arity in f's IdInfo greater than
-- the manifest arity, which isn't good. -- the manifest arity, which isn't good.
let let
rules = idSpecialisation bndr bndr2 = bndr1 `setIdInfo` simplIdInfo (getSubst env) (idInfo bndr)
bndr2 = bndr1 `setIdSpecialisation` substRules (getSubst env) rules
env1 = modifyInScope env bndr2 bndr2 env1 = modifyInScope env bndr2 bndr2
rhs_env = setInScope rhs_se env1 rhs_env = setInScope rhs_se env1
is_top_level = isTopLevel top_lvl is_top_level = isTopLevel top_lvl
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment