From 7e84448c9ed32f4fdc3de3155913bafd416898af Mon Sep 17 00:00:00 2001 From: Kirsten Chevalier Date: Tue, 28 Nov 2006 13:51:43 +0000 Subject: [PATCH] retain arity for let-bound vars in simplifier --- compiler/basicTypes/Id.lhs | 12 +++++++++--- compiler/basicTypes/IdInfo.lhs | 7 ++++++- compiler/simplCore/SimplEnv.lhs | 4 +++- 3 files changed, 18 insertions(+), 5 deletions(-) diff --git a/compiler/basicTypes/Id.lhs b/compiler/basicTypes/Id.lhs index edaeb7a..cc9587e 100644 --- a/compiler/basicTypes/Id.lhs +++ b/compiler/basicTypes/Id.lhs @@ -22,7 +22,7 @@ module Id ( -- Modifying an Id setIdName, setIdUnique, Id.setIdType, setIdExported, setIdNotExported, setIdInfo, lazySetIdInfo, modifyIdInfo, maybeModifyIdInfo, - zapLamIdInfo, zapDemandIdInfo, + zapLamIdInfo, zapDemandIdInfo, zapFragileIdInfo, -- Predicates isImplicitId, isDeadBinder, isDictId, @@ -513,9 +513,15 @@ clearOneShotLambda id \end{code} \begin{code} +zapInfo :: (IdInfo -> Maybe IdInfo) -> Id -> Id +zapInfo zapper id = maybeModifyIdInfo (zapper (idInfo id)) id + zapLamIdInfo :: Id -> Id -zapLamIdInfo id = maybeModifyIdInfo (zapLamInfo (idInfo id)) id +zapLamIdInfo = zapInfo zapLamInfo + +zapDemandIdInfo = zapInfo zapDemandInfo -zapDemandIdInfo id = maybeModifyIdInfo (zapDemandInfo (idInfo id)) id +zapFragileIdInfo :: Id -> Id +zapFragileIdInfo = zapInfo zapFragileInfo \end{code} diff --git a/compiler/basicTypes/IdInfo.lhs b/compiler/basicTypes/IdInfo.lhs index 9db8e35..38e2a2e 100644 --- a/compiler/basicTypes/IdInfo.lhs +++ b/compiler/basicTypes/IdInfo.lhs @@ -16,7 +16,7 @@ module IdInfo ( seqIdInfo, megaSeqIdInfo, -- Zapping - zapLamInfo, zapDemandInfo, + zapLamInfo, zapDemandInfo, zapFragileInfo, -- Arity ArityInfo, @@ -693,3 +693,8 @@ zapDemandInfo info@(IdInfo {newDemandInfo = dmd}) | otherwise = Nothing \end{code} +\begin{code} +zapFragileInfo :: IdInfo -> Maybe IdInfo +zapFragileInfo info = Just (info `setSpecInfo` emptySpecInfo + `setUnfoldingInfo` NoUnfolding) +\end{code} diff --git a/compiler/simplCore/SimplEnv.lhs b/compiler/simplCore/SimplEnv.lhs index c9fb4fb..040240c 100644 --- a/compiler/simplCore/SimplEnv.lhs +++ b/compiler/simplCore/SimplEnv.lhs @@ -620,7 +620,9 @@ substLetIdBndr env@(SimplEnv { seInScope = in_scope, seIdSubst = id_subst }) old where id1 = uniqAway in_scope old_id id2 = substIdType env id1 - new_id = setIdInfo id2 vanillaIdInfo + -- we want to get rid of any info that's dependent on free variables, + -- but keep other info (like the arity). + new_id = zapFragileIdInfo id2 -- Extend the substitution if the unique has changed, -- or there's some useful occurrence information -- 1.7.10.4