Commit 0fa26afe authored by simonpj's avatar simonpj
Browse files

[project @ 2001-07-20 15:22:21 by simonpj]

-----------------------
	Get rid of ArityAtLeast
	-----------------------

Now that we have CgInfo, with the exact code-generator arity
for the value, we don't need the distinction between ArityAtLeast
and ArityExactly in the ArityInfo field of an IdInfo.

This commit makes

	type ArityInfo = Maybe Arity

and propagates this change consistently through the compiler.
parent 738b84dc
......@@ -307,7 +307,7 @@ idArityInfo id = arityInfo (idInfo id)
idArity :: Id -> Arity
idArity id = arityLowerBound (idArityInfo id)
setIdArityInfo :: Id -> ArityInfo -> Id
setIdArityInfo :: Id -> Arity -> Id
setIdArityInfo id arity = modifyIdInfo (`setArityInfo` arity) id
---------------------------------
......
......@@ -20,7 +20,7 @@ module IdInfo (
-- Arity
ArityInfo(..),
exactArity, atLeastArity, unknownArity, hasArity,
exactArity, unknownArity, hasArity,
arityInfo, setArityInfo, ppArityInfo, arityLowerBound,
-- New demand and strictness info
......@@ -289,7 +289,7 @@ setUnfoldingInfo info uf
= info { unfoldingInfo = uf }
setDemandInfo info dd = info { demandInfo = dd }
setArityInfo info ar = info { arityInfo = ar }
setArityInfo info ar = info { arityInfo = Just ar }
setCgInfo info cg = info { cgInfo = cg }
setCprInfo info cp = info { cprInfo = cp }
setLBVarInfo info lb = info { lbvarInfo = lb }
......@@ -304,7 +304,7 @@ vanillaIdInfo :: IdInfo
vanillaIdInfo
= IdInfo {
cgInfo = noCgInfo,
arityInfo = UnknownArity,
arityInfo = unknownArity,
demandInfo = wwLazy,
specInfo = emptyCoreRules,
tyGenInfo = noTyGenInfo,
......@@ -338,42 +338,31 @@ of their arities; so it should not be asking... (but other things
besides the code-generator need arity info!)
\begin{code}
data ArityInfo
= UnknownArity -- No idea
type ArityInfo = Maybe Arity
-- A partial application of this Id to up to n-1 value arguments
-- does essentially no work. That is not necessarily the
-- same as saying that it has n leading lambdas, because coerces
-- may get in the way.
| ArityExactly Arity -- Arity is exactly this. We use this when importing a
-- function; it's already been compiled and we know its
-- arity for sure.
| ArityAtLeast Arity -- A partial application of this Id to up to n-1 value arguments
-- does essentially no work. That is not necessarily the
-- same as saying that it has n leading lambdas, because coerces
-- may get in the way.
-- functions in the module being compiled. Their arity
-- might increase later in the compilation process, if
-- an extra lambda floats up to the binding site.
deriving( Eq )
-- The arity might increase later in the compilation process, if
-- an extra lambda floats up to the binding site.
seqArity :: ArityInfo -> ()
seqArity a = arityLowerBound a `seq` ()
exactArity = ArityExactly
atLeastArity = ArityAtLeast
unknownArity = UnknownArity
exactArity = Just
unknownArity = Nothing
arityLowerBound :: ArityInfo -> Arity
arityLowerBound UnknownArity = 0
arityLowerBound (ArityAtLeast n) = n
arityLowerBound (ArityExactly n) = n
arityLowerBound Nothing = 0
arityLowerBound (Just n) = n
hasArity :: ArityInfo -> Bool
hasArity UnknownArity = False
hasArity other = True
hasArity Nothing = False
hasArity other = True
ppArityInfo UnknownArity = empty
ppArityInfo (ArityExactly arity) = hsep [ptext SLIT("ArityExactly"), int arity]
ppArityInfo (ArityAtLeast arity) = hsep [ptext SLIT("ArityAtLeast"), int arity]
ppArityInfo Nothing = empty
ppArityInfo (Just arity) = hsep [ptext SLIT("Arity"), int arity]
\end{code}
%************************************************************************
......
......@@ -144,7 +144,7 @@ mkDataConId work_name data_con
id = mkGlobalId (DataConId data_con) work_name (dataConRepType data_con) info
info = noCafNoTyGenIdInfo
`setCgArity` arity
`setArityInfo` exactArity arity
`setArityInfo` arity
`setCprInfo` cpr_info
`setStrictnessInfo` strict_info
`setNewStrictnessInfo` mkNewStrictnessInfo id arity strict_info cpr_info
......@@ -224,7 +224,7 @@ mkDataConWrapId data_con
-- wrapper constructor isn't inlined
`setCgArity` arity
-- The NoCaf-ness is set by noCafNoTyGenIdInfo
`setArityInfo` exactArity arity
`setArityInfo` arity
-- It's important to specify the arity, so that partial
-- applications are treated as values
`setNewStrictnessInfo` mkNewStrictnessInfo wrap_id arity noStrictnessInfo cpr_info
......@@ -414,7 +414,7 @@ mkRecordSelId tycon field_label unpack_id unpackUtf8_id
arity = 1 + n_dict_tys + n_field_dict_tys
info = noCafNoTyGenIdInfo
`setCgInfo` (CgInfo arity caf_info)
`setArityInfo` exactArity arity
`setArityInfo` arity
`setUnfoldingInfo` unfolding
-- ToDo: consider adding further IdInfo
......@@ -553,7 +553,7 @@ mkDictSelId name clas
info = noCafNoTyGenIdInfo
`setCgArity` 1
`setArityInfo` exactArity 1
`setArityInfo` 1
`setUnfoldingInfo` unfolding
-- We no longer use 'must-inline' on record selectors. They'll
......@@ -605,7 +605,7 @@ mkPrimOpId prim_op
info = noCafNoTyGenIdInfo
`setSpecInfo` rules
`setCgArity` arity
`setArityInfo` exactArity arity
`setArityInfo` arity
`setStrictnessInfo` strict_info
`setNewStrictnessInfo` mkNewStrictnessInfo id arity strict_info NoCPRInfo
......@@ -638,7 +638,7 @@ mkFCallId uniq fcall ty
info = noCafNoTyGenIdInfo
`setCgArity` arity
`setArityInfo` exactArity arity
`setArityInfo` arity
`setStrictnessInfo` strict_info
`setNewStrictnessInfo` mkNewStrictnessInfo id arity strict_info NoCPRInfo
......
......@@ -31,7 +31,7 @@ import Id ( Id, idType, idInfo, isDataConId, hasNoBinding,
)
import IdInfo ( OccInfo(..), isDeadOcc, isLoopBreaker,
setArityInfo,
setUnfoldingInfo, atLeastArity,
setUnfoldingInfo,
occInfo
)
import Demand ( isStrict )
......@@ -633,7 +633,7 @@ completeBinding old_bndr new_bndr top_lvl black_listed new_rhs thing_inside
-- We make new IdInfo for the new binder by starting from the old binder,
-- doing appropriate substitutions.
-- Then we add arity and unfolding info to get the new binder
new_bndr_info = idInfo new_bndr `setArityInfo` arity_info
new_bndr_info = idInfo new_bndr `setArityInfo` arity
-- Add the unfolding *only* for non-loop-breakers
-- Making loop breakers not have an unfolding at all
......@@ -657,7 +657,7 @@ completeBinding old_bndr new_bndr top_lvl black_listed new_rhs thing_inside
loop_breaker = isLoopBreaker occ_info
trivial_rhs = exprIsTrivial new_rhs
must_keep_binding = black_listed || loop_breaker || isExportedId old_bndr
arity_info = atLeastArity (exprArity new_rhs)
arity = exprArity new_rhs
\end{code}
......
......@@ -90,7 +90,7 @@ tcIdInfo unf_env in_scope_vars name ty info_ins
tcPrag info HsCprInfo = returnTc (info `setCprInfo` ReturnsCPR)
tcPrag info (HsArity arity) =
returnTc (info `setArityInfo` (ArityExactly arity)
returnTc (info `setArityInfo` arity
`setCgArity` arity)
tcPrag info (HsUnfold inline_prag expr)
......
Markdown is supported
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