2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[CoreUtils]{Utility functions on @Core@ syntax}
9 mkNote, mkInlineMe, mkSCC, mkCoerce,
10 bindNonRec, mkIfThenElse, mkAltExpr,
13 -- Properties of expressions
14 exprType, coreAltsType,
15 exprIsBottom, exprIsDupable, exprIsTrivial, exprIsCheap,
16 exprIsValue,exprOkForSpeculation, exprIsBig,
18 idAppIsBottom, idAppIsCheap,
20 -- Expr transformation
21 etaReduce, exprEtaExpandArity,
31 cheapEqExpr, eqExpr, applyTypeToArgs
34 #include "HsVersions.h"
37 import GlaExts -- For `xori`
40 import CoreFVs ( exprFreeVars )
41 import PprCore ( pprCoreExpr )
42 import Var ( Var, isId, isTyVar )
45 import Name ( hashName )
46 import Literal ( hashLiteral, literalType, litIsDupable )
47 import DataCon ( DataCon, dataConRepArity )
48 import PrimOp ( primOpOkForSpeculation, primOpIsCheap,
50 import Id ( Id, idType, idFlavour, idStrictness, idLBVarInfo,
51 mkWildId, idArity, idName, idUnfolding, idInfo,
52 isDataConId_maybe, isPrimOpId_maybe
54 import IdInfo ( LBVarInfo(..),
57 import Demand ( appIsBottom )
58 import Type ( Type, mkFunTy, mkForAllTy, splitFunTy_maybe,
59 applyTys, isUnLiftedType, seqType, mkUTy
61 import TysWiredIn ( boolTy, trueDataCon, falseDataCon )
62 import CostCentre ( CostCentre )
63 import Maybes ( maybeToBool )
65 import TysPrim ( alphaTy ) -- Debugging only
69 %************************************************************************
71 \subsection{Find the type of a Core atom/expression}
73 %************************************************************************
76 exprType :: CoreExpr -> Type
78 exprType (Var var) = idType var
79 exprType (Lit lit) = literalType lit
80 exprType (Let _ body) = exprType body
81 exprType (Case _ _ alts) = coreAltsType alts
82 exprType (Note (Coerce ty _) e) = ty -- **! should take usage from e
83 exprType (Note other_note e) = exprType e
84 exprType (Lam binder expr) = mkPiType binder (exprType expr)
86 = case collectArgs e of
87 (fun, args) -> applyTypeToArgs e (exprType fun) args
89 exprType other = pprTrace "exprType" (pprCoreExpr other) alphaTy
91 coreAltsType :: [CoreAlt] -> Type
92 coreAltsType ((_,_,rhs) : _) = exprType rhs
95 @mkPiType@ makes a (->) type or a forall type, depending on whether
96 it is given a type variable or a term variable. We cleverly use the
97 lbvarinfo field to figure out the right annotation for the arrove in
98 case of a term variable.
101 mkPiType :: Var -> Type -> Type -- The more polymorphic version doesn't work...
102 mkPiType v ty | isId v = (case idLBVarInfo v of
103 LBVarInfo u -> mkUTy u
105 mkFunTy (idType v) ty
106 | isTyVar v = mkForAllTy v ty
110 -- The first argument is just for debugging
111 applyTypeToArgs :: CoreExpr -> Type -> [CoreExpr] -> Type
112 applyTypeToArgs e op_ty [] = op_ty
114 applyTypeToArgs e op_ty (Type ty : args)
115 = -- Accumulate type arguments so we can instantiate all at once
116 applyTypeToArgs e (applyTys op_ty tys) rest_args
118 (tys, rest_args) = go [ty] args
119 go tys (Type ty : args) = go (ty:tys) args
120 go tys rest_args = (reverse tys, rest_args)
122 applyTypeToArgs e op_ty (other_arg : args)
123 = case (splitFunTy_maybe op_ty) of
124 Just (_, res_ty) -> applyTypeToArgs e res_ty args
125 Nothing -> pprPanic "applyTypeToArgs" (pprCoreExpr e)
130 %************************************************************************
132 \subsection{Attaching notes}
134 %************************************************************************
136 mkNote removes redundant coercions, and SCCs where possible
139 mkNote :: Note -> CoreExpr -> CoreExpr
140 mkNote (Coerce to_ty from_ty) expr = mkCoerce to_ty from_ty expr
141 mkNote (SCC cc) expr = mkSCC cc expr
142 mkNote InlineMe expr = mkInlineMe expr
143 mkNote note expr = Note note expr
145 -- Slide InlineCall in around the function
146 -- No longer necessary I think (SLPJ Apr 99)
147 -- mkNote InlineCall (App f a) = App (mkNote InlineCall f) a
148 -- mkNote InlineCall (Var v) = Note InlineCall (Var v)
149 -- mkNote InlineCall expr = expr
152 Drop trivial InlineMe's. This is somewhat important, because if we have an unfolding
153 that looks like (Note InlineMe (Var v)), the InlineMe doesn't go away because it may
154 not be *applied* to anything.
157 mkInlineMe e | exprIsTrivial e = e
158 | otherwise = Note InlineMe e
164 mkCoerce :: Type -> Type -> CoreExpr -> CoreExpr
166 mkCoerce to_ty from_ty (Note (Coerce to_ty2 from_ty2) expr)
167 = ASSERT( from_ty == to_ty2 )
168 mkCoerce to_ty from_ty2 expr
170 mkCoerce to_ty from_ty expr
171 | to_ty == from_ty = expr
172 | otherwise = ASSERT( from_ty == exprType expr )
173 Note (Coerce to_ty from_ty) expr
177 mkSCC :: CostCentre -> Expr b -> Expr b
178 -- Note: Nested SCC's *are* preserved for the benefit of
179 -- cost centre stack profiling (Durham)
181 mkSCC cc (Lit lit) = Lit lit
182 mkSCC cc (Lam x e) = Lam x (mkSCC cc e) -- Move _scc_ inside lambda
183 mkSCC cc expr = Note (SCC cc) expr
187 %************************************************************************
189 \subsection{Other expression construction}
191 %************************************************************************
194 bindNonRec :: Id -> CoreExpr -> CoreExpr -> CoreExpr
195 -- (bindNonRec x r b) produces either
198 -- case r of x { _DEFAULT_ -> b }
200 -- depending on whether x is unlifted or not
201 -- It's used by the desugarer to avoid building bindings
202 -- that give Core Lint a heart attack. Actually the simplifier
203 -- deals with them perfectly well.
204 bindNonRec bndr rhs body
205 | isUnLiftedType (idType bndr) = Case rhs bndr [(DEFAULT,[],body)]
206 | otherwise = Let (NonRec bndr rhs) body
210 mkAltExpr :: AltCon -> [CoreBndr] -> [Type] -> CoreExpr
211 -- This guy constructs the value that the scrutinee must have
212 -- when you are in one particular branch of a case
213 mkAltExpr (DataAlt con) args inst_tys
214 = mkConApp con (map Type inst_tys ++ map varToCoreExpr args)
215 mkAltExpr (LitAlt lit) [] []
218 mkIfThenElse :: CoreExpr -> CoreExpr -> CoreExpr -> CoreExpr
219 mkIfThenElse guard then_expr else_expr
220 = Case guard (mkWildId boolTy)
221 [ (DataAlt trueDataCon, [], then_expr),
222 (DataAlt falseDataCon, [], else_expr) ]
225 %************************************************************************
227 \subsection{Figuring out things about expressions}
229 %************************************************************************
231 @exprIsTrivial@ is true of expressions we are unconditionally happy to
232 duplicate; simple variables and constants, and type
233 applications. Note that primop Ids aren't considered
236 @exprIsBottom@ is true of expressions that are guaranteed to diverge
240 exprIsTrivial (Var v)
241 | Just op <- isPrimOpId_maybe v = primOpIsDupable op
243 exprIsTrivial (Type _) = True
244 exprIsTrivial (Lit lit) = True
245 exprIsTrivial (App e arg) = isTypeArg arg && exprIsTrivial e
246 exprIsTrivial (Note _ e) = exprIsTrivial e
247 exprIsTrivial (Lam b body) | isTyVar b = exprIsTrivial body
248 exprIsTrivial other = False
252 @exprIsDupable@ is true of expressions that can be duplicated at a modest
253 cost in code size. This will only happen in different case
254 branches, so there's no issue about duplicating work.
256 That is, exprIsDupable returns True of (f x) even if
257 f is very very expensive to call.
259 Its only purpose is to avoid fruitless let-binding
260 and then inlining of case join points
264 exprIsDupable (Type _) = True
265 exprIsDupable (Var v) = True
266 exprIsDupable (Lit lit) = litIsDupable lit
267 exprIsDupable (Note _ e) = exprIsDupable e
271 go (Var v) n_args = True
272 go (App f a) n_args = n_args < dupAppSize
275 go other n_args = False
278 dupAppSize = 4 -- Size of application we are prepared to duplicate
281 @exprIsCheap@ looks at a Core expression and returns \tr{True} if
282 it is obviously in weak head normal form, or is cheap to get to WHNF.
283 [Note that that's not the same as exprIsDupable; an expression might be
284 big, and hence not dupable, but still cheap.]
286 By ``cheap'' we mean a computation we're willing to:
287 push inside a lambda, or
288 inline at more than one place
289 That might mean it gets evaluated more than once, instead of being
290 shared. The main examples of things which aren't WHNF but are
295 (where e, and all the ei are cheap)
298 (where e and b are cheap)
301 (where op is a cheap primitive operator)
304 (because we are happy to substitute it inside a lambda)
306 Notice that a variable is considered 'cheap': we can push it inside a lambda,
307 because sharing will make sure it is only evaluated once.
310 exprIsCheap :: CoreExpr -> Bool
311 exprIsCheap (Lit lit) = True
312 exprIsCheap (Type _) = True
313 exprIsCheap (Var _) = True
314 exprIsCheap (Note _ e) = exprIsCheap e
315 exprIsCheap (Lam x e) = if isId x then True else exprIsCheap e
316 exprIsCheap (Case e _ alts) = exprIsCheap e &&
317 and [exprIsCheap rhs | (_,_,rhs) <- alts]
318 -- Experimentally, treat (case x of ...) as cheap
319 -- (and case __coerce x etc.)
320 -- This improves arities of overloaded functions where
321 -- there is only dictionary selection (no construction) involved
322 exprIsCheap (Let (NonRec x _) e)
323 | isUnLiftedType (idType x) = exprIsCheap e
325 -- strict lets always have cheap right hand sides, and
328 exprIsCheap other_expr
329 = go other_expr 0 True
331 go (Var f) n_args args_cheap
332 = (idAppIsCheap f n_args && args_cheap)
333 -- A constructor, cheap primop, or partial application
335 || idAppIsBottom f n_args
336 -- Application of a function which
337 -- always gives bottom; we treat this as cheap
338 -- because it certainly doesn't need to be shared!
340 go (App f a) n_args args_cheap
341 | isTypeArg a = go f n_args args_cheap
342 | otherwise = go f (n_args + 1) (exprIsCheap a && args_cheap)
344 go other n_args args_cheap = False
346 idAppIsCheap :: Id -> Int -> Bool
347 idAppIsCheap id n_val_args
348 | n_val_args == 0 = True -- Just a type application of
349 -- a variable (f t1 t2 t3)
351 | otherwise = case idFlavour id of
353 RecordSelId _ -> True -- I'm experimenting with making record selection
354 -- look cheap, so we will substitute it inside a
355 -- lambda. Particularly for dictionary field selection
357 PrimOpId op -> primOpIsCheap op -- In principle we should worry about primops
358 -- that return a type variable, since the result
359 -- might be applied to something, but I'm not going
360 -- to bother to check the number of args
361 other -> n_val_args < idArity id
364 exprOkForSpeculation returns True of an expression that it is
366 * safe to evaluate even if normal order eval might not
367 evaluate the expression at all, or
369 * safe *not* to evaluate even if normal order would do so
373 the expression guarantees to terminate,
375 without raising an exception,
376 without causing a side effect (e.g. writing a mutable variable)
379 let x = case y# +# 1# of { r# -> I# r# }
382 case y# +# 1# of { r# ->
387 We can only do this if the (y+1) is ok for speculation: it has no
388 side effects, and can't diverge or raise an exception.
391 exprOkForSpeculation :: CoreExpr -> Bool
392 exprOkForSpeculation (Lit _) = True
393 exprOkForSpeculation (Var v) = isUnLiftedType (idType v)
394 exprOkForSpeculation (Note _ e) = exprOkForSpeculation e
395 exprOkForSpeculation other_expr
396 = go other_expr 0 True
398 go (Var f) n_args args_ok
399 = case idFlavour f of
400 DataConId _ -> True -- The strictness of the constructor has already
401 -- been expressed by its "wrapper", so we don't need
402 -- to take the arguments into account
404 PrimOpId op -> primOpOkForSpeculation op && args_ok
405 -- A bit conservative: we don't really need
406 -- to care about lazy arguments, but this is easy
410 go (App f a) n_args args_ok
411 | isTypeArg a = go f n_args args_ok
412 | otherwise = go f (n_args + 1) (exprOkForSpeculation a && args_ok)
414 go other n_args args_ok = False
419 exprIsBottom :: CoreExpr -> Bool -- True => definitely bottom
420 exprIsBottom e = go 0 e
422 -- n is the number of args
423 go n (Note _ e) = go n e
424 go n (Let _ e) = go n e
425 go n (Case e _ _) = go 0 e -- Just check the scrut
426 go n (App e _) = go (n+1) e
427 go n (Var v) = idAppIsBottom v n
429 go n (Lam _ _) = False
431 idAppIsBottom :: Id -> Int -> Bool
432 idAppIsBottom id n_val_args = appIsBottom (idStrictness id) n_val_args
435 @exprIsValue@ returns true for expressions that are certainly *already*
436 evaluated to WHNF. This is used to decide wether it's ok to change
437 case x of _ -> e ===> e
439 and to decide whether it's safe to discard a `seq`
441 So, it does *not* treat variables as evaluated, unless they say they are
444 exprIsValue :: CoreExpr -> Bool -- True => Value-lambda, constructor, PAP
445 exprIsValue (Type ty) = True -- Types are honorary Values; we don't mind
447 exprIsValue (Lit l) = True
448 exprIsValue (Lam b e) = isId b || exprIsValue e
449 exprIsValue (Note _ e) = exprIsValue e
450 exprIsValue other_expr
453 go (Var f) n_args = idAppIsValue f n_args
456 | isTypeArg a = go f n_args
457 | otherwise = go f (n_args + 1)
459 go (Note _ f) n_args = go f n_args
461 go other n_args = False
463 idAppIsValue :: Id -> Int -> Bool
464 idAppIsValue id n_val_args
465 = case idFlavour id of
467 PrimOpId _ -> n_val_args < idArity id
468 other | n_val_args == 0 -> isEvaldUnfolding (idUnfolding id)
469 | otherwise -> n_val_args < idArity id
470 -- A worry: what if an Id's unfolding is just itself:
471 -- then we could get an infinite loop...
475 exprIsConApp_maybe :: CoreExpr -> Maybe (DataCon, [CoreExpr])
476 exprIsConApp_maybe expr
477 = analyse (collectArgs expr)
479 analyse (Var fun, args)
480 | maybeToBool maybe_con_app = maybe_con_app
482 maybe_con_app = case isDataConId_maybe fun of
483 Just con | length args >= dataConRepArity con
484 -- Might be > because the arity excludes type args
488 analyse (Var fun, [])
489 = case maybeUnfoldingTemplate (idUnfolding fun) of
491 Just unf -> exprIsConApp_maybe unf
493 analyse other = Nothing
497 %************************************************************************
499 \subsection{Eta reduction and expansion}
501 %************************************************************************
503 @etaReduce@ trys an eta reduction at the top level of a Core Expr.
505 e.g. \ x y -> f x y ===> f
507 But we only do this if it gets rid of a whole lambda, not part.
508 The idea is that lambdas are often quite helpful: they indicate
509 head normal forms, so we don't want to chuck them away lightly.
512 etaReduce :: CoreExpr -> CoreExpr
513 -- ToDo: we should really check that we don't turn a non-bottom
514 -- lambda into a bottom variable. Sigh
516 etaReduce expr@(Lam bndr body)
517 = check (reverse binders) body
519 (binders, body) = collectBinders expr
522 | not (any (`elemVarSet` body_fvs) binders)
525 body_fvs = exprFreeVars body
527 check (b : bs) (App fun arg)
528 | (varToCoreExpr b `cheapEqExpr` arg)
531 check _ _ = expr -- Bale out
533 etaReduce expr = expr -- The common case
538 exprEtaExpandArity :: CoreExpr -> Int -- The number of args the thing can be applied to
539 -- without doing much work
540 -- This is used when eta expanding
541 -- e ==> \xy -> e x y
543 -- It returns 1 (or more) to:
544 -- case x of p -> \s -> ...
545 -- because for I/O ish things we really want to get that \s to the top.
546 -- We are prepared to evaluate x each time round the loop in order to get that
547 -- Hence "generous" arity
550 = go e `max` 0 -- Never go -ve!
552 go (Var v) = idArity v
553 go (App f (Type _)) = go f
554 go (App f a) | exprIsCheap a = go f - 1
555 go (Lam x e) | isId x = go e + 1
557 go (Note n e) | ok_note n = go e
558 go (Case scrut _ alts)
559 | exprIsCheap scrut = min_zero [go rhs | (_,_,rhs) <- alts]
561 | all exprIsCheap (rhssOfBind b) = go e
565 ok_note (Coerce _ _) = True
566 ok_note InlineCall = True
567 ok_note other = False
568 -- Notice that we do not look through __inline_me__
569 -- This one is a bit more surprising, but consider
570 -- f = _inline_me (\x -> e)
571 -- We DO NOT want to eta expand this to
572 -- f = \x -> (_inline_me (\x -> e)) x
573 -- because the _inline_me gets dropped now it is applied,
578 min_zero :: [Int] -> Int -- Find the minimum, but zero is the smallest
579 min_zero (x:xs) = go x xs
581 go 0 xs = 0 -- Nothing beats zero
583 go min (x:xs) | x < min = go x xs
584 | otherwise = go min xs
590 etaExpand :: Int -- Add this number of value args
592 -> CoreExpr -> Type -- Expression and its type
595 -- Given e' = etaExpand n us e ty
597 -- ty = exprType e = exprType e'
599 -- etaExpand deals with for-alls and coerces. For example:
601 -- where E :: forall a. T
602 -- newtype T = MkT (A -> B)
605 -- (/\b. coerce T (\y::A -> (coerce (A->B) (E b) y)
607 -- (case x of { I# x -> /\ a -> coerce T E)
609 etaExpand n us expr ty
610 | n == 0 -- Saturated, so nothing to do
613 | otherwise -- An unsaturated constructor or primop; eta expand it
614 = case splitForAllTy_maybe ty of {
615 Just (tv,ty') -> Lam tv (etaExpand n us (App expr (Type (mkTyVarTy tv))) ty')
619 case splitFunTy_maybe ty of {
620 Just (arg_ty, res_ty) -> Lam arg' (etaExpand (n-1) us2 (App expr (Var arg')) res_ty)
622 arg' = mkSysLocal SLIT("eta") uniq arg_ty
623 (us1, us2) = splitUnqiSupply us
624 uniq = uniqFromSupply us1
628 case splitNewType_maybe ty of {
629 Just ty' -> mkCoerce ty ty' (etaExpand n us (mkCoerce ty' ty expr) ty')
631 Nothing -> pprTrace "Bad eta expand" (ppr expr $$ ppr ty) expr
636 %************************************************************************
638 \subsection{Equality}
640 %************************************************************************
642 @cheapEqExpr@ is a cheap equality test which bales out fast!
643 True => definitely equal
644 False => may or may not be equal
647 cheapEqExpr :: Expr b -> Expr b -> Bool
649 cheapEqExpr (Var v1) (Var v2) = v1==v2
650 cheapEqExpr (Lit lit1) (Lit lit2) = lit1 == lit2
651 cheapEqExpr (Type t1) (Type t2) = t1 == t2
653 cheapEqExpr (App f1 a1) (App f2 a2)
654 = f1 `cheapEqExpr` f2 && a1 `cheapEqExpr` a2
656 cheapEqExpr _ _ = False
658 exprIsBig :: Expr b -> Bool
659 -- Returns True of expressions that are too big to be compared by cheapEqExpr
660 exprIsBig (Lit _) = False
661 exprIsBig (Var v) = False
662 exprIsBig (Type t) = False
663 exprIsBig (App f a) = exprIsBig f || exprIsBig a
664 exprIsBig other = True
669 eqExpr :: CoreExpr -> CoreExpr -> Bool
670 -- Works ok at more general type, but only needed at CoreExpr
672 = eq emptyVarEnv e1 e2
674 -- The "env" maps variables in e1 to variables in ty2
675 -- So when comparing lambdas etc,
676 -- we in effect substitute v2 for v1 in e1 before continuing
677 eq env (Var v1) (Var v2) = case lookupVarEnv env v1 of
678 Just v1' -> v1' == v2
681 eq env (Lit lit1) (Lit lit2) = lit1 == lit2
682 eq env (App f1 a1) (App f2 a2) = eq env f1 f2 && eq env a1 a2
683 eq env (Lam v1 e1) (Lam v2 e2) = eq (extendVarEnv env v1 v2) e1 e2
684 eq env (Let (NonRec v1 r1) e1)
685 (Let (NonRec v2 r2) e2) = eq env r1 r2 && eq (extendVarEnv env v1 v2) e1 e2
686 eq env (Let (Rec ps1) e1)
687 (Let (Rec ps2) e2) = length ps1 == length ps2 &&
688 and (zipWith eq_rhs ps1 ps2) &&
691 env' = extendVarEnvList env [(v1,v2) | ((v1,_),(v2,_)) <- zip ps1 ps2]
692 eq_rhs (_,r1) (_,r2) = eq env' r1 r2
693 eq env (Case e1 v1 a1)
694 (Case e2 v2 a2) = eq env e1 e2 &&
695 length a1 == length a2 &&
696 and (zipWith (eq_alt env') a1 a2)
698 env' = extendVarEnv env v1 v2
700 eq env (Note n1 e1) (Note n2 e2) = eq_note env n1 n2 && eq env e1 e2
701 eq env (Type t1) (Type t2) = t1 == t2
704 eq_list env [] [] = True
705 eq_list env (e1:es1) (e2:es2) = eq env e1 e2 && eq_list env es1 es2
706 eq_list env es1 es2 = False
708 eq_alt env (c1,vs1,r1) (c2,vs2,r2) = c1==c2 &&
709 eq (extendVarEnvList env (vs1 `zip` vs2)) r1 r2
711 eq_note env (SCC cc1) (SCC cc2) = cc1 == cc2
712 eq_note env (Coerce t1 f1) (Coerce t2 f2) = t1==t2 && f1==f2
713 eq_note env InlineCall InlineCall = True
714 eq_note env other1 other2 = False
718 %************************************************************************
720 \subsection{The size of an expression}
722 %************************************************************************
725 coreBindsSize :: [CoreBind] -> Int
726 coreBindsSize bs = foldr ((+) . bindSize) 0 bs
728 exprSize :: CoreExpr -> Int
729 -- A measure of the size of the expressions
730 -- It also forces the expression pretty drastically as a side effect
731 exprSize (Var v) = varSize v
732 exprSize (Lit lit) = lit `seq` 1
733 exprSize (App f a) = exprSize f + exprSize a
734 exprSize (Lam b e) = varSize b + exprSize e
735 exprSize (Let b e) = bindSize b + exprSize e
736 exprSize (Case e b as) = exprSize e + varSize b + foldr ((+) . altSize) 0 as
737 exprSize (Note n e) = noteSize n + exprSize e
738 exprSize (Type t) = seqType t `seq` 1
740 noteSize (SCC cc) = cc `seq` 1
741 noteSize (Coerce t1 t2) = seqType t1 `seq` seqType t2 `seq` 1
742 noteSize InlineCall = 1
743 noteSize InlineMe = 1
745 varSize :: Var -> Int
746 varSize b | isTyVar b = 1
747 | otherwise = seqType (idType b) `seq`
748 megaSeqIdInfo (idInfo b) `seq`
751 varsSize = foldr ((+) . varSize) 0
753 bindSize (NonRec b e) = varSize b + exprSize e
754 bindSize (Rec prs) = foldr ((+) . pairSize) 0 prs
756 pairSize (b,e) = varSize b + exprSize e
758 altSize (c,bs,e) = c `seq` varsSize bs + exprSize e
762 %************************************************************************
766 %************************************************************************
769 hashExpr :: CoreExpr -> Int
770 hashExpr e | hash < 0 = 77 -- Just in case we hit -maxInt
773 hash = abs (hash_expr e) -- Negative numbers kill UniqFM
775 hash_expr (Note _ e) = hash_expr e
776 hash_expr (Let (NonRec b r) e) = hashId b
777 hash_expr (Let (Rec ((b,r):_)) e) = hashId b
778 hash_expr (Case _ b _) = hashId b
779 hash_expr (App f e) = hash_expr f * fast_hash_expr e
780 hash_expr (Var v) = hashId v
781 hash_expr (Lit lit) = hashLiteral lit
782 hash_expr (Lam b _) = hashId b
783 hash_expr (Type t) = trace "hash_expr: type" 1 -- Shouldn't happen
785 fast_hash_expr (Var v) = hashId v
786 fast_hash_expr (Lit lit) = hashLiteral lit
787 fast_hash_expr (App f (Type _)) = fast_hash_expr f
788 fast_hash_expr (App f a) = fast_hash_expr a
789 fast_hash_expr (Lam b _) = hashId b
790 fast_hash_expr other = 1
793 hashId id = hashName (idName id)