Commit 713b32a5 authored by simonpj's avatar simonpj

[project @ 2001-10-15 15:06:01 by simonpj]

--------------------------
	Tidy up arity propagation
	--------------------------

Due to excessive complexity, correct arity information was getting
lost on the way to interface files.  As a result, a function that had
CPR info __S SLm (say), was getting arity 0, and this confused the (old)
CPR analyser ("lub of function and HasCPR").

I hope this fixes the above error (which showed up somewhere in
compiling Edison), but I'm going to commit it right now anyway.
Meanwhile I'll recompile Edison too.


Details
~~~~~~~
Digging out the rather obscure cause made me tidy up the CgInfo stuff.
The story is now

* The CgInfo field of an Id gets attached to the Id *only* in
  the TypeEnv of the ModuleDetails, during CoreTidy.

  This ModuleDetails stuff is used
	a) to generate the interface file
	b) to import into other modules in GHCi

* No CgInfo field is in the CoreBindings which are passed
  downsteam to CorePrep and thence CodeGen.  Quite right too...
  it's the downstream stuff that *generates* the CgInfo.

* But the Arity field *is* now passed on through CoreTidy
  (like strictness info) since it is usefully used by CorePrep.

* On the way I simplified the ArityInfo field of an IdInfo
  to simply
		Arity
  instead of
		Maybe Arity
parent c4854c78
......@@ -43,7 +43,7 @@ module Id (
-- IdInfo stuff
setIdUnfolding,
setIdArityInfo,
setIdArity,
setIdDemandInfo, setIdNewDemandInfo,
setIdStrictness, setIdNewStrictness, zapIdNewStrictness,
setIdTyGenInfo,
......@@ -53,7 +53,7 @@ module Id (
setIdCprInfo,
setIdOccInfo,
idArity, idArityInfo,
idArity,
idDemandInfo, idNewDemandInfo,
idStrictness, idNewStrictness, idNewStrictness_maybe, getNewStrictness,
idTyGenInfo,
......@@ -108,7 +108,7 @@ import Outputable
import Unique ( Unique, mkBuiltinUnique )
infixl 1 `setIdUnfolding`,
`setIdArityInfo`,
`setIdArity`,
`setIdDemandInfo`,
`setIdStrictness`,
`setIdNewDemandInfo`,
......@@ -309,14 +309,11 @@ isDeadBinder bndr | isId bndr = isDeadOcc (idOccInfo bndr)
\begin{code}
---------------------------------
-- ARITY
idArityInfo :: Id -> ArityInfo
idArityInfo id = arityInfo (idInfo id)
idArity :: Id -> Arity
idArity id = arityLowerBound (idArityInfo id)
idArity id = arityInfo (idInfo id)
setIdArityInfo :: Id -> Arity -> Id
setIdArityInfo id arity = modifyIdInfo (`setArityInfo` arity) id
setIdArity :: Id -> Arity -> Id
setIdArity id arity = modifyIdInfo (`setArityInfo` arity) id
---------------------------------
-- STRICTNESS
......
......@@ -20,8 +20,8 @@ module IdInfo (
-- Arity
ArityInfo,
exactArity, unknownArity, hasArity,
arityInfo, setArityInfo, ppArityInfo, arityLowerBound,
unknownArity,
arityInfo, setArityInfo, ppArityInfo,
-- New demand and strictness info
newStrictnessInfo, setNewStrictnessInfo, mkNewStrictnessInfo,
......@@ -49,7 +49,7 @@ module IdInfo (
demandInfo, setDemandInfo,
-- Inline prags
InlinePragInfo(..),
InlinePragInfo,
inlinePragInfo, setInlinePragInfo,
-- Occurrence info
......@@ -310,7 +310,7 @@ setUnfoldingInfo info uf
= info { unfoldingInfo = uf }
setDemandInfo info dd = info { demandInfo = dd }
setArityInfo info ar = info { arityInfo = Just ar }
setArityInfo info ar = info { arityInfo = ar }
setCgInfo info cg = info { cgInfo = cg }
setCprInfo info cp = info { cprInfo = cp }
setLBVarInfo info lb = info { lbvarInfo = lb }
......@@ -359,7 +359,7 @@ of their arities; so it should not be asking... (but other things
besides the code-generator need arity info!)
\begin{code}
type ArityInfo = Maybe Arity
type ArityInfo = 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
......@@ -369,21 +369,12 @@ type ArityInfo = Maybe Arity
-- an extra lambda floats up to the binding site.
seqArity :: ArityInfo -> ()
seqArity a = arityLowerBound a `seq` ()
seqArity a = a `seq` ()
exactArity = Just
unknownArity = Nothing
unknownArity = 0 :: Arity
arityLowerBound :: ArityInfo -> Arity
arityLowerBound Nothing = 0
arityLowerBound (Just n) = n
hasArity :: ArityInfo -> Bool
hasArity Nothing = False
hasArity other = True
ppArityInfo Nothing = empty
ppArityInfo (Just arity) = hsep [ptext SLIT("Arity"), int arity]
ppArityInfo 0 = empty
ppArityInfo n = hsep [ptext SLIT("Arity"), int n]
\end{code}
%************************************************************************
......
......@@ -24,7 +24,7 @@ import Id ( idType, idInfo, idName, isExportedId,
idSpecialisation, idUnique, isDataConWrapId,
mkVanillaGlobal, mkGlobalId, isLocalId,
isDataConId, mkUserLocal, isGlobalId, globalIdDetails,
idNewDemandInfo, setIdNewDemandInfo,
idNewDemandInfo, setIdNewDemandInfo, setIdCgInfo,
idNewStrictness, setIdNewStrictness
)
import IdInfo {- loads of stuff -}
......@@ -155,7 +155,7 @@ tidyCorePgm dflags mod pcs cg_info_env
isGlobalName (idName bndr)]
; let ((orig_ns', occ_env, subst_env), tidy_binds)
= mapAccumL (tidyTopBind mod ext_ids cg_info_env)
= mapAccumL (tidyTopBind mod ext_ids)
init_tidy_env binds_in
; let tidy_rules = tidyIdRules (occ_env,subst_env) ext_rules
......@@ -163,7 +163,8 @@ tidyCorePgm dflags mod pcs cg_info_env
; let prs' = prs { prsOrig = orig_ns' }
pcs' = pcs { pcs_PRS = prs' }
; let final_ids = [ id | bind <- tidy_binds
; let final_ids = [ addCgInfo cg_info_env id
| bind <- tidy_binds
, id <- bindersOf bind
, isGlobalName (idName id)]
......@@ -189,6 +190,16 @@ tidyCorePgm dflags mod pcs cg_info_env
; return (pcs', tidy_details)
}
addCgInfo :: CgInfoEnv -> Id -> Id
-- Pin on the info that comes from the code generator
-- This doesn't make its way into the *bindings* that
-- go on to the code generator (that might give black holes etc)
-- Rather, it's pinned onto the Id in the type environment
-- that (a) generates the interface file
-- (b) in GHCi goes into subsequent compilations
addCgInfo cg_info_env id
= id `setIdCgInfo` lookupCgInfo cg_info_env (idName id)
tidyCoreExpr :: CoreExpr -> IO CoreExpr
tidyCoreExpr expr = return (tidyExpr emptyTidyEnv expr)
\end{code}
......@@ -375,19 +386,18 @@ type TopTidyEnv = (NameSupply, TidyOccEnv, VarEnv Var)
tidyTopBind :: Module
-> IdEnv Bool -- Domain = Ids that should be external
-- True <=> their unfolding is external too
-> CgInfoEnv
-> TopTidyEnv -> CoreBind
-> (TopTidyEnv, CoreBind)
tidyTopBind mod ext_ids cg_info_env top_tidy_env (NonRec bndr rhs)
tidyTopBind mod ext_ids top_tidy_env (NonRec bndr rhs)
= ((orig,occ,subst) , NonRec bndr' rhs')
where
((orig,occ,subst), bndr')
= tidyTopBinder mod ext_ids cg_info_env rec_tidy_env rhs' top_tidy_env bndr
= tidyTopBinder mod ext_ids rec_tidy_env rhs' top_tidy_env bndr
rec_tidy_env = (occ,subst)
rhs' = tidyExpr rec_tidy_env rhs
tidyTopBind mod ext_ids cg_info_env top_tidy_env (Rec prs)
tidyTopBind mod ext_ids top_tidy_env (Rec prs)
= (final_env, Rec prs')
where
(final_env@(_,occ,subst), prs') = mapAccumL do_one top_tidy_env prs
......@@ -397,13 +407,12 @@ tidyTopBind mod ext_ids cg_info_env top_tidy_env (Rec prs)
= ((orig,occ,subst), (bndr',rhs'))
where
((orig,occ,subst), bndr')
= tidyTopBinder mod ext_ids cg_info_env
= tidyTopBinder mod ext_ids
rec_tidy_env rhs' top_tidy_env bndr
rhs' = tidyExpr rec_tidy_env rhs
tidyTopBinder :: Module -> IdEnv Bool
-> CgInfoEnv
-> TidyEnv -> CoreExpr
-- The TidyEnv is used to tidy the IdInfo
-- The expr is the already-tided RHS
......@@ -411,7 +420,7 @@ tidyTopBinder :: Module -> IdEnv Bool
-> TopTidyEnv -> Id -> (TopTidyEnv, Id)
-- NB: tidyTopBinder doesn't affect the unique supply
tidyTopBinder mod ext_ids cg_info_env tidy_env rhs
tidyTopBinder mod ext_ids tidy_env rhs
env@(ns2, occ_env2, subst_env2) id
| isDataConWrapId id -- Don't tidy constructor wrappers
......@@ -451,8 +460,7 @@ tidyTopBinder mod ext_ids cg_info_env tidy_env rhs
is_external
(idName id)
ty' = tidyTopType (idType id)
cg_info = lookupCgInfo cg_info_env name'
idinfo' = tidyIdInfo tidy_env is_external unfold_info cg_info id
idinfo' = tidyIdInfo tidy_env is_external unfold_info id
id' | isGlobalId id = mkGlobalId (globalIdDetails id) name' ty' idinfo'
| otherwise = mkVanillaGlobal name' ty' idinfo'
......@@ -470,17 +478,17 @@ tidyTopBinder mod ext_ids cg_info_env tidy_env rhs
| otherwise = noUnfolding
tidyIdInfo tidy_env is_external unfold_info cg_info id
tidyIdInfo tidy_env is_external unfold_info id
| opt_OmitInterfacePragmas || not is_external
-- No IdInfo if the Id isn't external, or if we don't have -O
= vanillaIdInfo
`setCgInfo` cg_info
`setArityInfo` arityInfo core_idinfo
`setNewStrictnessInfo` newStrictnessInfo core_idinfo
-- Keep strictness; it's used by CorePrep
-- Keep strictness and arity; both are used by CorePrep
| otherwise
= vanillaIdInfo
`setCgInfo` cg_info
`setArityInfo` arityInfo core_idinfo
`setNewStrictnessInfo` newStrictnessInfo core_idinfo
`setInlinePragInfo` inlinePragInfo core_idinfo
`setUnfoldingInfo` unfold_info
......
......@@ -8,8 +8,7 @@ module IlxGen( ilxGen ) where
import Char ( ord, chr )
import StgSyn
import Id ( idType, idName, isDeadBinder, idArityInfo )
import IdInfo ( arityLowerBound )
import Id ( idType, idName, isDeadBinder, idArity )
import Var ( Var, Id, TyVar, isId, isTyVar, tyVarKind, tyVarName )
import VarEnv
import VarSet ( isEmptyVarSet )
......@@ -772,7 +771,7 @@ ilxFunAppAfterPush env fun args tail_call
case lookupIlxBindEnv env fun of
Just (_, StgRhsClosure _ _ _ Updatable _ _) -> Nothing
Just (place, StgRhsClosure _ _ fvs _ args _) -> Just (place,fun,args,fvs)
_ -> Nothing -- trace (show fun ++ " --> " ++ show (arityLowerBound (idArityInfo fun)))
_ -> Nothing -- trace (show fun ++ " --> " ++ show (idArity fun))
type KnownClosure = Maybe ( IlxEnv -- Of the binding site of the function
, Id -- The function
......
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