compiler/stranal/SaLib.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
   3 %
   4 \section[SaLib]{Basic datatypes, functions for the strictness analyser}
   5
   6 See also: the ``library'' for the ``back end'' (@SaBackLib@).
   7
   8 \begin{code}
   9 #ifndef OLD_STRICTNESS
  10 module SaLib () where
  11 #else
  12
  13 module SaLib (
  14         AbsVal(..),
  15         AnalysisKind(..),
  16         AbsValEnv{-abstract-}, StrictEnv, AbsenceEnv,
  17         mkAbsApproxFun,
  18         nullAbsValEnv, addOneToAbsValEnv, growAbsValEnvList,
  19         lookupAbsValEnv,
  20         absValFromStrictness
  21     ) where
  22
  23 #include "HsVersions.h"
  24
  25 import Type             ( Type )
  26 import VarEnv
  27 import IdInfo           ( StrictnessInfo(..) )
  28 import Demand           ( Demand )
  29 import Outputable
  30 \end{code}
  31
  32 %************************************************************************
  33 %*                                                                      *
  34 \subsection[AbsVal-datatype]{@AbsVal@: abstract values (and @AbsValEnv@)}
  35 %*                                                                      *
  36 %************************************************************************
  37
  38 @AnalysisKind@ tells what kind of analysis is being done.
  39
  40 \begin{code}
  41 data AnalysisKind
  42   = StrAnal     -- We're doing strictness analysis
  43   | AbsAnal     -- We're doing absence analysis
  44   deriving Show
  45 \end{code}
  46
  47 @AbsVal@ is the data type of HNF abstract values.
  48
  49 \begin{code}
  50 data AbsVal
  51   = AbsTop                  -- AbsTop is the completely uninformative
  52                             -- value
  53
  54   | AbsBot                  -- An expression whose abstract value is
  55                             -- AbsBot is sure to fail to terminate.
  56                             -- AbsBot represents the abstract
  57                             --  *function* bottom too.
  58
  59   | AbsProd [AbsVal]        -- (Lifted) product of abstract values
  60                             -- "Lifted" means that AbsBot is *different* from
  61                             --    AbsProd [AbsBot, ..., AbsBot]
  62
  63   | AbsFun                  -- An abstract function, with the given:
  64             Type                 -- Type of the *argument* to the function
  65             (AbsVal -> AbsVal)  -- The function
  66
  67   | AbsApproxFun            -- This is used to represent a coarse
  68             [Demand]        -- approximation to a function value.  It's an
  69             AbsVal          -- abstract function which is strict in its
  70                             -- arguments if the  Demand so indicates.
  71         -- INVARIANT: the [Demand] is non-empty
  72
  73         -- AbsApproxFun has to take a *list* of demands, no just one,
  74         -- because function spaces are now lifted.  Hence, (f bot top)
  75         -- might be bot, but the partial application (f bot) is a *function*,
  76         -- not bot.
  77
  78 mkAbsApproxFun :: Demand -> AbsVal -> AbsVal
  79 mkAbsApproxFun d (AbsApproxFun ds val) = AbsApproxFun (d:ds) val
  80 mkAbsApproxFun d val                   = AbsApproxFun [d]    val
  81
  82 instance Outputable AbsVal where
  83     ppr AbsTop = ptext SLIT("AbsTop")
  84     ppr AbsBot = ptext SLIT("AbsBot")
  85     ppr (AbsProd prod) = hsep [ptext SLIT("AbsProd"), ppr prod]
  86     ppr (AbsFun bndr_ty body) = ptext SLIT("AbsFun")
  87     ppr (AbsApproxFun demands val)
  88       = ptext SLIT("AbsApprox") <+> brackets (interpp'SP demands) <+> ppr val
  89 \end{code}
  90
  91 %-----------
  92
  93 An @AbsValEnv@ maps @Ids@ to @AbsVals@.  Any unbound @Ids@ are
  94 implicitly bound to @AbsTop@, the completely uninformative,
  95 pessimistic value---see @absEval@ of a @Var@.
  96
  97 \begin{code}
  98 newtype AbsValEnv = AbsValEnv (IdEnv AbsVal)
  99
 100 type StrictEnv  = AbsValEnv     -- Environment for strictness analysis
 101 type AbsenceEnv = AbsValEnv     -- Environment for absence analysis
 102
 103 nullAbsValEnv -- this is the one and only way to create AbsValEnvs
 104   = AbsValEnv emptyVarEnv
 105
 106 addOneToAbsValEnv (AbsValEnv idenv) y z = AbsValEnv (extendVarEnv idenv y z)
 107 growAbsValEnvList (AbsValEnv idenv) ys  = AbsValEnv (extendVarEnvList idenv ys)
 108
 109 lookupAbsValEnv (AbsValEnv idenv) y
 110   = lookupVarEnv idenv y
 111 \end{code}
 112
 113 \begin{code}
 114 absValFromStrictness :: AnalysisKind -> StrictnessInfo -> AbsVal
 115
 116 absValFromStrictness anal NoStrictnessInfo = AbsTop
 117 absValFromStrictness anal (StrictnessInfo args_info bot_result)
 118   = case args_info of   -- Check the invariant that the arg list on
 119         [] -> res       -- AbsApproxFun is non-empty
 120         _  -> AbsApproxFun args_info res
 121   where
 122     res | not bot_result = AbsTop
 123         | otherwise      = case anal of
 124                                 StrAnal -> AbsBot
 125                                 AbsAnal -> AbsTop
 126 \end{code}
 127
 128 \begin{code}
 129 #endif /* OLD_STRICTNESS */
 130 \end{code}