[project @ 1998-12-02 13:17:09 by simonm]

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

diff --git a/ghc/compiler/stranal/SaLib.lhs b/ghc/compiler/stranal/SaLib.lhs
index 9b6751c..e97480f 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-1996
+% (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
 %
 \section[SaLib]{Basic datatypes, functions for the strictness analyser}
 
@@ -10,6 +10,7 @@ module SaLib (
        AbsVal(..),
        AnalysisKind(..),
        AbsValEnv{-abstract-}, StrictEnv, AbsenceEnv,
+       mkAbsApproxFun,
        nullAbsValEnv, addOneToAbsValEnv, growAbsValEnvList,
        lookupAbsValEnv,
        absValFromStrictness
@@ -17,13 +18,11 @@ module SaLib (
 
 #include "HsVersions.h"
 
+import Id              ( Id )
 import CoreSyn         ( CoreExpr )
-import Id              ( nullIdEnv, addOneToIdEnv, growIdEnvList,
-                         lookupIdEnv, IdEnv,
-                         Id
-                       )
+import VarEnv
 import IdInfo          ( StrictnessInfo(..) )
-import Demand          ( Demand{-instance Outputable-} )
+import Demand          ( Demand, pprDemands )
 import Outputable
 \end{code}
 
@@ -64,9 +63,18 @@ data AbsVal
            AbsValEnv       -- and environment
 
   | AbsApproxFun           -- This is used to represent a coarse
-           Demand          -- approximation to a function value.  It's an
+           [Demand]        -- approximation to a function value.  It's an
            AbsVal          -- abstract function which is strict in its
-                           -- argument if the  Demand so indicates.
+                           -- arguments if the  Demand so indicates.
+
+       -- AbsApproxFun has to take a *list* of demands, no just one,
+       -- because function spaces are now lifted.  Hence, (f bot top)
+       -- might be bot, but the partial application (f bot) is a *function*,
+       -- not bot.
+
+mkAbsApproxFun :: Demand -> AbsVal -> AbsVal
+mkAbsApproxFun d (AbsApproxFun ds val) = AbsApproxFun (d:ds) val
+mkAbsApproxFun d val                  = AbsApproxFun [d]    val
 
 instance Outputable AbsVal where
     ppr AbsTop = ptext SLIT("AbsTop")
@@ -76,8 +84,8 @@ instance Outputable AbsVal where
       = hsep [ptext SLIT("AbsFun{"), ppr arg,
               ptext SLIT("???"), -- text "}{env:", ppr (keysFM env `zip` eltsFM env),
               char '}' ]
-    ppr (AbsApproxFun demand val)
-      = hsep [ptext SLIT("AbsApprox "), ppr demand, ppr val]
+    ppr (AbsApproxFun demands val)
+      = hsep [ptext SLIT("AbsApprox "), pprDemands demands, ppr val]
 \end{code}
 
 %-----------
@@ -93,13 +101,13 @@ type StrictEnv  = AbsValEnv        -- Environment for strictness analysis
 type AbsenceEnv = AbsValEnv    -- Environment for absence analysis
 
 nullAbsValEnv -- this is the one and only way to create AbsValEnvs
-  = AbsValEnv nullIdEnv
+  = AbsValEnv emptyVarEnv
 
-addOneToAbsValEnv (AbsValEnv idenv) y z = AbsValEnv (addOneToIdEnv idenv y z)
-growAbsValEnvList (AbsValEnv idenv) ys  = AbsValEnv (growIdEnvList idenv ys)
+addOneToAbsValEnv (AbsValEnv idenv) y z = AbsValEnv (extendVarEnv idenv y z)
+growAbsValEnvList (AbsValEnv idenv) ys  = AbsValEnv (extendVarEnvList idenv ys)
 
 lookupAbsValEnv (AbsValEnv idenv) y
-  = lookupIdEnv idenv y
+  = lookupVarEnv idenv y
 \end{code}
 
 \begin{code}
@@ -110,5 +118,5 @@ absValFromStrictness anal NoStrictnessInfo         = AbsTop
 absValFromStrictness StrAnal BottomGuaranteed         = AbsBot -- Guaranteed bottom
 absValFromStrictness AbsAnal BottomGuaranteed         = AbsTop -- Check for poison in
                                                                -- arguments (if any)
-absValFromStrictness anal (StrictnessInfo args_info _) = foldr AbsApproxFun AbsTop args_info
+absValFromStrictness anal (StrictnessInfo args_info _) = AbsApproxFun args_info AbsTop
 \end{code}