[project @ 1996-12-19 09:10:02 by simonpj]

[ghc-hetmet.git] / ghc / compiler / stranal / SaLib.lhs

diff --git a/ghc/compiler/stranal/SaLib.lhs b/ghc/compiler/stranal/SaLib.lhs
index 873bfbe..e3fd7ab 100644 (file)
--- a/ghc/compiler/stranal/SaLib.lhs
+++ b/ghc/compiler/stranal/SaLib.lhs
@@ -1,5 +1,5 @@
 %
-% (c) The GRASP/AQUA Project, Glasgow University, 1993-1995
+% (c) The GRASP/AQUA Project, Glasgow University, 1993-1996
 %
 \section[SaLib]{Basic datatypes, functions for the strictness analyser}
 
@@ -11,23 +11,25 @@ See also: the ``library'' for the ``back end'' (@SaBackLib@).
 module SaLib (
        AbsVal(..),
        AnalysisKind(..),
-       AbsValEnv{-abstract-}, StrictEnv(..), AbsenceEnv(..),
+       AbsValEnv{-abstract-}, SYN_IE(StrictEnv), SYN_IE(AbsenceEnv),
+       SYN_IE(StrAnalFlags), getStrAnalFlags,
        nullAbsValEnv, addOneToAbsValEnv, growAbsValEnvList,
        lookupAbsValEnv,
-       absValFromStrictness,
-
-       -- and to make the interface self-sufficient...
-       CoreExpr, Id, IdEnv(..), UniqFM, Unique,
-       Demand, PlainCoreExpr(..)
+       absValFromStrictness
     ) where
 
-import IdEnv
-import IdInfo
---import FiniteMap     -- debugging only
-import Outputable
-import PlainCore
-import Pretty
-import Util            -- for pragmas only
+IMP_Ubiq(){-uitous-}
+
+import CoreSyn         ( SYN_IE(CoreExpr) )
+import Id              ( nullIdEnv, addOneToIdEnv, growIdEnvList,
+                         lookupIdEnv, SYN_IE(IdEnv),
+                         GenId{-instance Outputable-}
+                       )
+import IdInfo          ( StrictnessInfo(..) )
+import Demand          ( Demand{-instance Outputable-} )
+import Outputable      ( Outputable(..){-instance * []-} )
+import PprType         ( GenType{-instance Outputable-} )
+import Pretty          ( ppStr, ppCat )
 \end{code}
 
 %************************************************************************
@@ -63,7 +65,7 @@ data AbsVal
 
   | AbsFun                 -- An abstract function, with the given:
            [Id]            -- arguments
-           PlainCoreExpr   -- body
+           CoreExpr   -- body
            AbsValEnv       -- and environment
 
   | AbsApproxFun           -- This is used to represent a coarse
@@ -72,7 +74,7 @@ data AbsVal
                            -- argument if the i'th element of the Demand
                            -- list so indicates.
                            -- The list of arguments is always non-empty.
-                           -- In effect, AbsApproxFun [] = AbsTop 
+                           -- In effect, AbsApproxFun [] = AbsTop
 
 instance Outputable AbsVal where
     ppr sty AbsTop = ppStr "AbsTop"
@@ -90,27 +92,32 @@ instance Outputable AbsVal where
 
 An @AbsValEnv@ maps @Ids@ to @AbsVals@.  Any unbound @Ids@ are
 implicitly bound to @AbsTop@, the completely uninformative,
-pessimistic value---see @absEval@ of a @CoVar@.
+pessimistic value---see @absEval@ of a @Var@.
 
 \begin{code}
 data AbsValEnv = AbsValEnv StrAnalFlags (IdEnv AbsVal)
-type StrAnalFlags = Bool       -- True <=> make everything strict
+
+type StrAnalFlags
+  = (Bool,     -- True <=> AllStrict flag is set
+     Bool)     -- True <=> NumbersStrict flag is set
 
 type StrictEnv  = AbsValEnv    -- Environment for strictness analysis
 type AbsenceEnv = AbsValEnv    -- Environment for absence analysis
 
-nullAbsValEnv x = AbsValEnv x nullIdEnv
+nullAbsValEnv flags -- this is the one and only way to create AbsValEnvs
+  = AbsValEnv flags nullIdEnv
+
 addOneToAbsValEnv (AbsValEnv x idenv) y z = AbsValEnv x (addOneToIdEnv idenv y z)
 growAbsValEnvList (AbsValEnv x idenv) ys  = AbsValEnv x (growIdEnvList idenv ys)
 
-lookupAbsValEnv (AbsValEnv do_all_strict idenv) y
-  = if do_all_strict
-    then Just AbsBot
-    else lookupIdEnv idenv y
+lookupAbsValEnv (AbsValEnv _ idenv) y
+  = lookupIdEnv idenv y
+
+getStrAnalFlags (AbsValEnv flags _) = flags
 \end{code}
 
 \begin{code}
-absValFromStrictness :: AnalysisKind -> StrictnessInfo -> AbsVal
+absValFromStrictness :: AnalysisKind -> StrictnessInfo bdee -> AbsVal
 
 absValFromStrictness anal NoStrictnessInfo            = AbsTop