Improve hashing of expressions for CSE (reduces warnings about extendCSEnv)

[ghc-hetmet.git] / compiler / simplCore / CSE.lhs

diff --git a/compiler/simplCore/CSE.lhs b/compiler/simplCore/CSE.lhs
index 3cec4a1..f8259c7 100644 (file)
--- a/compiler/simplCore/CSE.lhs
+++ b/compiler/simplCore/CSE.lhs
@@ -157,7 +157,7 @@ bar will be inlined (when it should not be). Even if we remove INLINE foo,
 we'd still like foo to be inlined if rhs is small. This won't happen
 with foo = bar.
 
-Not CSE-ing inside INLLINE also solves an annoying bug in CSE. Consider
+Not CSE-ing inside INLINE also solves an annoying bug in CSE. Consider
 a worker/wrapper, in which the worker has turned into a single variable:
        $wf = h
        f = \x -> ...$wf...
@@ -223,6 +223,7 @@ cseExpr env (Var v)            = Var (lookupSubst env v)
 cseExpr env (App f a)             = App (cseExpr env f) (tryForCSE env a)
 cseExpr evn (Note InlineMe e)     = Note InlineMe e    -- See Note [INLINE and NOINLINE]
 cseExpr env (Note n e)            = Note n (cseExpr env e)
+cseExpr env (Cast e co)            = Cast (cseExpr env e) co
 cseExpr env (Lam b e)             = let (env', b') = addBinder env b
                                     in Lam b' (cseExpr env' e)
 cseExpr env (Let bind e)          = let (env', bind') = cseBind env bind
@@ -314,7 +315,9 @@ extendCSEnv (CS cs in_scope sub) expr expr'
   = CS (addToUFM_C combine cs hash [(expr, expr')]) in_scope sub
   where
     hash   = hashExpr expr
-    combine old new = WARN( result `lengthExceeds` 4, text "extendCSEnv: long list:" <+> ppr result )
+    combine old new = WARN( result `lengthExceeds` 4, ((text "extendCSEnv: long list (length" <+> int (length result) <> comma 
+                                                       <+> text "hash code" <+> text (show hash) <> char ')')
+                                                       $$ nest 4 (ppr result)) )
                      result
                    where
                      result = new ++ old