#include "HsVersions.h"
-import Id ( Id )
-import CoreSyn ( CoreExpr )
+import Type ( Type )
import VarEnv
import IdInfo ( StrictnessInfo(..) )
-import Demand ( Demand, pprDemands )
+import Demand ( Demand )
import Outputable
\end{code}
data AnalysisKind
= StrAnal -- We're doing strictness analysis
| AbsAnal -- We're doing absence analysis
- deriving Text
+ deriving Show
\end{code}
@AbsVal@ is the data type of HNF abstract values.
-- AbsProd [AbsBot, ..., AbsBot]
| AbsFun -- An abstract function, with the given:
- Id -- argument
- CoreExpr -- body
- AbsValEnv -- and environment
+ Type -- Type of the *argument* to the function
+ (AbsVal -> AbsVal) -- The function
| AbsApproxFun -- This is used to represent a coarse
[Demand] -- approximation to a function value. It's an
AbsVal -- abstract function which is strict in its
-- arguments if the Demand so indicates.
+ -- INVARIANT: the [Demand] is non-empty
-- AbsApproxFun has to take a *list* of demands, no just one,
-- because function spaces are now lifted. Hence, (f bot top)
ppr AbsTop = ptext SLIT("AbsTop")
ppr AbsBot = ptext SLIT("AbsBot")
ppr (AbsProd prod) = hsep [ptext SLIT("AbsProd"), ppr prod]
- ppr (AbsFun arg body env)
- = hsep [ptext SLIT("AbsFun{"), ppr arg,
- ptext SLIT("???"), -- text "}{env:", ppr (keysFM env `zip` eltsFM env),
- char '}' ]
+ ppr (AbsFun bndr_ty body) = ptext SLIT("AbsFun")
ppr (AbsApproxFun demands val)
- = hsep [ptext SLIT("AbsApprox "), pprDemands demands, ppr val]
+ = ptext SLIT("AbsApprox") <+> brackets (interpp'SP demands) <+> ppr val
\end{code}
%-----------
\begin{code}
absValFromStrictness :: AnalysisKind -> StrictnessInfo -> AbsVal
-absValFromStrictness anal NoStrictnessInfo = AbsTop
-
-absValFromStrictness StrAnal BottomGuaranteed = AbsBot -- Guaranteed bottom
-absValFromStrictness AbsAnal BottomGuaranteed = AbsTop -- Check for poison in
- -- arguments (if any)
-absValFromStrictness anal (StrictnessInfo args_info _) = AbsApproxFun args_info AbsTop
+absValFromStrictness anal NoStrictnessInfo = AbsTop
+absValFromStrictness anal (StrictnessInfo args_info bot_result)
+ = case args_info of -- Check the invariant that the arg list on
+ [] -> res -- AbsApproxFun is non-empty
+ _ -> AbsApproxFun args_info res
+ where
+ res | not bot_result = AbsTop
+ | otherwise = case anal of
+ StrAnal -> AbsBot
+ AbsAnal -> AbsTop
\end{code}