X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fstranal%2FSaLib.lhs;h=3f5c7fa93f39e1e3ac3ad807f659fb57bcee6bba;hb=1fb1ab5d53a09607e7f6d2450806760688396387;hp=ef42acde13faacc6853a333af0222a09a581961e;hpb=7d61cb61daa5e433a0cb85b34b7f0c58b2f961ff;p=ghc-hetmet.git

diff --git a/ghc/compiler/stranal/SaLib.lhs b/ghc/compiler/stranal/SaLib.lhs
index ef42acd..3f5c7fa 100644
--- a/ghc/compiler/stranal/SaLib.lhs
+++ b/ghc/compiler/stranal/SaLib.lhs
@@ -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
     ) where
 
-import Ubiq{-uitous-}
+IMP_Ubiq(){-uitous-}
 
-import CoreSyn		( CoreExpr(..) )
+import CoreSyn		( SYN_IE(CoreExpr) )
 import Id		( nullIdEnv, addOneToIdEnv, growIdEnvList,
-			  lookupIdEnv, IdEnv(..),
+			  lookupIdEnv, SYN_IE(IdEnv),
 			  GenId{-instance Outputable-}
 			)
-import IdInfo		( StrictnessInfo(..), Demand{-instance Outputable-} )
+import IdInfo		( StrictnessInfo(..) )
+import Demand		( Demand{-instance Outputable-} )
 import Outputable	( Outputable(..){-instance * []-} )
 import PprType		( GenType{-instance Outputable-} )
-import Pretty		( ppStr, ppCat )
+import Pretty		( ppPStr, ppCat, ppChar )
 \end{code}
 
 %************************************************************************
@@ -63,28 +64,25 @@ data AbsVal
 			    --    AbsProd [AbsBot, ..., AbsBot]
 
   | AbsFun	    	    -- An abstract function, with the given:
-	    [Id]	    -- arguments
-	    CoreExpr   -- 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 = ppPStr SLIT("AbsTop")
+    ppr sty AbsBot = ppPStr SLIT("AbsBot")
+    ppr sty (AbsProd prod) = ppCat [ppPStr SLIT("AbsProd"), ppr sty prod]
+    ppr sty (AbsFun arg body env)
+      = ppCat [ppPStr SLIT("AbsFun{"), ppr sty arg,
+	       ppPStr SLIT("???"), -- ppStr "}{env:", ppr sty (keysFM env `zip` eltsFM env),
+	       ppChar '}' ]
+    ppr sty (AbsApproxFun demand val)
+      = ppCat [ppPStr SLIT("AbsApprox "), ppr sty demand, ppr sty val ]
 \end{code}
 
 %-----------
@@ -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}