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, exprArity,
15 exprIsBottom, exprIsDupable, exprIsTrivial, exprIsCheap,
16 exprIsValue,exprOkForSpeculation, exprIsBig,
18 idAppIsBottom, idAppIsCheap,
20 -- Expr transformation
21 etaReduceExpr, exprEtaExpandArity,
30 cheapEqExpr, eqExpr, applyTypeToArgs
33 #include "HsVersions.h"
36 import GlaExts -- For `xori`
39 import CoreFVs ( exprFreeVars )
40 import PprCore ( pprCoreExpr )
41 import Var ( Var, isId, isTyVar )
44 import Name ( isLocallyDefined, hashName )
45 import Literal ( Literal, hashLiteral, literalType, litIsDupable )
46 import DataCon ( DataCon, dataConRepArity )
47 import PrimOp ( primOpOkForSpeculation, primOpIsCheap,
49 import Id ( Id, idType, idFlavour, idStrictness, idLBVarInfo,
50 mkWildId, idArity, idName, idUnfolding, idInfo,
51 isDataConId_maybe, isPrimOpId_maybe
53 import IdInfo ( arityLowerBound, InlinePragInfo(..),
57 import Demand ( appIsBottom )
58 import Type ( Type, mkFunTy, mkForAllTy,
59 splitFunTy_maybe, tyVarsOfType, tyVarsOfTypes,
60 isNotUsgTy, mkUsgTy, unUsgTy, UsageAnn(..),
61 applyTys, isUnLiftedType, seqType
63 import TysWiredIn ( boolTy, stringTy, trueDataCon, falseDataCon )
64 import CostCentre ( CostCentre )
65 import Unique ( buildIdKey, augmentIdKey )
66 import Util ( zipWithEqual, mapAccumL )
67 import Maybes ( maybeToBool )
69 import TysPrim ( alphaTy ) -- Debugging only
73 %************************************************************************
75 \subsection{Find the type of a Core atom/expression}
77 %************************************************************************
80 exprType :: CoreExpr -> Type
82 exprType (Var var) = idType var
83 exprType (Lit lit) = literalType lit
84 exprType (Let _ body) = exprType body
85 exprType (Case _ _ alts) = coreAltsType alts
86 exprType (Note (Coerce ty _) e) = ty -- **! should take usage from e
87 exprType (Note (TermUsg u) e) = mkUsgTy u (unUsgTy (exprType e))
88 exprType (Note other_note e) = exprType e
89 exprType (Lam binder expr) = mkPiType binder (exprType expr)
91 = case collectArgs e of
92 (fun, args) -> applyTypeToArgs e (exprType fun) args
94 exprType other = pprTrace "exprType" (pprCoreExpr other) alphaTy
96 coreAltsType :: [CoreAlt] -> Type
97 coreAltsType ((_,_,rhs) : _) = exprType rhs
100 @mkPiType@ makes a (->) type or a forall type, depending on whether
101 it is given a type variable or a term variable. We cleverly use the
102 lbvarinfo field to figure out the right annotation for the arrove in
103 case of a term variable.
106 mkPiType :: Var -> Type -> Type -- The more polymorphic version doesn't work...
107 mkPiType v ty | isId v = (case idLBVarInfo v of
108 IsOneShotLambda -> mkUsgTy UsOnce
110 mkFunTy (idType v) ty
111 | isTyVar v = mkForAllTy v ty
115 -- The first argument is just for debugging
116 applyTypeToArgs :: CoreExpr -> Type -> [CoreExpr] -> Type
117 applyTypeToArgs e op_ty [] = op_ty
119 applyTypeToArgs e op_ty (Type ty : args)
120 = -- Accumulate type arguments so we can instantiate all at once
121 ASSERT2( all isNotUsgTy tys,
122 ppr e <+> text "of" <+> ppr op_ty <+> text "to" <+>
123 ppr (Type ty : args) <+> text "i.e." <+> ppr tys )
124 applyTypeToArgs e (applyTys op_ty tys) rest_args
126 (tys, rest_args) = go [ty] args
127 go tys (Type ty : args) = go (ty:tys) args
128 go tys rest_args = (reverse tys, rest_args)
130 applyTypeToArgs e op_ty (other_arg : args)
131 = case (splitFunTy_maybe op_ty) of
132 Just (_, res_ty) -> applyTypeToArgs e res_ty args
133 Nothing -> pprPanic "applyTypeToArgs" (pprCoreExpr e)
138 %************************************************************************
140 \subsection{Attaching notes}
142 %************************************************************************
144 mkNote removes redundant coercions, and SCCs where possible
147 mkNote :: Note -> CoreExpr -> CoreExpr
148 mkNote (Coerce to_ty from_ty) expr = mkCoerce to_ty from_ty expr
149 mkNote (SCC cc) expr = mkSCC cc expr
150 mkNote InlineMe expr = mkInlineMe expr
151 mkNote note expr = Note note expr
153 -- Slide InlineCall in around the function
154 -- No longer necessary I think (SLPJ Apr 99)
155 -- mkNote InlineCall (App f a) = App (mkNote InlineCall f) a
156 -- mkNote InlineCall (Var v) = Note InlineCall (Var v)
157 -- mkNote InlineCall expr = expr
160 Drop trivial InlineMe's. This is somewhat important, because if we have an unfolding
161 that looks like (Note InlineMe (Var v)), the InlineMe doesn't go away because it may
162 not be *applied* to anything.
165 mkInlineMe e | exprIsTrivial e = e
166 | otherwise = Note InlineMe e
172 mkCoerce :: Type -> Type -> CoreExpr -> CoreExpr
174 mkCoerce to_ty from_ty (Note (Coerce to_ty2 from_ty2) expr)
175 = ASSERT( from_ty == to_ty2 )
176 mkCoerce to_ty from_ty2 expr
178 mkCoerce to_ty from_ty expr
179 | to_ty == from_ty = expr
180 | otherwise = ASSERT( from_ty == exprType expr )
181 Note (Coerce to_ty from_ty) expr
185 mkSCC :: CostCentre -> Expr b -> Expr b
186 -- Note: Nested SCC's *are* preserved for the benefit of
187 -- cost centre stack profiling (Durham)
189 mkSCC cc (Lit lit) = Lit lit
190 mkSCC cc (Lam x e) = Lam x (mkSCC cc e) -- Move _scc_ inside lambda
191 mkSCC cc expr = Note (SCC cc) expr
195 %************************************************************************
197 \subsection{Other expression construction}
199 %************************************************************************
202 bindNonRec :: Id -> CoreExpr -> CoreExpr -> CoreExpr
203 -- (bindNonRec x r b) produces either
206 -- case r of x { _DEFAULT_ -> b }
208 -- depending on whether x is unlifted or not
209 -- It's used by the desugarer to avoid building bindings
210 -- that give Core Lint a heart attack. Actually the simplifier
211 -- deals with them perfectly well.
212 bindNonRec bndr rhs body
213 | isUnLiftedType (idType bndr) = Case rhs bndr [(DEFAULT,[],body)]
214 | otherwise = Let (NonRec bndr rhs) body
218 mkAltExpr :: AltCon -> [CoreBndr] -> [Type] -> CoreExpr
219 -- This guy constructs the value that the scrutinee must have
220 -- when you are in one particular branch of a case
221 mkAltExpr (DataAlt con) args inst_tys
222 = mkConApp con (map Type inst_tys ++ map varToCoreExpr args)
223 mkAltExpr (LitAlt lit) [] []
226 mkIfThenElse :: CoreExpr -> CoreExpr -> CoreExpr -> CoreExpr
227 mkIfThenElse guard then_expr else_expr
228 = Case guard (mkWildId boolTy)
229 [ (DataAlt trueDataCon, [], then_expr),
230 (DataAlt falseDataCon, [], else_expr) ]
233 %************************************************************************
235 \subsection{Figuring out things about expressions}
237 %************************************************************************
239 @exprIsTrivial@ is true of expressions we are unconditionally happy to
240 duplicate; simple variables and constants, and type
241 applications. Note that primop Ids aren't considered
244 @exprIsBottom@ is true of expressions that are guaranteed to diverge
248 exprIsTrivial (Var v)
249 | Just op <- isPrimOpId_maybe v = primOpIsDupable op
251 exprIsTrivial (Type _) = True
252 exprIsTrivial (Lit lit) = True
253 exprIsTrivial (App e arg) = isTypeArg arg && exprIsTrivial e
254 exprIsTrivial (Note _ e) = exprIsTrivial e
255 exprIsTrivial (Lam b body) | isTyVar b = exprIsTrivial body
256 exprIsTrivial other = False
260 @exprIsDupable@ is true of expressions that can be duplicated at a modest
261 cost in code size. This will only happen in different case
262 branches, so there's no issue about duplicating work.
264 That is, exprIsDupable returns True of (f x) even if
265 f is very very expensive to call.
267 Its only purpose is to avoid fruitless let-binding
268 and then inlining of case join points
272 exprIsDupable (Type _) = True
273 exprIsDupable (Var v) = True
274 exprIsDupable (Lit lit) = litIsDupable lit
275 exprIsDupable (Note _ e) = exprIsDupable e
279 go (Var v) n_args = True
280 go (App f a) n_args = n_args < dupAppSize
283 go other n_args = False
286 dupAppSize = 4 -- Size of application we are prepared to duplicate
289 @exprIsCheap@ looks at a Core expression and returns \tr{True} if
290 it is obviously in weak head normal form, or is cheap to get to WHNF.
291 [Note that that's not the same as exprIsDupable; an expression might be
292 big, and hence not dupable, but still cheap.]
294 By ``cheap'' we mean a computation we're willing to:
295 push inside a lambda, or
296 inline at more than one place
297 That might mean it gets evaluated more than once, instead of being
298 shared. The main examples of things which aren't WHNF but are
304 where e, and all the ei are cheap; and
309 where e and b are cheap; and
313 where op is a cheap primitive operator
317 Notice that a variable is considered 'cheap': we can push it inside a lambda,
318 because sharing will make sure it is only evaluated once.
321 exprIsCheap :: CoreExpr -> Bool
322 exprIsCheap (Lit lit) = True
323 exprIsCheap (Type _) = True
324 exprIsCheap (Var _) = True
325 exprIsCheap (Note _ e) = exprIsCheap e
326 exprIsCheap (Lam x e) = if isId x then True else exprIsCheap e
327 exprIsCheap (Case (Var v) _ alts) = and [exprIsCheap rhs | (_,_,rhs) <- alts]
328 -- Experimentally, treat (case x of ...) as cheap
329 -- This improves arities of overloaded functions where
330 -- there is only dictionary selection (no construction) involved
331 exprIsCheap other_expr
332 = go other_expr 0 True
334 go (Var f) n_args args_cheap
335 = (idAppIsCheap f n_args && args_cheap)
336 -- A constructor, cheap primop, or partial application
338 || idAppIsBottom f n_args
339 -- Application of a function which
340 -- always gives bottom; we treat this as
341 -- a WHNF, because it certainly doesn't
342 -- need to be shared!
344 go (App f a) n_args args_cheap
345 | isTypeArg a = go f n_args args_cheap
346 | otherwise = go f (n_args + 1) (exprIsCheap a && args_cheap)
348 go other n_args args_cheap = False
350 idAppIsCheap :: Id -> Int -> Bool
351 idAppIsCheap id n_val_args
352 | n_val_args == 0 = True -- Just a type application of
353 -- a variable (f t1 t2 t3)
355 | otherwise = case idFlavour id of
357 RecordSelId _ -> True -- I'm experimenting with making record selection
358 -- look cheap, so we will substitute it inside a
359 -- lambda. Particularly for dictionary field selection
361 PrimOpId op -> primOpIsCheap op -- In principle we should worry about primops
362 -- that return a type variable, since the result
363 -- might be applied to something, but I'm not going
364 -- to bother to check the number of args
365 other -> n_val_args < idArity id
368 exprOkForSpeculation returns True of an expression that it is
370 * safe to evaluate even if normal order eval might not
371 evaluate the expression at all, or
373 * safe *not* to evaluate even if normal order would do so
377 the expression guarantees to terminate,
379 without raising an exception,
380 without causing a side effect (e.g. writing a mutable variable)
383 let x = case y# +# 1# of { r# -> I# r# }
386 case y# +# 1# of { r# ->
391 We can only do this if the (y+1) is ok for speculation: it has no
392 side effects, and can't diverge or raise an exception.
395 exprOkForSpeculation :: CoreExpr -> Bool
396 exprOkForSpeculation (Lit _) = True
397 exprOkForSpeculation (Var v) = isUnLiftedType (idType v)
398 exprOkForSpeculation (Note _ e) = exprOkForSpeculation e
399 exprOkForSpeculation other_expr
400 = go other_expr 0 True
402 go (Var f) n_args args_ok
403 = case idFlavour f of
404 DataConId _ -> True -- The strictness of the constructor has already
405 -- been expressed by its "wrapper", so we don't need
406 -- to take the arguments into account
408 PrimOpId op -> primOpOkForSpeculation op && args_ok
409 -- A bit conservative: we don't really need
410 -- to care about lazy arguments, but this is easy
414 go (App f a) n_args args_ok
415 | isTypeArg a = go f n_args args_ok
416 | otherwise = go f (n_args + 1) (exprOkForSpeculation a && args_ok)
418 go other n_args args_ok = False
423 exprIsBottom :: CoreExpr -> Bool -- True => definitely bottom
424 exprIsBottom e = go 0 e
426 -- n is the number of args
427 go n (Note _ e) = go n e
428 go n (Let _ e) = go n e
429 go n (Case e _ _) = go 0 e -- Just check the scrut
430 go n (App e _) = go (n+1) e
431 go n (Var v) = idAppIsBottom v n
433 go n (Lam _ _) = False
435 idAppIsBottom :: Id -> Int -> Bool
436 idAppIsBottom id n_val_args = appIsBottom (idStrictness id) n_val_args
439 @exprIsValue@ returns true for expressions that are certainly *already*
440 evaluated to WHNF. This is used to decide wether it's ok to change
441 case x of _ -> e ===> e
443 and to decide whether it's safe to discard a `seq`
445 So, it does *not* treat variables as evaluated, unless they say they are
448 exprIsValue :: CoreExpr -> Bool -- True => Value-lambda, constructor, PAP
449 exprIsValue (Type ty) = True -- Types are honorary Values; we don't mind
451 exprIsValue (Lit l) = True
452 exprIsValue (Lam b e) = isId b || exprIsValue e
453 exprIsValue (Note _ e) = exprIsValue e
454 exprIsValue other_expr
457 go (Var f) n_args = idAppIsValue f n_args
460 | isTypeArg a = go f n_args
461 | otherwise = go f (n_args + 1)
463 go (Note _ f) n_args = go f n_args
465 go other n_args = False
467 idAppIsValue :: Id -> Int -> Bool
468 idAppIsValue id n_val_args
469 = case idFlavour id of
471 PrimOpId _ -> n_val_args < idArity id
472 other | n_val_args == 0 -> isEvaldUnfolding (idUnfolding id)
473 | otherwise -> n_val_args < idArity id
474 -- A worry: what if an Id's unfolding is just itself:
475 -- then we could get an infinite loop...
479 exprArity :: CoreExpr -> Int -- How many value lambdas are at the top
480 exprArity (Lam b e) | isTyVar b = exprArity e
481 | otherwise = 1 + exprArity e
483 exprArity (Note note e) | ok_note note = exprArity e
485 ok_note (Coerce _ _) = True
486 -- We *do* look through coerces when getting arities.
487 -- Reason: arities are to do with *representation* and
489 ok_note InlineMe = True
490 ok_note InlineCall = True
491 ok_note other = False
492 -- SCC and TermUsg might be over-conservative?
498 exprIsConApp_maybe :: CoreExpr -> Maybe (DataCon, [CoreExpr])
499 exprIsConApp_maybe expr
500 = analyse (collectArgs expr)
502 analyse (Var fun, args)
503 | maybeToBool maybe_con_app = maybe_con_app
505 maybe_con_app = case isDataConId_maybe fun of
506 Just con | length args >= dataConRepArity con
507 -- Might be > because the arity excludes type args
511 analyse (Var fun, [])
512 = case maybeUnfoldingTemplate (idUnfolding fun) of
514 Just unf -> exprIsConApp_maybe unf
516 analyse other = Nothing
520 %************************************************************************
522 \subsection{Eta reduction and expansion}
524 %************************************************************************
526 @etaReduceExpr@ trys an eta reduction at the top level of a Core Expr.
528 e.g. \ x y -> f x y ===> f
530 But we only do this if it gets rid of a whole lambda, not part.
531 The idea is that lambdas are often quite helpful: they indicate
532 head normal forms, so we don't want to chuck them away lightly.
535 etaReduceExpr :: CoreExpr -> CoreExpr
536 -- ToDo: we should really check that we don't turn a non-bottom
537 -- lambda into a bottom variable. Sigh
539 etaReduceExpr expr@(Lam bndr body)
540 = check (reverse binders) body
542 (binders, body) = collectBinders expr
545 | not (any (`elemVarSet` body_fvs) binders)
548 body_fvs = exprFreeVars body
550 check (b : bs) (App fun arg)
551 | (varToCoreExpr b `cheapEqExpr` arg)
554 check _ _ = expr -- Bale out
556 etaReduceExpr expr = expr -- The common case
561 exprEtaExpandArity :: CoreExpr -> Int -- The number of args the thing can be applied to
562 -- without doing much work
563 -- This is used when eta expanding
564 -- e ==> \xy -> e x y
566 -- It returns 1 (or more) to:
567 -- case x of p -> \s -> ...
568 -- because for I/O ish things we really want to get that \s to the top.
569 -- We are prepared to evaluate x each time round the loop in order to get that
570 -- Hence "generous" arity
573 = go e `max` 0 -- Never go -ve!
575 go (Var v) = idArity v
576 go (App f (Type _)) = go f
577 go (App f a) | exprIsCheap a = go f - 1
578 go (Lam x e) | isId x = go e + 1
580 go (Note n e) | ok_note n = go e
581 go (Case scrut _ alts)
582 | exprIsCheap scrut = min_zero [go rhs | (_,_,rhs) <- alts]
584 | all exprIsCheap (rhssOfBind b) = go e
588 ok_note (Coerce _ _) = True
589 ok_note InlineCall = True
590 ok_note other = False
591 -- Notice that we do not look through __inline_me__
592 -- This one is a bit more surprising, but consider
593 -- f = _inline_me (\x -> e)
594 -- We DO NOT want to eta expand this to
595 -- f = \x -> (_inline_me (\x -> e)) x
596 -- because the _inline_me gets dropped now it is applied,
601 min_zero :: [Int] -> Int -- Find the minimum, but zero is the smallest
602 min_zero (x:xs) = go x xs
604 go 0 xs = 0 -- Nothing beats zero
606 go min (x:xs) | x < min = go x xs
607 | otherwise = go min xs
612 %************************************************************************
614 \subsection{Equality}
616 %************************************************************************
618 @cheapEqExpr@ is a cheap equality test which bales out fast!
619 True => definitely equal
620 False => may or may not be equal
623 cheapEqExpr :: Expr b -> Expr b -> Bool
625 cheapEqExpr (Var v1) (Var v2) = v1==v2
626 cheapEqExpr (Lit lit1) (Lit lit2) = lit1 == lit2
627 cheapEqExpr (Type t1) (Type t2) = t1 == t2
629 cheapEqExpr (App f1 a1) (App f2 a2)
630 = f1 `cheapEqExpr` f2 && a1 `cheapEqExpr` a2
632 cheapEqExpr _ _ = False
634 exprIsBig :: Expr b -> Bool
635 -- Returns True of expressions that are too big to be compared by cheapEqExpr
636 exprIsBig (Lit _) = False
637 exprIsBig (Var v) = False
638 exprIsBig (Type t) = False
639 exprIsBig (App f a) = exprIsBig f || exprIsBig a
640 exprIsBig other = True
645 eqExpr :: CoreExpr -> CoreExpr -> Bool
646 -- Works ok at more general type, but only needed at CoreExpr
648 = eq emptyVarEnv e1 e2
650 -- The "env" maps variables in e1 to variables in ty2
651 -- So when comparing lambdas etc,
652 -- we in effect substitute v2 for v1 in e1 before continuing
653 eq env (Var v1) (Var v2) = case lookupVarEnv env v1 of
654 Just v1' -> v1' == v2
657 eq env (Lit lit1) (Lit lit2) = lit1 == lit2
658 eq env (App f1 a1) (App f2 a2) = eq env f1 f2 && eq env a1 a2
659 eq env (Lam v1 e1) (Lam v2 e2) = eq (extendVarEnv env v1 v2) e1 e2
660 eq env (Let (NonRec v1 r1) e1)
661 (Let (NonRec v2 r2) e2) = eq env r1 r2 && eq (extendVarEnv env v1 v2) e1 e2
662 eq env (Let (Rec ps1) e1)
663 (Let (Rec ps2) e2) = length ps1 == length ps2 &&
664 and (zipWith eq_rhs ps1 ps2) &&
667 env' = extendVarEnvList env [(v1,v2) | ((v1,_),(v2,_)) <- zip ps1 ps2]
668 eq_rhs (_,r1) (_,r2) = eq env' r1 r2
669 eq env (Case e1 v1 a1)
670 (Case e2 v2 a2) = eq env e1 e2 &&
671 length a1 == length a2 &&
672 and (zipWith (eq_alt env') a1 a2)
674 env' = extendVarEnv env v1 v2
676 eq env (Note n1 e1) (Note n2 e2) = eq_note env n1 n2 && eq env e1 e2
677 eq env (Type t1) (Type t2) = t1 == t2
680 eq_list env [] [] = True
681 eq_list env (e1:es1) (e2:es2) = eq env e1 e2 && eq_list env es1 es2
682 eq_list env es1 es2 = False
684 eq_alt env (c1,vs1,r1) (c2,vs2,r2) = c1==c2 &&
685 eq (extendVarEnvList env (vs1 `zip` vs2)) r1 r2
687 eq_note env (SCC cc1) (SCC cc2) = cc1 == cc2
688 eq_note env (Coerce t1 f1) (Coerce t2 f2) = t1==t2 && f1==f2
689 eq_note env InlineCall InlineCall = True
690 eq_note env other1 other2 = False
694 %************************************************************************
696 \subsection{The size of an expression}
698 %************************************************************************
701 coreBindsSize :: [CoreBind] -> Int
702 coreBindsSize bs = foldr ((+) . bindSize) 0 bs
704 exprSize :: CoreExpr -> Int
705 -- A measure of the size of the expressions
706 -- It also forces the expression pretty drastically as a side effect
707 exprSize (Var v) = varSize v
708 exprSize (Lit lit) = lit `seq` 1
709 exprSize (App f a) = exprSize f + exprSize a
710 exprSize (Lam b e) = varSize b + exprSize e
711 exprSize (Let b e) = bindSize b + exprSize e
712 exprSize (Case e b as) = exprSize e + varSize b + foldr ((+) . altSize) 0 as
713 exprSize (Note n e) = noteSize n + exprSize e
714 exprSize (Type t) = seqType t `seq` 1
716 noteSize (SCC cc) = cc `seq` 1
717 noteSize (Coerce t1 t2) = seqType t1 `seq` seqType t2 `seq` 1
718 noteSize InlineCall = 1
719 noteSize InlineMe = 1
720 noteSize (TermUsg usg) = usg `seq` 1
722 exprsSize = foldr ((+) . exprSize) 0
724 varSize :: Var -> Int
725 varSize b | isTyVar b = 1
726 | otherwise = seqType (idType b) `seq`
727 megaSeqIdInfo (idInfo b) `seq`
730 varsSize = foldr ((+) . varSize) 0
732 bindSize (NonRec b e) = varSize b + exprSize e
733 bindSize (Rec prs) = foldr ((+) . pairSize) 0 prs
735 pairSize (b,e) = varSize b + exprSize e
737 altSize (c,bs,e) = c `seq` varsSize bs + exprSize e
741 %************************************************************************
745 %************************************************************************
748 hashExpr :: CoreExpr -> Int
749 hashExpr e | hash < 0 = 77 -- Just in case we hit -maxInt
752 hash = abs (hash_expr e) -- Negative numbers kill UniqFM
754 hash_expr (Note _ e) = hash_expr e
755 hash_expr (Let (NonRec b r) e) = hashId b
756 hash_expr (Let (Rec ((b,r):_)) e) = hashId b
757 hash_expr (Case _ b _) = hashId b
758 hash_expr (App f e) = hash_expr f * fast_hash_expr e
759 hash_expr (Var v) = hashId v
760 hash_expr (Lit lit) = hashLiteral lit
761 hash_expr (Lam b _) = hashId b
762 hash_expr (Type t) = trace "hash_expr: type" 1 -- Shouldn't happen
764 fast_hash_expr (Var v) = hashId v
765 fast_hash_expr (Lit lit) = hashLiteral lit
766 fast_hash_expr (App f (Type _)) = fast_hash_expr f
767 fast_hash_expr (App f a) = fast_hash_expr a
768 fast_hash_expr (Lam b _) = hashId b
769 fast_hash_expr other = 1
772 hashId id = hashName (idName id)