[project @ 2001-08-04 06:19:54 by ken]

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

diff --git a/ghc/compiler/stranal/SaAbsInt.lhs b/ghc/compiler/stranal/SaAbsInt.lhs
index 82a2b47..14bb2df 100644 (file)
--- a/ghc/compiler/stranal/SaAbsInt.lhs
+++ b/ghc/compiler/stranal/SaAbsInt.lhs
@@ -293,8 +293,12 @@ evalStrictness (WwUnpack _ demand_info) val
   = case val of
       AbsTop      -> False
       AbsBot      -> True
-      AbsProd vals -> or (zipWithEqual "evalStrictness" evalStrictness demand_info vals)
-      _                   -> pprTrace "evalStrictness?" empty False
+      AbsProd vals
+          | length vals /= length demand_info -> pprTrace "TELL SIMON: evalStrictness" (ppr demand_info $$ ppr val)
+                                                 False
+          | otherwise -> or (zipWithEqual "evalStrictness" evalStrictness demand_info vals)
+
+      _                       -> pprTrace "evalStrictness?" empty False
 
 evalStrictness WwPrim val
   = case val of
@@ -318,8 +322,13 @@ evalAbsence (WwUnpack _ demand_info) val
   = case val of
        AbsTop       -> False           -- No poison in here
        AbsBot       -> True            -- Pure poison
-       AbsProd vals -> or (zipWithEqual "evalAbsence" evalAbsence demand_info vals)
-       _            -> panic "evalAbsence: other"
+       AbsProd vals 
+          | length vals /= length demand_info -> pprTrace "TELL SIMON: evalAbsence" (ppr demand_info $$ ppr val)
+                                                 True
+          | otherwise -> or (zipWithEqual "evalAbsence" evalAbsence demand_info vals)
+       _              -> pprTrace "TELL SIMON: evalAbsence" 
+                               (ppr demand_info $$ ppr val)
+                         True
 
 evalAbsence other val = anyBot val
   -- The demand is conservative; even "Lazy" *might* evaluate the
@@ -505,6 +514,11 @@ absEval anal (Let (Rec pairs) body) env
     in
     absEval anal body new_env
 
+absEval anal (Note (Coerce _ _) expr) env = AbsTop
+       -- Don't look inside coerces, becuase they
+       -- are usually recursive newtypes
+       -- (Could improve, for the error case, but we're about
+       -- to kill this analyser anyway.)
 absEval anal (Note note expr) env = absEval anal expr env
 \end{code}