Commit c380ee79 authored by kglynn's avatar kglynn
Browse files

[project @ 1999-10-05 09:04:30 by kglynn]


Much simplified and beautified CPR analysis code.  (And also much
shorter, we'd better write this up before it disappears).

Added (constant) functions to the abstract domain. Note that
Fun^n Bot (n >= 1) == Bot and likewise for Top

Treats divergent computations as Bot (rather than Top as previous) so
non-divergent paths dominate which allows us to generate more accurate
CPR info (see e.g. chr).

We use the result of strictness analysis to tell us if an Id is
divergent (when applied to sufficient args), therefore we should run
after the strictness analysis pass.
parent 34df3534
......@@ -12,18 +12,20 @@ import CoreSyn
import CoreUtils ( coreExprType )
import CoreUnfold ( maybeUnfoldingTemplate )
import Var ( Var, Id, TyVar, idType, varName, varType )
import Id ( setIdCprInfo, getIdCprInfo, getIdUnfolding )
import IdInfo ( CprInfo(..) )
import Id ( setIdCprInfo, getIdCprInfo, getIdUnfolding, getIdArity,
isBottomingId )
import IdInfo ( CprInfo(..), arityLowerBound )
import VarEnv
import Type ( Type, splitFunTys, splitForAllTys, splitNewType_maybe )
import Type ( Type, splitFunTys, splitFunTy_maybe, splitForAllTys, splitNewType_maybe )
import TyCon ( isProductTyCon, isNewTyCon, isUnLiftedTyCon )
import DataCon ( dataConTyCon, splitProductType_maybe )
import Const ( Con(DataCon), isWHNFCon )
import DataCon ( dataConTyCon, splitProductType_maybe, dataConRawArgTys )
import Const ( Con(DataCon), isDataCon, isWHNFCon )
import Util ( zipEqual, zipWithEqual )
import Outputable
import UniqFM (ufmToList)
import Maybe
import PprType( pprType ) -- Only called in debug messages
This module performs an analysis of a set of Core Bindings for the
......@@ -43,45 +45,80 @@ worker-wrapper pass. The worker-wrapper pass splits bindings on the
basis of both strictness and CPR info. If an id has both then it can
combine the transformations so that only one pair is produced.
The analysis here detects nested CPR information. For example, if a
function returns a constructed pair, the first element of which is a
constructed int, then the analysis will detect nested CPR information
for the int as well. Unfortunately, the current transformations can't
take advantage of the nested CPR information. They have (broken now,
I think) code which will flatten out nested CPR components and rebuild
them in the wrapper, but enabling this would lose laziness. It is
possible to make use of the nested info: if we knew that a caller was
strict in that position then we could create a specialized version of
the function which flattened/reconstructed that position.
It is not known whether this optimisation would be worthwhile.
So we generate and carry round nested CPR information, but before
using this info to guide the creation of workers and wrappers we map
all components of a CPRInfo to NoCprInfo.
Data types
Within this module Id's CPR information is represented by
``AbsVal''. When adding this information to the Id's pragma info field
we convert the Absval to a ``CprInfo'' value. The two are almost
isomorphic, CprInfo doesn't have a represenation for Bot.
Abstract domains consist of a `no information' value (Top) and
for tuple types, a corresponding length tuple of abstract values.
Bot is not a proper abstract value but a generic bottom is
useful for calculating fixpoints.
Since functions abstract to constant functions we can just
represent their result. It is not necessary to model functions
directly. This is more efficient, but unfortunately it both
simplifies and pbscures the code in places.
we convert the ``Absval'' to a ``CprInfo'' value.
Abstract domains consist of a `no information' value (Top), a function
value (Fun) which when applied to an argument returns a new AbsVal
(note the argument is not used in any way), , for product types, a
corresponding length tuple (Tuple) of abstract values. And finally,
Bot. Bot is not a proper abstract value but a generic bottom is
useful for calculating fixpoints and representing divergent
computations. Note that we equate Bot and Fun^n Bot (n > 0), and
likewise for Top. This saves a lot of delving in types to keep
everything exactly correct.
Since functions abstract to constant functions we could just
represent them by the abstract value of their result. However, it
turns out (I know - I tried!) that this requires a lot of type
manipulation and the code is more straightforward if we represent
functions by an abstract constant function.
data AbsVal = Top -- Not a constructed product
| Fun AbsVal -- A function that takes an argument
-- and gives AbsVal as result.
| Tuple [AbsVal] -- A constructed product of values
| Bot -- Bot'tom included for convenience
-- we could use appropriate Tuple Vals
deriving Show
deriving (Eq,Show)
isFun :: AbsVal -> Bool
isFun (Fun _) = True
isFun _ = False
-- For pretty debugging
instance Outputable AbsVal where
ppr Top = ptext SLIT("Top")
ppr (Fun r) = ptext SLIT("Fun->") <> (parens.ppr) r
ppr (Tuple la) = ptext SLIT("Tuple ") <> text "[" <>
(hsep (punctuate comma (map ppr la))) <>
text "]"
ppr Bot = ptext SLIT("Bot")
-- lub takes the lowest upper bound of two abstract values, standard.
lub :: AbsVal -> AbsVal -> AbsVal
lub Bot a = a
lub a Bot = a
lub Top a = Top
lub a Top = Top
lub (Tuple l) (Tuple r) = Tuple (zipWithEqual "CPR: lub" lub l r)
lub (Fun l) (Fun r) = Fun (lub l r)
lub l r = panic "CPR Analysis tried to take the lub of a function and a tuple"
......@@ -149,7 +186,7 @@ cprAnalTopBind rho (Rec bounders)
init_rho = rho `extendVarEnvList` (zip binders (repeat Bot))
binders = map fst bounders
(fin_rho, fin_bounders) = ntimes (length bounders)
(fin_rho, fin_bounders) = nTimes (length bounders)
(init_rho, bounders)
fin_bounders' = map (\(b,e) -> (fst $ pinCPR b e (lookupVarEnv_NF fin_rho b), e))
......@@ -157,57 +194,71 @@ cprAnalTopBind rho (Rec bounders)
cprAnalExpr :: CPREnv -> CoreExpr -> (CoreExpr, AbsVal)
-- If Id will always diverge when given sufficient arguments then
-- we can just set its abs val to Bot. Any other CPR info
-- from other paths will then dominate, which is what we want.
-- Check in rho, if not there it must be imported, so check
-- the var's idinfo.
cprAnalExpr rho e@(Var v)
= (e, case lookupVarEnv rho v of
Just a_val -> a_val
Nothing -> getCprPragInfo v)
| isBottomingId v = (e, Bot)
| otherwise = (e, case lookupVarEnv rho v of
Just a_val -> a_val
Nothing -> cpr_prag_a_val)
getCprPragInfo v = let ids_inf = (cprInfoToAbs . getIdCprInfo) v in
case ids_inf of
Top -> -- if we can inline this var, then
-- analyse the unfolding
ids_inf = (cprInfoToAbs.getIdCprInfo) v
ids_arity = (arityLowerBound.getIdArity) v
cpr_prag_a_val = case ids_inf of
Top -> -- if we can inline this var, and its a constructor app
-- then analyse the unfolding
case (maybeUnfoldingTemplate.getIdUnfolding) v of
Just e -> if isCon e then snd $ cprAnalExpr rho e
else ids_inf
zz_other -> ids_inf
zz_other -> ids_inf
Just e | isCon e -> snd $ cprAnalExpr rho e
zz_other -> Top
zz_other -> -- Unfortunately, cprinfo doesn't store the # of args
nTimes ids_arity Fun ids_inf
-- Return constructor with decorated arguments. If constructor
-- has product type then this is a manifest constructor (hooray!)
cprAnalExpr rho (Con con args)
= (Con con args_cpr,
-- Don't need to do this here, since we will filter out later
-- but it isn't expensive and will reduce returned abs vals.
if isConProdType con
then Tuple args_avals
if isConProdType con
then Tuple args_aval_filt_funs
else Top)
(args_cpr, args_avals) = foldl anal_arg ([], []) args
anal_arg :: ([CoreExpr], [AbsVal]) -> CoreExpr -> ([CoreExpr], [AbsVal])
anal_arg (done_args, avs) arg
| isValArg arg = cprAnalExpr rho arg `end_cons` (done_args, avs)
| otherwise = (done_args ++ [arg], avs)
end_cons :: (a,b) -> ([a],[b]) -> ([a],[b])
end_cons (x,y) (xs,ys) = (xs ++ [x], ys ++ [y])
-- For apps we ignore the argument. This app will return a constructed
-- product if the function does (we check that result type is not a fn when
-- we come to decorate a binder).
anal_con_args = map (cprAnalExpr rho) args
args_cpr = map fst anal_con_args
args_aval_filt_funs = if (not.isDataCon) con then
map snd anal_con_args
map (ifApply isFun (const Top)) $
map snd $
filter (not.isTypeArg.fst) anal_con_args
-- For apps we don't care about the argument's abs val. This
-- app will return a constructed product if the function does. We strip
-- a Fun from the functions abs val, unless the argument is a type argument
-- or it is already Top or Bot.
cprAnalExpr rho (App fun arg@(Type _))
= (App fun_cpr arg, fun_res)
(fun_cpr, fun_res) = cprAnalExpr rho fun
cprAnalExpr rho (App fun arg)
= (App fun_cpr arg_cpr, res_aval)
= (App fun_cpr arg_cpr, if fun_res==Top || fun_res==Bot
then fun_res
else res_res)
(fun_cpr, res_aval) = cprAnalExpr rho fun
(arg_cpr, arg_aval) = cprAnalExpr rho arg
(fun_cpr, fun_res) = cprAnalExpr rho fun
(arg_cpr, _) = cprAnalExpr rho arg
Fun res_res = fun_res
-- Map arguments to Top (we aren't constructing them)
-- Return the abstract value of the body, since functions
-- are represented by the CPR value of their result.
cprAnalExpr rho (Lam b body)
-- are represented by the CPR value of their result, and
-- add a Fun for this lambda..
cprAnalExpr rho (Lam b body) | isTyVar b = (Lam b body_cpr, body_aval)
| otherwise = (Lam b body_cpr, Fun body_aval)
(body_cpr, body_aval) = cprAnalExpr (extendVarEnv rho b Top) body
......@@ -221,7 +272,7 @@ cprAnalExpr rho (Let (NonRec binder rhs) body)
cprAnalExpr rho (Let (Rec bounders) body)
= (Let (Rec fin_bounders) body_cpr, body_aval)
(rhs_rho, fin_bounders) = ntimes
(rhs_rho, fin_bounders) = nTimes
(length bounders)
(init_rho, bounders)
......@@ -239,9 +290,9 @@ cprAnalExpr rho (Case scrut bndr alts)
(alts_cpr, alts_aval) = cprAnalCaseAlts (extendVarEnv rho bndr scrut_aval) alts
cprAnalExpr rho (Note n exp)
= (Note n exp_cpr, note_aval)
= (Note n exp_cpr, expr_aval)
(exp_cpr, note_aval) = cprAnalExpr rho exp
(exp_cpr, expr_aval) = cprAnalExpr rho exp
cprAnalExpr rho (Type t)
= (Type t, Top)
......@@ -271,67 +322,63 @@ do_one_pass (i_rho,bounders)
-- take a binding pair and the abs val calculated from the rhs and
-- calculate a new absval taking into account sufficient manifest
-- lambda condition and that product arguments must be non-functional
-- to have CPR property.
-- Also we pin the var's CPR property to it. This only has the CPR property if
-- its a function
-- lambda condition
-- Also we pin the var's CPR property to it. A var only has the CPR property if
-- it is a function
pinCPR :: Var -> CoreExpr -> AbsVal -> (Var, AbsVal)
pinCPR v e av = case av of
Tuple _ ->
-- v is function with sufficent lambdas?
if v_is_fn then
if {- pprTrace "pinCPR:" (ppr v <+> text "type args:" <+>
ppr argtys <+> text "lambda bound vars" <+>
ppr val_binders) -} (length argtys == length val_binders) then
(addCpr av, av)
else (addCpr Top, Top)
-- is v a function with insufficent lambdas?
Fun _ | length argtys /= length val_binders ->
-- argtys must be greater than val_binders. So stripped_exp
-- has a function type. The head of this expr can't be lambda
-- a note, because we stripped them off before. It can't be a
-- Con because it has a function type. It can't be a Type.
-- If its an app, let or case then there is work to get the
-- and we can't do anything because we may lose laziness. *But*
-- if its a var (i.e. a function name) then we are fine. Note
-- that I don't think this case is at all interesting, but I have
-- a test program that generates it.
-- UPDATE: 20 Jul 1999
-- I've decided not to allow this (useless) optimisation. It will make
-- the w/w split more complex.
-- if isVar stripped_exp then
-- (addCpr av, av)
-- else
(addCpr Top, Top)
Tuple _ ->
-- not a function.
-- Pin NoInfo to v. If v appears in the interface file then an
-- importing module will check to see if it has an unfolding
-- with a constructor at its head. If it does it will re-analyse
-- with a constructor at its head (WHNF). If it does it will re-analyse
-- the folding. I could do the check here, but I don't know if
-- the current unfolding info is final.
(addCpr Top,
-- OK, not a function but retain CPR info if it has a constructor
-- Retain CPR info if it has a constructor
-- at its head, and thus will be inlined and simplified by
-- case of a known constructor
if isCon e then
-- Need to filter out functions from nested results
filterAbsTuple (av, v_type)
else Top)
_ -> (addCpr av, av)
if isCon e then av else Top)
_ -> (addCpr av, av)
-- func to pin CPR info on a var
addCpr :: AbsVal -> Var
addCpr = (setIdCprInfo v).absToCprInfo
v_type = varType v
-- Split argument types and result type from v's type
(_, argtys, zz_result_type) = splitTypeToFunArgAndRes v_type
v_is_fn = argtys /= []
(_, argtys, _) = (splitTypeToFunArgAndRes.varType) v
-- val_binders are the explicit lambdas at the head of the expression
(binders,zz_stripped_exp) = collectBinders e
val_binders = filter (not.isTyVar) binders
filterAbsTuple :: (AbsVal, Type) -> AbsVal
filterAbsTuple (av@(Tuple args), ty)
= case splitProductType_maybe ty of
Nothing -> WARN( True, text "filterAbsTuple" <+> ppr ty) -- Or should it be a panic?
Just (tycon, _, data_con, inst_con_arg_tys)
| isNewTyCon tycon
-> ASSERT ( null $ tail inst_con_arg_tys )
filterAbsTuple (av, head inst_con_arg_tys)
| otherwise
-> Tuple $ map filterAbsTuple $ zipEqual "cprFilter" args inst_con_arg_tys
filterAbsTuple (av, _) = av
(_, val_binders, _) = collectTyAndValBinders e -- collectBindersIgnoringNotes e'
absToCprInfo :: AbsVal -> CprInfo
absToCprInfo (Tuple args) = CPRInfo $ map absToCprInfo args
absToCprInfo _ = NoCPRInfo
absToCprInfo (Fun r) = absToCprInfo r
absToCprInfo _ = NoCPRInfo
-- Cpr Info doesn't store the number of arguments a function has, so the caller
-- must take care to add the appropriate number of Funs.
cprInfoToAbs :: CprInfo -> AbsVal
cprInfoToAbs NoCPRInfo = Top
cprInfoToAbs (CPRInfo args) = Tuple $ map cprInfoToAbs args
......@@ -383,24 +430,25 @@ splitFunTysIgnoringNewTypes ty = split ty
-- Is this the constructor for a product type (i.e. algebraic, single constructor)
-- NB: isProductTyCon replies 'False' for unboxed tuples
isConProdType :: Con -> Bool
isConProdType (DataCon con) = isProductTyCon tycon
tycon = dataConTyCon con
isConProdType (DataCon con) = isProductTyCon . dataConTyCon $ con
isConProdType _ = False
-- returns True iff head of expression is a constructor
-- Should I look through notes?
-- Should I look through notes? I think so ...
isCon :: CoreExpr -> Bool
isCon (Con c _) = isWHNFCon c -- is this the right test?
isCon (Note _n e) = isCon e
isCon _ = False
-- Compose a function with itself n times. This must be in a library
-- somewhere, but where!
ntimes :: Int -> (a -> a) -> (a -> a)
ntimes 0 f = id
ntimes 1 f = f
ntimes n f = f . ntimes (n-1) f
-- Compose a function with itself n times. (nth rather than twice)
-- This must/should be in a library somewhere, but where!
nTimes :: Int -> (a -> a) -> (a -> a)
nTimes 0 _ = id
nTimes 1 f = f
nTimes n f = f . nTimes (n-1) f
-- Only apply f to argument if it satisfies p
ifApply :: (a -> Bool) -> (a -> a) -> (a -> a)
ifApply p f x = if p x then f x else x
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