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