X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fstranal%2FSaLib.lhs;h=ac9c267916ab8dfb68c2a1b54f1d451e7b3abeed;hb=d9fe1d1dba2f78c10df8fd622952b4c1d057b78b;hp=e97480f0b381ed51fb9d4e5b27c4b4a16afcbe8f;hpb=438596897ebbe25a07e1c82085cfbc5bdb00f09e;p=ghc-hetmet.git

diff --git a/ghc/compiler/stranal/SaLib.lhs b/ghc/compiler/stranal/SaLib.lhs
index e97480f..ac9c267 100644
--- a/ghc/compiler/stranal/SaLib.lhs
+++ b/ghc/compiler/stranal/SaLib.lhs
@@ -18,11 +18,10 @@ module SaLib (
 
 #include "HsVersions.h"
 
-import Id		( Id )
-import CoreSyn		( CoreExpr )
+import Type		( Type )
 import VarEnv
 import IdInfo		( StrictnessInfo(..) )
-import Demand		( Demand, pprDemands )
+import Demand		( Demand )
 import Outputable
 \end{code}
 
@@ -38,7 +37,7 @@ import Outputable
 data AnalysisKind
   = StrAnal 	-- We're doing strictness analysis
   | AbsAnal	-- We're doing absence analysis
-  deriving Text
+  deriving Show
 \end{code}
 
 @AbsVal@ is the data type of HNF abstract values.
@@ -58,14 +57,14 @@ data AbsVal
 			    --    AbsProd [AbsBot, ..., AbsBot]
 
   | AbsFun	    	    -- An abstract function, with the given:
-	    Id		    -- argument
-	    CoreExpr	    -- body
-	    AbsValEnv	    -- and environment
+	    Type	   	 -- Type of the *argument* to the function
+	    (AbsVal -> AbsVal)	-- The function
 
   | AbsApproxFun	    -- This is used to represent a coarse
 	    [Demand]	    -- approximation to a function value.  It's an
 	    AbsVal	    -- abstract function which is strict in its
 			    -- arguments if the  Demand so indicates.
+	-- INVARIANT: the [Demand] is non-empty
 
 	-- AbsApproxFun has to take a *list* of demands, no just one,
 	-- because function spaces are now lifted.  Hence, (f bot top)
@@ -80,12 +79,9 @@ instance Outputable AbsVal where
     ppr AbsTop = ptext SLIT("AbsTop")
     ppr AbsBot = ptext SLIT("AbsBot")
     ppr (AbsProd prod) = hsep [ptext SLIT("AbsProd"), ppr prod]
-    ppr (AbsFun arg body env)
-      = hsep [ptext SLIT("AbsFun{"), ppr arg,
-	       ptext SLIT("???"), -- text "}{env:", ppr (keysFM env `zip` eltsFM env),
-	       char '}' ]
+    ppr (AbsFun bndr_ty body) = ptext SLIT("AbsFun")
     ppr (AbsApproxFun demands val)
-      = hsep [ptext SLIT("AbsApprox "), pprDemands demands, ppr val]
+      = ptext SLIT("AbsApprox") <+> brackets (interpp'SP demands) <+> ppr val
 \end{code}
 
 %-----------
@@ -113,10 +109,14 @@ lookupAbsValEnv (AbsValEnv idenv) y
 \begin{code}
 absValFromStrictness :: AnalysisKind -> StrictnessInfo -> 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 args_info _) = AbsApproxFun args_info AbsTop
+absValFromStrictness anal NoStrictnessInfo = AbsTop
+absValFromStrictness anal (StrictnessInfo args_info bot_result)
+  = case args_info of	-- Check the invariant that the arg list on 
+	[] -> res	-- AbsApproxFun is non-empty
+	_  -> AbsApproxFun args_info res
+  where
+    res | not bot_result = AbsTop
+	| otherwise      = case anal of
+				StrAnal -> AbsBot
+				AbsAnal -> AbsTop
 \end{code}