2 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1996
4 \section[SaLib]{Basic datatypes, functions for the strictness analyser}
6 See also: the ``library'' for the ``back end'' (@SaBackLib@).
9 #include "HsVersions.h"
14 AbsValEnv{-abstract-}, SYN_IE(StrictEnv), SYN_IE(AbsenceEnv),
15 SYN_IE(StrAnalFlags), getStrAnalFlags,
16 nullAbsValEnv, addOneToAbsValEnv, growAbsValEnvList,
23 import CoreSyn ( SYN_IE(CoreExpr) )
24 import Id ( nullIdEnv, addOneToIdEnv, growIdEnvList,
25 lookupIdEnv, SYN_IE(IdEnv),
26 GenId{-instance Outputable-}
28 import IdInfo ( StrictnessInfo(..) )
29 import Demand ( Demand{-instance Outputable-} )
30 import Outputable ( Outputable(..){-instance * []-} )
31 import PprType ( GenType{-instance Outputable-} )
32 import Pretty ( ppPStr, ppCat, ppChar )
35 %************************************************************************
37 \subsection[AbsVal-datatype]{@AbsVal@: abstract values (and @AbsValEnv@)}
39 %************************************************************************
41 @AnalysisKind@ tells what kind of analysis is being done.
45 = StrAnal -- We're doing strictness analysis
46 | AbsAnal -- We're doing absence analysis
50 @AbsVal@ is the data type of HNF abstract values.
54 = AbsTop -- AbsTop is the completely uninformative
57 | AbsBot -- An expression whose abstract value is
58 -- AbsBot is sure to fail to terminate.
59 -- AbsBot represents the abstract
60 -- *function* bottom too.
62 | AbsProd [AbsVal] -- (Lifted) product of abstract values
63 -- "Lifted" means that AbsBot is *different* from
64 -- AbsProd [AbsBot, ..., AbsBot]
66 | AbsFun -- An abstract function, with the given:
69 AbsValEnv -- and environment
71 | AbsApproxFun -- This is used to represent a coarse
72 Demand -- approximation to a function value. It's an
73 AbsVal -- abstract function which is strict in its
74 -- argument if the Demand so indicates.
76 instance Outputable AbsVal where
77 ppr sty AbsTop = ppPStr SLIT("AbsTop")
78 ppr sty AbsBot = ppPStr SLIT("AbsBot")
79 ppr sty (AbsProd prod) = ppCat [ppPStr SLIT("AbsProd"), ppr sty prod]
80 ppr sty (AbsFun arg body env)
81 = ppCat [ppPStr SLIT("AbsFun{"), ppr sty arg,
82 ppPStr SLIT("???"), -- ppStr "}{env:", ppr sty (keysFM env `zip` eltsFM env),
84 ppr sty (AbsApproxFun demand val)
85 = ppCat [ppPStr SLIT("AbsApprox "), ppr sty demand, ppr sty val ]
90 An @AbsValEnv@ maps @Ids@ to @AbsVals@. Any unbound @Ids@ are
91 implicitly bound to @AbsTop@, the completely uninformative,
92 pessimistic value---see @absEval@ of a @Var@.
95 data AbsValEnv = AbsValEnv StrAnalFlags (IdEnv AbsVal)
98 = (Bool, -- True <=> AllStrict flag is set
99 Bool) -- True <=> NumbersStrict flag is set
101 type StrictEnv = AbsValEnv -- Environment for strictness analysis
102 type AbsenceEnv = AbsValEnv -- Environment for absence analysis
104 nullAbsValEnv flags -- this is the one and only way to create AbsValEnvs
105 = AbsValEnv flags nullIdEnv
107 addOneToAbsValEnv (AbsValEnv x idenv) y z = AbsValEnv x (addOneToIdEnv idenv y z)
108 growAbsValEnvList (AbsValEnv x idenv) ys = AbsValEnv x (growIdEnvList idenv ys)
110 lookupAbsValEnv (AbsValEnv _ idenv) y
111 = lookupIdEnv idenv y
113 getStrAnalFlags (AbsValEnv flags _) = flags
117 absValFromStrictness :: AnalysisKind -> StrictnessInfo bdee -> AbsVal
119 absValFromStrictness anal NoStrictnessInfo = AbsTop
121 absValFromStrictness StrAnal BottomGuaranteed = AbsBot -- Guaranteed bottom
122 absValFromStrictness AbsAnal BottomGuaranteed = AbsTop -- Check for poison in
123 -- arguments (if any)
124 absValFromStrictness anal (StrictnessInfo args_info _) = foldr AbsApproxFun AbsTop args_info