[project @ 2000-12-11 15:26:00 by sewardj]

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

diff --git a/ghc/compiler/stranal/SaAbsInt.lhs b/ghc/compiler/stranal/SaAbsInt.lhs
index 32b3469..47afd99 100644 (file)
--- a/ghc/compiler/stranal/SaAbsInt.lhs
+++ b/ghc/compiler/stranal/SaAbsInt.lhs
@@ -17,16 +17,16 @@ module SaAbsInt (
 
 import CmdLineOpts     ( opt_AllStrict, opt_NumbersStrict )
 import CoreSyn
-import CoreUnfold      ( Unfolding, maybeUnfoldingTemplate )
-import Id              ( Id, idType, idArity, idStrictness, idUnfolding, isDataConId_maybe )
+import CoreUnfold      ( maybeUnfoldingTemplate )
+import Id              ( Id, idType, idStrictness, idUnfolding, isDataConId_maybe )
 import DataCon         ( dataConTyCon, splitProductType_maybe, dataConRepArgTys )
 import IdInfo          ( StrictnessInfo(..) )
-import Demand          ( Demand(..), wwPrim, wwStrict, wwEnum, wwUnpackData, wwLazy, wwUnpackNew,
+import Demand          ( Demand(..), wwPrim, wwStrict, wwUnpackData, wwLazy, wwUnpackNew,
                          mkStrictnessInfo, isLazy
                        )
 import SaLib
-import TyCon           ( isProductTyCon, isRecursiveTyCon, isEnumerationTyCon, isNewTyCon )
-import BasicTypes      ( Arity, NewOrData(..) )
+import TyCon           ( isProductTyCon, isRecursiveTyCon, isNewTyCon )
+import BasicTypes      ( NewOrData(..) )
 import Type            ( splitTyConApp_maybe, 
                          isUnLiftedType, Type )
 import TyCon           ( tyConUnique )
@@ -605,7 +605,9 @@ findStrictness id (AbsApproxFun str_ds str_res) (AbsApproxFun abs_ds _)
        -- See notes with WwLib.worthSplitting
   = find_strictness id str_ds str_res abs_ds
 
-findStrictness id str_val abs_val = NoStrictnessInfo
+findStrictness id str_val abs_val 
+  | isBot str_val = mkStrictnessInfo ([], True)
+  | otherwise     = NoStrictnessInfo
 
 -- The list of absence demands passed to combineDemands 
 -- can be shorter than the list of absence demands
@@ -814,19 +816,6 @@ cheapFixpoint anal ids rhss env
          AbsAnal -> AbsBot
 \end{code}
 
-\begin{verbatim}
-mkLookupFun :: (key -> key -> Bool)    -- Equality predicate
-           -> (key -> key -> Bool)     -- Less-than predicate
-           -> [(key,val)]              -- The assoc list
-           -> key                      -- The key
-           -> Maybe val                -- The corresponding value
-
-mkLookupFun eq lt alist s
-  = case [a | (s',a) <- alist, s' `eq` s] of
-      []    -> Nothing
-      (a:_) -> Just a
-\end{verbatim}
-
 \begin{code}
 fixpoint :: AnalysisKind -> [Id] -> [CoreExpr] -> AbsValEnv -> [AbsVal]