%
-% (c) The GRASP/AQUA Project, Glasgow University, 1993-1995
+% (c) The GRASP/AQUA Project, Glasgow University, 1993-1996
%
\section[SaLib]{Basic datatypes, functions for the strictness analyser}
See also: the ``library'' for the ``back end'' (@SaBackLib@).
\begin{code}
-#include "HsVersions.h"
-
module SaLib (
AbsVal(..),
AnalysisKind(..),
- AbsValEnv{-abstract-}, StrictEnv(..), AbsenceEnv(..),
+ AbsValEnv{-abstract-}, StrictEnv, AbsenceEnv,
nullAbsValEnv, addOneToAbsValEnv, growAbsValEnvList,
lookupAbsValEnv,
- absValFromStrictness,
-
- -- and to make the interface self-sufficient...
- CoreExpr, Id, IdEnv(..), UniqFM, Unique,
- Demand, PlainCoreExpr(..)
+ absValFromStrictness
) where
-import IdEnv
-import IdInfo
---import FiniteMap -- debugging only
+#include "HsVersions.h"
+
+import CoreSyn ( CoreExpr )
+import Id ( nullIdEnv, addOneToIdEnv, growIdEnvList,
+ lookupIdEnv, IdEnv,
+ Id
+ )
+import IdInfo ( StrictnessInfo(..) )
+import Demand ( Demand{-instance Outputable-} )
import Outputable
-import PlainCore
-import Pretty
-import Util -- for pragmas only
\end{code}
%************************************************************************
-- AbsProd [AbsBot, ..., AbsBot]
| AbsFun -- An abstract function, with the given:
- [Id] -- arguments
- PlainCoreExpr -- body
+ Id -- argument
+ CoreExpr -- body
AbsValEnv -- and environment
| AbsApproxFun -- This is used to represent a coarse
- [Demand] -- approximation to a function value. It's an
- -- abstract function which is strict in its i'th
- -- argument if the i'th element of the Demand
- -- list so indicates.
- -- The list of arguments is always non-empty.
- -- In effect, AbsApproxFun [] = AbsTop
+ Demand -- approximation to a function value. It's an
+ AbsVal -- abstract function which is strict in its
+ -- argument if the Demand so indicates.
instance Outputable AbsVal where
- ppr sty AbsTop = ppStr "AbsTop"
- ppr sty AbsBot = ppStr "AbsBot"
- ppr sty (AbsProd prod) = ppCat [ppStr "AbsProd", ppr sty prod]
- ppr sty (AbsFun args body env)
- = ppCat [ppStr "AbsFun{", ppr sty args,
- ppStr "???", -- ppStr "}{env:", ppr sty (keysFM env `zip` eltsFM env),
- ppStr "}" ]
- ppr sty (AbsApproxFun demands)
- = ppCat [ppStr "AbsApprox{", ppr sty demands, ppStr "}" ]
+ 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 (AbsApproxFun demand val)
+ = hsep [ptext SLIT("AbsApprox "), ppr demand, ppr val]
\end{code}
%-----------
An @AbsValEnv@ maps @Ids@ to @AbsVals@. Any unbound @Ids@ are
implicitly bound to @AbsTop@, the completely uninformative,
-pessimistic value---see @absEval@ of a @CoVar@.
+pessimistic value---see @absEval@ of a @Var@.
\begin{code}
-data AbsValEnv = AbsValEnv StrAnalFlags (IdEnv AbsVal)
-type StrAnalFlags = Bool -- True <=> make everything strict
+newtype AbsValEnv = AbsValEnv (IdEnv AbsVal)
type StrictEnv = AbsValEnv -- Environment for strictness analysis
type AbsenceEnv = AbsValEnv -- Environment for absence analysis
-nullAbsValEnv x = AbsValEnv x nullIdEnv
-addOneToAbsValEnv (AbsValEnv x idenv) y z = AbsValEnv x (addOneToIdEnv idenv y z)
-growAbsValEnvList (AbsValEnv x idenv) ys = AbsValEnv x (growIdEnvList idenv ys)
+nullAbsValEnv -- this is the one and only way to create AbsValEnvs
+ = AbsValEnv nullIdEnv
+
+addOneToAbsValEnv (AbsValEnv idenv) y z = AbsValEnv (addOneToIdEnv idenv y z)
+growAbsValEnvList (AbsValEnv idenv) ys = AbsValEnv (growIdEnvList idenv ys)
-lookupAbsValEnv (AbsValEnv do_all_strict idenv) y
- = if do_all_strict
- then Just AbsBot
- else lookupIdEnv idenv y
+lookupAbsValEnv (AbsValEnv idenv) y
+ = lookupIdEnv idenv y
\end{code}
\begin{code}
absValFromStrictness StrAnal BottomGuaranteed = AbsBot -- Guaranteed bottom
absValFromStrictness AbsAnal BottomGuaranteed = AbsTop -- Check for poison in
-- arguments (if any)
-absValFromStrictness anal (StrictnessInfo [] _) = AbsTop
-absValFromStrictness anal (StrictnessInfo args_info _) = AbsApproxFun args_info
+absValFromStrictness anal (StrictnessInfo args_info _) = foldr AbsApproxFun AbsTop args_info
\end{code}