ghc/compiler/coreSyn/CoreUtils.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 \section[CoreUtils]{Utility functions on @Core@ syntax}
   5
   6 \begin{code}
   7 module CoreUtils (
   8         exprType, coreAltsType,
   9
  10         mkNote, mkInlineMe, mkSCC, mkCoerce,
  11
  12         exprIsBottom, exprIsDupable, exprIsTrivial, exprIsCheap,
  13         exprIsValue,exprOkForSpeculation, exprIsBig,
  14         exprArity,
  15
  16         idAppIsBottom, idAppIsCheap,
  17
  18         etaReduceExpr, exprEtaExpandArity,
  19
  20         hashExpr,
  21
  22         cheapEqExpr, eqExpr, applyTypeToArgs
  23     ) where
  24
  25 #include "HsVersions.h"
  26
  27
  28 import {-# SOURCE #-} CoreUnfold        ( isEvaldUnfolding )
  29
  30 import GlaExts          -- For `xori`
  31
  32 import CoreSyn
  33 import CoreFVs          ( exprFreeVars )
  34 import PprCore          ( pprCoreExpr )
  35 import Var              ( isId, isTyVar )
  36 import VarSet
  37 import VarEnv
  38 import Name             ( isLocallyDefined, hashName )
  39 import Literal          ( Literal, hashLiteral, literalType )
  40 import PrimOp           ( primOpOkForSpeculation, primOpIsCheap )
  41 import Id               ( Id, idType, idFlavour, idStrictness, idLBVarInfo,
  42                           idArity, idName, idUnfolding, idInfo
  43                         )
  44 import IdInfo           ( arityLowerBound, InlinePragInfo(..),
  45                           LBVarInfo(..),
  46                           IdFlavour(..),
  47                           appIsBottom
  48                         )
  49 import Type             ( Type, mkFunTy, mkForAllTy,
  50                           splitFunTy_maybe, tyVarsOfType, tyVarsOfTypes,
  51                           isNotUsgTy, mkUsgTy, unUsgTy, UsageAnn(..),
  52                           applyTys, isUnLiftedType
  53                         )
  54 import CostCentre       ( CostCentre )
  55 import Unique           ( buildIdKey, augmentIdKey )
  56 import Util             ( zipWithEqual, mapAccumL )
  57 import Outputable
  58 import TysPrim          ( alphaTy )     -- Debugging only
  59 \end{code}
  60
  61
  62 %************************************************************************
  63 %*                                                                      *
  64 \subsection{Find the type of a Core atom/expression}
  65 %*                                                                      *
  66 %************************************************************************
  67
  68 \begin{code}
  69 exprType :: CoreExpr -> Type
  70
  71 exprType (Var var)              = idType var
  72 exprType (Lit lit)              = literalType lit
  73 exprType (Let _ body)           = exprType body
  74 exprType (Case _ _ alts)        = coreAltsType alts
  75 exprType (Note (Coerce ty _) e) = ty  -- **! should take usage from e
  76 exprType (Note (TermUsg u) e)   = mkUsgTy u (unUsgTy (exprType e))
  77 exprType (Note other_note e)    = exprType e
  78 exprType (Lam binder expr)
  79   | isId binder    = (case idLBVarInfo binder of
  80                        IsOneShotLambda -> mkUsgTy UsOnce
  81                        otherwise       -> id) $
  82                      idType binder `mkFunTy` exprType expr
  83   | isTyVar binder = mkForAllTy binder (exprType expr)
  84
  85 exprType e@(App _ _)
  86   = case collectArgs e of
  87         (fun, args) -> applyTypeToArgs e (exprType fun) args
  88
  89 exprType other = pprTrace "exprType" (pprCoreExpr other) alphaTy
  90
  91 coreAltsType :: [CoreAlt] -> Type
  92 coreAltsType ((_,_,rhs) : _) = exprType rhs
  93 \end{code}
  94
  95 \begin{code}
  96 -- The first argument is just for debugging
  97 applyTypeToArgs :: CoreExpr -> Type -> [CoreExpr] -> Type
  98 applyTypeToArgs e op_ty [] = op_ty
  99
 100 applyTypeToArgs e op_ty (Type ty : args)
 101   =     -- Accumulate type arguments so we can instantiate all at once
 102     ASSERT2( all isNotUsgTy tys,
 103              ppr e <+> text "of" <+> ppr op_ty <+> text "to" <+>
 104              ppr (Type ty : args) <+> text "i.e." <+> ppr tys )
 105     applyTypeToArgs e (applyTys op_ty tys) rest_args
 106   where
 107     (tys, rest_args)        = go [ty] args
 108     go tys (Type ty : args) = go (ty:tys) args
 109     go tys rest_args        = (reverse tys, rest_args)
 110
 111 applyTypeToArgs e op_ty (other_arg : args)
 112   = case (splitFunTy_maybe op_ty) of
 113         Just (_, res_ty) -> applyTypeToArgs e res_ty args
 114         Nothing -> pprPanic "applyTypeToArgs" (pprCoreExpr e)
 115 \end{code}
 116
 117
 118
 119 %************************************************************************
 120 %*                                                                      *
 121 \subsection{Attaching notes
 122 %*                                                                      *
 123 %************************************************************************
 124
 125 mkNote removes redundant coercions, and SCCs where possible
 126
 127 \begin{code}
 128 mkNote :: Note -> CoreExpr -> CoreExpr
 129 mkNote (Coerce to_ty from_ty) expr = mkCoerce to_ty from_ty expr
 130 mkNote (SCC cc) expr               = mkSCC cc expr
 131 mkNote InlineMe expr               = mkInlineMe expr
 132 mkNote note     expr               = Note note expr
 133
 134 -- Slide InlineCall in around the function
 135 --      No longer necessary I think (SLPJ Apr 99)
 136 -- mkNote InlineCall (App f a) = App (mkNote InlineCall f) a
 137 -- mkNote InlineCall (Var v)   = Note InlineCall (Var v)
 138 -- mkNote InlineCall expr      = expr
 139 \end{code}
 140
 141 Drop trivial InlineMe's.  This is somewhat important, because if we have an unfolding
 142 that looks like (Note InlineMe (Var v)), the InlineMe doesn't go away because it may
 143 not be *applied* to anything.
 144
 145 \begin{code}
 146 mkInlineMe e | exprIsTrivial e = e
 147              | otherwise       = Note InlineMe e
 148 \end{code}
 149
 150
 151
 152 \begin{code}
 153 mkCoerce :: Type -> Type -> Expr b -> Expr b
 154 -- In (mkCoerce to_ty from_ty e), we require that from_ty = exprType e
 155 -- But exprType is defined in CoreUtils, so we don't check the assertion
 156
 157 mkCoerce to_ty from_ty (Note (Coerce to_ty2 from_ty2) expr)
 158   = ASSERT( from_ty == to_ty2 )
 159     mkCoerce to_ty from_ty2 expr
 160
 161 mkCoerce to_ty from_ty expr
 162   | to_ty == from_ty = expr
 163   | otherwise        = Note (Coerce to_ty from_ty) expr
 164 \end{code}
 165
 166 \begin{code}
 167 mkSCC :: CostCentre -> Expr b -> Expr b
 168         -- Note: Nested SCC's *are* preserved for the benefit of
 169         --       cost centre stack profiling (Durham)
 170
 171 mkSCC cc (Lit lit) = Lit lit
 172 mkSCC cc (Lam x e) = Lam x (mkSCC cc e) -- Move _scc_ inside lambda
 173 mkSCC cc expr      = Note (SCC cc) expr
 174 \end{code}
 175
 176
 177 %************************************************************************
 178 %*                                                                      *
 179 \subsection{Figuring out things about expressions}
 180 %*                                                                      *
 181 %************************************************************************
 182
 183 @exprIsTrivial@ is true of expressions we are unconditionally
 184                 happy to duplicate; simple variables and constants,
 185                 and type applications.
 186
 187 @exprIsBottom@  is true of expressions that are guaranteed to diverge
 188
 189
 190 \begin{code}
 191 exprIsTrivial (Type _)       = True
 192 exprIsTrivial (Lit lit)      = True
 193 exprIsTrivial (Var v)        = True
 194 exprIsTrivial (App e arg)    = isTypeArg arg && exprIsTrivial e
 195 exprIsTrivial (Note _ e)     = exprIsTrivial e
 196 exprIsTrivial (Lam b body)   | isTyVar b = exprIsTrivial body
 197 exprIsTrivial other          = False
 198 \end{code}
 199
 200
 201 @exprIsDupable@ is true of expressions that can be duplicated at a modest
 202                 cost in code size.  This will only happen in different case
 203                 branches, so there's no issue about duplicating work.
 204
 205                 That is, exprIsDupable returns True of (f x) even if
 206                 f is very very expensive to call.
 207
 208                 Its only purpose is to avoid fruitless let-binding
 209                 and then inlining of case join points
 210
 211
 212 \begin{code}
 213 exprIsDupable (Type _)       = True
 214 exprIsDupable (Var v)        = True
 215 exprIsDupable (Lit lit)      = True
 216 exprIsDupable (Note _ e)     = exprIsDupable e
 217 exprIsDupable expr
 218   = go expr 0
 219   where
 220     go (Var v)   n_args = True
 221     go (App f a) n_args =  n_args < dupAppSize
 222                         && exprIsDupable a
 223                         && go f (n_args+1)
 224     go other n_args     = False
 225
 226 dupAppSize :: Int
 227 dupAppSize = 4          -- Size of application we are prepared to duplicate
 228 \end{code}
 229
 230 @exprIsCheap@ looks at a Core expression and returns \tr{True} if
 231 it is obviously in weak head normal form, or is cheap to get to WHNF.
 232 [Note that that's not the same as exprIsDupable; an expression might be
 233 big, and hence not dupable, but still cheap.]
 234
 235 By ``cheap'' we mean a computation we're willing to:
 236         push inside a lambda, or
 237         inline at more than one place
 238 That might mean it gets evaluated more than once, instead of being
 239 shared.  The main examples of things which aren't WHNF but are
 240 ``cheap'' are:
 241
 242   *     case e of
 243           pi -> ei
 244
 245         where e, and all the ei are cheap; and
 246
 247   *     let x = e
 248         in b
 249
 250         where e and b are cheap; and
 251
 252   *     op x1 ... xn
 253
 254         where op is a cheap primitive operator
 255
 256   *     error "foo"
 257
 258 Notice that a variable is considered 'cheap': we can push it inside a lambda,
 259 because sharing will make sure it is only evaluated once.
 260
 261 \begin{code}
 262 exprIsCheap :: CoreExpr -> Bool
 263 exprIsCheap (Lit lit)             = True
 264 exprIsCheap (Type _)              = True
 265 exprIsCheap (Var _)               = True
 266 exprIsCheap (Note _ e)            = exprIsCheap e
 267 exprIsCheap (Lam x e)             = if isId x then True else exprIsCheap e
 268 exprIsCheap (Case (Var v) _ alts) = and [exprIsCheap rhs | (_,_,rhs) <- alts]
 269         -- Experimentally, treat (case x of ...) as cheap
 270         -- This improves arities of overloaded functions where
 271         -- there is only dictionary selection (no construction) involved
 272 exprIsCheap other_expr
 273   = go other_expr 0 True
 274   where
 275     go (Var f) n_args args_cheap
 276         = (idAppIsCheap f n_args && args_cheap)
 277                         -- A constructor, cheap primop, or partial application
 278
 279           || idAppIsBottom f n_args
 280                         -- Application of a function which
 281                         -- always gives bottom; we treat this as
 282                         -- a WHNF, because it certainly doesn't
 283                         -- need to be shared!
 284
 285     go (App f a) n_args args_cheap
 286         | isTypeArg a = go f n_args       args_cheap
 287         | otherwise   = go f (n_args + 1) (exprIsCheap a && args_cheap)
 288
 289     go other   n_args args_cheap = False
 290
 291 idAppIsCheap :: Id -> Int -> Bool
 292 idAppIsCheap id n_val_args
 293   | n_val_args == 0 = True      -- Just a type application of
 294                                 -- a variable (f t1 t2 t3)
 295                                 -- counts as WHNF
 296   | otherwise = case idFlavour id of
 297                   DataConId _   -> True
 298                   RecordSelId _ -> True                 -- I'm experimenting with making record selection
 299                                                         -- look cheap, so we will substitute it inside a
 300                                                         -- lambda.  Particularly for dictionary field selection
 301
 302                   PrimOpId op   -> primOpIsCheap op     -- In principle we should worry about primops
 303                                                         -- that return a type variable, since the result
 304                                                         -- might be applied to something, but I'm not going
 305                                                         -- to bother to check the number of args
 306                   other       -> n_val_args < idArity id
 307 \end{code}
 308
 309 exprOkForSpeculation returns True of an expression that it is
 310
 311         * safe to evaluate even if normal order eval might not
 312           evaluate the expression at all, or
 313
 314         * safe *not* to evaluate even if normal order would do so
 315
 316 It returns True iff
 317
 318         the expression guarantees to terminate,
 319         soon,
 320         without raising an exception,
 321         without causing a side effect (e.g. writing a mutable variable)
 322
 323 E.G.
 324         let x = case y# +# 1# of { r# -> I# r# }
 325         in E
 326 ==>
 327         case y# +# 1# of { r# ->
 328         let x = I# r#
 329         in E
 330         }
 331
 332 We can only do this if the (y+1) is ok for speculation: it has no
 333 side effects, and can't diverge or raise an exception.
 334
 335 \begin{code}
 336 exprOkForSpeculation :: CoreExpr -> Bool
 337 exprOkForSpeculation (Lit _)    = True
 338 exprOkForSpeculation (Var v)    = isUnLiftedType (idType v)
 339 exprOkForSpeculation (Note _ e) = exprOkForSpeculation e
 340 exprOkForSpeculation other_expr
 341   = go other_expr 0 True
 342   where
 343     go (Var f) n_args args_ok
 344       = case idFlavour f of
 345           DataConId _ -> True   -- The strictness of the constructor has already
 346                                 -- been expressed by its "wrapper", so we don't need
 347                                 -- to take the arguments into account
 348
 349           PrimOpId op -> primOpOkForSpeculation op && args_ok
 350                                 -- A bit conservative: we don't really need
 351                                 -- to care about lazy arguments, but this is easy
 352
 353           other -> False
 354
 355     go (App f a) n_args args_ok
 356         | isTypeArg a = go f n_args       args_ok
 357         | otherwise   = go f (n_args + 1) (exprOkForSpeculation a && args_ok)
 358
 359     go other n_args args_ok = False
 360 \end{code}
 361
 362
 363 \begin{code}
 364 exprIsBottom :: CoreExpr -> Bool        -- True => definitely bottom
 365 exprIsBottom e = go 0 e
 366                where
 367                 -- n is the number of args
 368                  go n (Note _ e)   = go n e
 369                  go n (Let _ e)    = go n e
 370                  go n (Case e _ _) = go 0 e     -- Just check the scrut
 371                  go n (App e _)    = go (n+1) e
 372                  go n (Var v)      = idAppIsBottom v n
 373                  go n (Lit _)      = False
 374                  go n (Lam _ _)    = False
 375
 376 idAppIsBottom :: Id -> Int -> Bool
 377 idAppIsBottom id n_val_args = appIsBottom (idStrictness id) n_val_args
 378 \end{code}
 379
 380 @exprIsValue@ returns true for expressions that are certainly *already*
 381 evaluated to WHNF.  This is used to decide wether it's ok to change
 382         case x of _ -> e   ===>   e
 383
 384 and to decide whether it's safe to discard a `seq`
 385
 386 So, it does *not* treat variables as evaluated, unless they say they are
 387
 388 \begin{code}
 389 exprIsValue :: CoreExpr -> Bool         -- True => Value-lambda, constructor, PAP
 390 exprIsValue (Type ty)     = True        -- Types are honorary Values; we don't mind
 391                                         -- copying them
 392 exprIsValue (Lit l)       = True
 393 exprIsValue (Lam b e)     = isId b || exprIsValue e
 394 exprIsValue (Note _ e)    = exprIsValue e
 395 exprIsValue other_expr
 396   = go other_expr 0
 397   where
 398     go (Var f) n_args = idAppIsValue f n_args
 399
 400     go (App f a) n_args
 401         | isTypeArg a = go f n_args
 402         | otherwise   = go f (n_args + 1)
 403
 404     go (Note _ f) n_args = go f n_args
 405
 406     go other n_args = False
 407
 408 idAppIsValue :: Id -> Int -> Bool
 409 idAppIsValue id n_val_args
 410   = case idFlavour id of
 411         DataConId _ -> True
 412         PrimOpId _  -> n_val_args < idArity id
 413         other | n_val_args == 0 -> isEvaldUnfolding (idUnfolding id)
 414               | otherwise       -> n_val_args < idArity id
 415         -- A worry: what if an Id's unfolding is just itself:
 416         -- then we could get an infinite loop...
 417 \end{code}
 418
 419 \begin{code}
 420 exprArity :: CoreExpr -> Int    -- How many value lambdas are at the top
 421 exprArity (Lam b e)     | isTyVar b     = exprArity e
 422                         | otherwise     = 1 + exprArity e
 423
 424 exprArity (Note note e) | ok_note note  = exprArity e
 425                         where
 426                           ok_note (Coerce _ _) = True
 427                                 -- We *do* look through coerces when getting arities.
 428                                 -- Reason: arities are to do with *representation* and
 429                                 -- work duplication.
 430                           ok_note InlineMe     = True
 431                           ok_note InlineCall   = True
 432                           ok_note other        = False
 433                                 -- SCC and TermUsg might be over-conservative?
 434
 435 exprArity other = 0
 436 \end{code}
 437
 438
 439 %************************************************************************
 440 %*                                                                      *
 441 \subsection{Eta reduction and expansion}
 442 %*                                                                      *
 443 %************************************************************************
 444
 445 @etaReduceExpr@ trys an eta reduction at the top level of a Core Expr.
 446
 447 e.g.    \ x y -> f x y  ===>  f
 448
 449 But we only do this if it gets rid of a whole lambda, not part.
 450 The idea is that lambdas are often quite helpful: they indicate
 451 head normal forms, so we don't want to chuck them away lightly.
 452
 453 \begin{code}
 454 etaReduceExpr :: CoreExpr -> CoreExpr
 455                 -- ToDo: we should really check that we don't turn a non-bottom
 456                 -- lambda into a bottom variable.  Sigh
 457
 458 etaReduceExpr expr@(Lam bndr body)
 459   = check (reverse binders) body
 460   where
 461     (binders, body) = collectBinders expr
 462
 463     check [] body
 464         | not (any (`elemVarSet` body_fvs) binders)
 465         = body                  -- Success!
 466         where
 467           body_fvs = exprFreeVars body
 468
 469     check (b : bs) (App fun arg)
 470         |  (varToCoreExpr b `cheapEqExpr` arg)
 471         = check bs fun
 472
 473     check _ _ = expr    -- Bale out
 474
 475 etaReduceExpr expr = expr               -- The common case
 476 \end{code}
 477
 478
 479 \begin{code}
 480 exprEtaExpandArity :: CoreExpr -> Int   -- The number of args the thing can be applied to
 481                                         -- without doing much work
 482 -- This is used when eta expanding
 483 --      e  ==>  \xy -> e x y
 484 --
 485 -- It returns 1 (or more) to:
 486 --      case x of p -> \s -> ...
 487 -- because for I/O ish things we really want to get that \s to the top.
 488 -- We are prepared to evaluate x each time round the loop in order to get that
 489 -- Hence "generous" arity
 490
 491 exprEtaExpandArity e
 492   = go e
 493   where
 494     go (Var v)                          = idArity v
 495     go (App f (Type _))                 = go f
 496     go (App f a)  | exprIsCheap a       = (go f - 1) `max` 0    -- Never go -ve!
 497     go (Lam x e)  | isId x              = go e + 1
 498                   | otherwise           = go e
 499     go (Note n e) | ok_note n           = go e
 500     go (Case scrut _ alts)
 501       | exprIsCheap scrut               = min_zero [go rhs | (_,_,rhs) <- alts]
 502     go (Let b e)
 503       | all exprIsCheap (rhssOfBind b)  = go e
 504
 505     go other                            = 0
 506
 507     ok_note (Coerce _ _) = True
 508     ok_note InlineCall   = True
 509     ok_note other        = False
 510             -- Notice that we do not look through __inline_me__
 511             -- This one is a bit more surprising, but consider
 512             --  f = _inline_me (\x -> e)
 513             -- We DO NOT want to eta expand this to
 514             --  f = \x -> (_inline_me (\x -> e)) x
 515             -- because the _inline_me gets dropped now it is applied,
 516             -- giving just
 517             --  f = \x -> e
 518             -- A Bad Idea
 519
 520 min_zero :: [Int] -> Int        -- Find the minimum, but zero is the smallest
 521 min_zero (x:xs) = go x xs
 522                 where
 523                   go 0   xs                 = 0         -- Nothing beats zero
 524                   go min []                 = min
 525                   go min (x:xs) | x < min   = go x xs
 526                                 | otherwise = go min xs
 527
 528 \end{code}
 529
 530
 531 %************************************************************************
 532 %*                                                                      *
 533 \subsection{Equality}
 534 %*                                                                      *
 535 %************************************************************************
 536
 537 @cheapEqExpr@ is a cheap equality test which bales out fast!
 538         True  => definitely equal
 539         False => may or may not be equal
 540
 541 \begin{code}
 542 cheapEqExpr :: Expr b -> Expr b -> Bool
 543
 544 cheapEqExpr (Var v1)   (Var v2)   = v1==v2
 545 cheapEqExpr (Lit lit1) (Lit lit2) = lit1 == lit2
 546 cheapEqExpr (Type t1)  (Type t2)  = t1 == t2
 547
 548 cheapEqExpr (App f1 a1) (App f2 a2)
 549   = f1 `cheapEqExpr` f2 && a1 `cheapEqExpr` a2
 550
 551 cheapEqExpr _ _ = False
 552
 553 exprIsBig :: Expr b -> Bool
 554 -- Returns True of expressions that are too big to be compared by cheapEqExpr
 555 exprIsBig (Lit _)      = False
 556 exprIsBig (Var v)      = False
 557 exprIsBig (Type t)     = False
 558 exprIsBig (App f a)    = exprIsBig f || exprIsBig a
 559 exprIsBig other        = True
 560 \end{code}
 561
 562
 563 \begin{code}
 564 eqExpr :: CoreExpr -> CoreExpr -> Bool
 565         -- Works ok at more general type, but only needed at CoreExpr
 566 eqExpr e1 e2
 567   = eq emptyVarEnv e1 e2
 568   where
 569   -- The "env" maps variables in e1 to variables in ty2
 570   -- So when comparing lambdas etc,
 571   -- we in effect substitute v2 for v1 in e1 before continuing
 572     eq env (Var v1) (Var v2) = case lookupVarEnv env v1 of
 573                                   Just v1' -> v1' == v2
 574                                   Nothing  -> v1  == v2
 575
 576     eq env (Lit lit1)   (Lit lit2)   = lit1 == lit2
 577     eq env (App f1 a1)  (App f2 a2)  = eq env f1 f2 && eq env a1 a2
 578     eq env (Lam v1 e1)  (Lam v2 e2)  = eq (extendVarEnv env v1 v2) e1 e2
 579     eq env (Let (NonRec v1 r1) e1)
 580            (Let (NonRec v2 r2) e2)   = eq env r1 r2 && eq (extendVarEnv env v1 v2) e1 e2
 581     eq env (Let (Rec ps1) e1)
 582            (Let (Rec ps2) e2)        = length ps1 == length ps2 &&
 583                                        and (zipWith eq_rhs ps1 ps2) &&
 584                                        eq env' e1 e2
 585                                      where
 586                                        env' = extendVarEnvList env [(v1,v2) | ((v1,_),(v2,_)) <- zip ps1 ps2]
 587                                        eq_rhs (_,r1) (_,r2) = eq env' r1 r2
 588     eq env (Case e1 v1 a1)
 589            (Case e2 v2 a2)           = eq env e1 e2 &&
 590                                        length a1 == length a2 &&
 591                                        and (zipWith (eq_alt env') a1 a2)
 592                                      where
 593                                        env' = extendVarEnv env v1 v2
 594
 595     eq env (Note n1 e1) (Note n2 e2) = eq_note env n1 n2 && eq env e1 e2
 596     eq env (Type t1)    (Type t2)    = t1 == t2
 597     eq env e1           e2           = False
 598
 599     eq_list env []       []       = True
 600     eq_list env (e1:es1) (e2:es2) = eq env e1 e2 && eq_list env es1 es2
 601     eq_list env es1      es2      = False
 602
 603     eq_alt env (c1,vs1,r1) (c2,vs2,r2) = c1==c2 &&
 604                                          eq (extendVarEnvList env (vs1 `zip` vs2)) r1 r2
 605
 606     eq_note env (SCC cc1)      (SCC cc2)      = cc1 == cc2
 607     eq_note env (Coerce t1 f1) (Coerce t2 f2) = t1==t2 && f1==f2
 608     eq_note env InlineCall     InlineCall     = True
 609     eq_note env other1         other2         = False
 610 \end{code}
 611
 612 %************************************************************************
 613 %*                                                                      *
 614 \subsection{Hashing}
 615 %*                                                                      *
 616 %************************************************************************
 617
 618 \begin{code}
 619 hashExpr :: CoreExpr -> Int
 620 hashExpr e | hash < 0  = 77     -- Just in case we hit -maxInt
 621            | otherwise = hash
 622            where
 623              hash = abs (hash_expr e)   -- Negative numbers kill UniqFM
 624
 625 hash_expr (Note _ e)              = hash_expr e
 626 hash_expr (Let (NonRec b r) e)    = hashId b
 627 hash_expr (Let (Rec ((b,r):_)) e) = hashId b
 628 hash_expr (Case _ b _)            = hashId b
 629 hash_expr (App f e)               = hash_expr f * fast_hash_expr e
 630 hash_expr (Var v)                 = hashId v
 631 hash_expr (Lit lit)               = hashLiteral lit
 632 hash_expr (Lam b _)               = hashId b
 633 hash_expr (Type t)                = trace "hash_expr: type" 1           -- Shouldn't happen
 634
 635 fast_hash_expr (Var v)          = hashId v
 636 fast_hash_expr (Lit lit)        = hashLiteral lit
 637 fast_hash_expr (App f (Type _)) = fast_hash_expr f
 638 fast_hash_expr (App f a)        = fast_hash_expr a
 639 fast_hash_expr (Lam b _)        = hashId b
 640 fast_hash_expr other            = 1
 641
 642 hashId :: Id -> Int
 643 hashId id = hashName (idName id)
 644 \end{code}