[project @ 1997-05-18 23:04:57 by sof]

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

diff --git a/ghc/compiler/stranal/SaLib.lhs b/ghc/compiler/stranal/SaLib.lhs
index 52f6650..13a89ce 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,24 +11,25 @@ See also: the ``library'' for the ``back end'' (@SaBackLib@).
 module SaLib (
        AbsVal(..),
        AnalysisKind(..),
-       AbsValEnv{-abstract-}, StrictEnv(..), AbsenceEnv(..),
-       StrAnalFlags(..), getStrAnalFlags,
+       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-}, SYN_IE(Id)
+                       )
+import IdInfo          ( StrictnessInfo(..) )
+import Demand          ( Demand{-instance Outputable-} )
+import Outputable      ( Outputable(..){-instance * []-} )
+import PprType         ( GenType{-instance Outputable-} )
+import Pretty          ( ptext, hsep, char )
 \end{code}
 
 %************************************************************************
@@ -63,35 +64,32 @@ data AbsVal
                            --    AbsProd [AbsBot, ..., AbsBot]
 
   | AbsFun                 -- An abstract function, with the given:
-           [Id]            -- arguments
-           PlainCoreExpr   -- body
+           Id              -- argument
+           CoreExpr        -- body
            AbsValEnv       -- and environment
 
   | AbsApproxFun           -- This is used to represent a coarse
-           [Demand]        -- approximation to a function value.  It's an
-                           -- abstract function which is strict in its i'th
-                           -- argument if the i'th element of the Demand
-                           -- list so indicates.
-                           -- The list of arguments is always non-empty.
-                           -- In effect, AbsApproxFun [] = AbsTop 
+           Demand          -- approximation to a function value.  It's an
+           AbsVal          -- abstract function which is strict in its
+                           -- argument if the  Demand so indicates.
 
 instance Outputable AbsVal where
-    ppr sty AbsTop = ppStr "AbsTop"
-    ppr sty AbsBot = ppStr "AbsBot"
-    ppr sty (AbsProd prod) = ppCat [ppStr "AbsProd", ppr sty prod]
-    ppr sty (AbsFun args body env)
-      = ppCat [ppStr "AbsFun{", ppr sty args,
-              ppStr "???", -- ppStr "}{env:", ppr sty (keysFM env `zip` eltsFM env),
-              ppStr "}" ]
-    ppr sty (AbsApproxFun demands)
-      = ppCat [ppStr "AbsApprox{", ppr sty demands, ppStr "}" ]
+    ppr sty AbsTop = ptext SLIT("AbsTop")
+    ppr sty AbsBot = ptext SLIT("AbsBot")
+    ppr sty (AbsProd prod) = hsep [ptext SLIT("AbsProd"), ppr sty prod]
+    ppr sty (AbsFun arg body env)
+      = hsep [ptext SLIT("AbsFun{"), ppr sty arg,
+              ptext SLIT("???"), -- text "}{env:", ppr sty (keysFM env `zip` eltsFM env),
+              char '}' ]
+    ppr sty (AbsApproxFun demand val)
+      = hsep [ptext SLIT("AbsApprox "), ppr sty demand, ppr sty val ]
 \end{code}
 
 %-----------
 
 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)
@@ -116,13 +114,12 @@ getStrAnalFlags (AbsValEnv flags _) = flags
 \end{code}
 
 \begin{code}
-absValFromStrictness :: AnalysisKind -> StrictnessInfo -> AbsVal
+absValFromStrictness :: AnalysisKind -> StrictnessInfo bdee -> AbsVal
 
 absValFromStrictness anal NoStrictnessInfo            = AbsTop
 
 absValFromStrictness StrAnal BottomGuaranteed         = AbsBot -- Guaranteed bottom
 absValFromStrictness AbsAnal BottomGuaranteed         = AbsTop -- Check for poison in
                                                                -- arguments (if any)
-absValFromStrictness anal (StrictnessInfo []        _) = AbsTop
-absValFromStrictness anal (StrictnessInfo args_info _) = AbsApproxFun args_info
+absValFromStrictness anal (StrictnessInfo args_info _) = foldr AbsApproxFun AbsTop args_info
 \end{code}