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