1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
|
%
% (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
%
\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{-abstract-}, 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[AbsVal-datatype]{@AbsVal@: abstract values (and @AbsValEnv@)}
%* *
%************************************************************************
@AnalysisKind@ tells what kind of analysis is being done.
\begin{code}
data AnalysisKind
= StrAnal -- We're doing strictness analysis
| AbsAnal -- We're doing absence analysis
deriving Show
\end{code}
@AbsVal@ is the data type of HNF abstract values.
\begin{code}
data AbsVal
= AbsTop -- AbsTop is the completely uninformative
-- value
| AbsBot -- An expression whose abstract value is
-- AbsBot is sure to fail to terminate.
-- AbsBot represents the abstract
-- *function* bottom too.
| AbsProd [AbsVal] -- (Lifted) product of abstract values
-- "Lifted" means that AbsBot is *different* from
-- AbsProd [AbsBot, ..., AbsBot]
| AbsFun -- An abstract function, with the given:
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)
-- might be bot, but the partial application (f bot) is a *function*,
-- not bot.
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---see @absEval@ of a @Var@.
\begin{code}
newtype AbsValEnv = AbsValEnv (IdEnv AbsVal)
type StrictEnv = AbsValEnv -- Environment for strictness analysis
type AbsenceEnv = AbsValEnv -- Environment for absence analysis
nullAbsValEnv -- this is the one and only way to create AbsValEnvs
= 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 -- 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}
\begin{code}
#endif /* OLD_STRICTNESS */
\end{code}
|
