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