%
% (c) The GRASP/AQUA Project, Glasgow University, 19931998
%
\section[SaLib]{Basic datatypes, functions for the strictness analyser}
See also: the ``library'' for the ``back end'' (@SaBackLib@).
\begin{code}
#ifndef OLD_STRICTNESS
module SaLib () where
#else
module SaLib (
AbsVal(..),
AnalysisKind(..),
AbsValEnv, StrictEnv, AbsenceEnv,
mkAbsApproxFun,
nullAbsValEnv, addOneToAbsValEnv, growAbsValEnvList,
lookupAbsValEnv,
absValFromStrictness
) where
#include "HsVersions.h"
import Type ( Type )
import VarEnv
import IdInfo ( StrictnessInfo(..) )
import Demand ( Demand )
import Outputable
\end{code}
%************************************************************************
%* *
\subsection[AbsValdatatype]{@AbsVal@: abstract values (and @AbsValEnv@)}
%* *
%************************************************************************
@AnalysisKind@ tells what kind of analysis is being done.
\begin{code}
data AnalysisKind
= StrAnal
| AbsAnal
deriving Show
\end{code}
@AbsVal@ is the data type of HNF abstract values.
\begin{code}
data AbsVal
= AbsTop
| AbsBot
| AbsProd [AbsVal]
| AbsFun
Type
(AbsVal -> AbsVal)
| AbsApproxFun
[Demand]
AbsVal
mkAbsApproxFun :: Demand -> AbsVal -> AbsVal
mkAbsApproxFun d (AbsApproxFun ds val) = AbsApproxFun (d:ds) val
mkAbsApproxFun d val = AbsApproxFun [d] val
instance Outputable AbsVal where
ppr AbsTop = ptext (sLit "AbsTop")
ppr AbsBot = ptext (sLit "AbsBot")
ppr (AbsProd prod) = hsep [ptext (sLit "AbsProd"), ppr prod]
ppr (AbsFun bndr_ty body) = ptext (sLit "AbsFun")
ppr (AbsApproxFun demands val)
= ptext (sLit "AbsApprox") <+> brackets (interpp'SP demands) <+> ppr val
\end{code}
%-----------
An @AbsValEnv@ maps @Ids@ to @AbsVals@. Any unbound @Ids@ are
implicitly bound to @AbsTop@, the completely uninformative,
pessimistic value
\begin{code}
newtype AbsValEnv = AbsValEnv (IdEnv AbsVal)
type StrictEnv = AbsValEnv
type AbsenceEnv = AbsValEnv
nullAbsValEnv
= AbsValEnv emptyVarEnv
addOneToAbsValEnv (AbsValEnv idenv) y z = AbsValEnv (extendVarEnv idenv y z)
growAbsValEnvList (AbsValEnv idenv) ys = AbsValEnv (extendVarEnvList idenv ys)
lookupAbsValEnv (AbsValEnv idenv) y
= lookupVarEnv idenv y
\end{code}
\begin{code}
absValFromStrictness :: AnalysisKind -> StrictnessInfo -> AbsVal
absValFromStrictness anal NoStrictnessInfo = AbsTop
absValFromStrictness anal (StrictnessInfo args_info bot_result)
= case args_info of
[] -> res
_ -> AbsApproxFun args_info res
where
res | not bot_result = AbsTop
| otherwise = case anal of
StrAnal -> AbsBot
AbsAnal -> AbsTop
\end{code}
\begin{code}
#endif /* OLD_STRICTNESS */
\end{code}