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 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 Maybes ( maybeToBool )
67 import TysPrim ( alphaTy ) -- Debugging only
71 %************************************************************************
73 \subsection{Find the type of a Core atom/expression}
75 %************************************************************************
78 exprType :: CoreExpr -> Type
80 exprType (Var var) = idType var
81 exprType (Lit lit) = literalType lit
82 exprType (Let _ body) = exprType body
83 exprType (Case _ _ alts) = coreAltsType alts
84 exprType (Note (Coerce ty _) e) = ty -- **! should take usage from e
85 exprType (Note (TermUsg u) e) = mkUsgTy u (unUsgTy (exprType e))
86 exprType (Note other_note e) = exprType e
87 exprType (Lam binder expr) = mkPiType binder (exprType expr)
89 = case collectArgs e of
90 (fun, args) -> applyTypeToArgs e (exprType fun) args
92 exprType other = pprTrace "exprType" (pprCoreExpr other) alphaTy
94 coreAltsType :: [CoreAlt] -> Type
95 coreAltsType ((_,_,rhs) : _) = exprType rhs
98 @mkPiType@ makes a (->) type or a forall type, depending on whether
99 it is given a type variable or a term variable. We cleverly use the
100 lbvarinfo field to figure out the right annotation for the arrove in
101 case of a term variable.
104 mkPiType :: Var -> Type -> Type -- The more polymorphic version doesn't work...
105 mkPiType v ty | isId v = (case idLBVarInfo v of
106 IsOneShotLambda -> mkUsgTy UsOnce
108 mkFunTy (idType v) ty
109 | isTyVar v = mkForAllTy v ty
113 -- The first argument is just for debugging
114 applyTypeToArgs :: CoreExpr -> Type -> [CoreExpr] -> Type
115 applyTypeToArgs e op_ty [] = op_ty
117 applyTypeToArgs e op_ty (Type ty : args)
118 = -- Accumulate type arguments so we can instantiate all at once
119 ASSERT2( all isNotUsgTy tys,
120 ppr e <+> text "of" <+> ppr op_ty <+> text "to" <+>
121 ppr (Type ty : args) <+> text "i.e." <+> ppr tys )
122 applyTypeToArgs e (applyTys op_ty tys) rest_args
124 (tys, rest_args) = go [ty] args
125 go tys (Type ty : args) = go (ty:tys) args
126 go tys rest_args = (reverse tys, rest_args)
128 applyTypeToArgs e op_ty (other_arg : args)
129 = case (splitFunTy_maybe op_ty) of
130 Just (_, res_ty) -> applyTypeToArgs e res_ty args
131 Nothing -> pprPanic "applyTypeToArgs" (pprCoreExpr e)
136 %************************************************************************
138 \subsection{Attaching notes}
140 %************************************************************************
142 mkNote removes redundant coercions, and SCCs where possible
145 mkNote :: Note -> CoreExpr -> CoreExpr
146 mkNote (Coerce to_ty from_ty) expr = mkCoerce to_ty from_ty expr
147 mkNote (SCC cc) expr = mkSCC cc expr
148 mkNote InlineMe expr = mkInlineMe expr
149 mkNote note expr = Note note expr
151 -- Slide InlineCall in around the function
152 -- No longer necessary I think (SLPJ Apr 99)
153 -- mkNote InlineCall (App f a) = App (mkNote InlineCall f) a
154 -- mkNote InlineCall (Var v) = Note InlineCall (Var v)
155 -- mkNote InlineCall expr = expr
158 Drop trivial InlineMe's. This is somewhat important, because if we have an unfolding
159 that looks like (Note InlineMe (Var v)), the InlineMe doesn't go away because it may
160 not be *applied* to anything.
163 mkInlineMe e | exprIsTrivial e = e
164 | otherwise = Note InlineMe e
170 mkCoerce :: Type -> Type -> CoreExpr -> CoreExpr
172 mkCoerce to_ty from_ty (Note (Coerce to_ty2 from_ty2) expr)
173 = ASSERT( from_ty == to_ty2 )
174 mkCoerce to_ty from_ty2 expr
176 mkCoerce to_ty from_ty expr
177 | to_ty == from_ty = expr
178 | otherwise = ASSERT( from_ty == exprType expr )
179 Note (Coerce to_ty from_ty) expr
183 mkSCC :: CostCentre -> Expr b -> Expr b
184 -- Note: Nested SCC's *are* preserved for the benefit of
185 -- cost centre stack profiling (Durham)
187 mkSCC cc (Lit lit) = Lit lit
188 mkSCC cc (Lam x e) = Lam x (mkSCC cc e) -- Move _scc_ inside lambda
189 mkSCC cc expr = Note (SCC cc) expr
193 %************************************************************************
195 \subsection{Other expression construction}
197 %************************************************************************
200 bindNonRec :: Id -> CoreExpr -> CoreExpr -> CoreExpr
201 -- (bindNonRec x r b) produces either
204 -- case r of x { _DEFAULT_ -> b }
206 -- depending on whether x is unlifted or not
207 -- It's used by the desugarer to avoid building bindings
208 -- that give Core Lint a heart attack. Actually the simplifier
209 -- deals with them perfectly well.
210 bindNonRec bndr rhs body
211 | isUnLiftedType (idType bndr) = Case rhs bndr [(DEFAULT,[],body)]
212 | otherwise = Let (NonRec bndr rhs) body
216 mkAltExpr :: AltCon -> [CoreBndr] -> [Type] -> CoreExpr
217 -- This guy constructs the value that the scrutinee must have
218 -- when you are in one particular branch of a case
219 mkAltExpr (DataAlt con) args inst_tys
220 = mkConApp con (map Type inst_tys ++ map varToCoreExpr args)
221 mkAltExpr (LitAlt lit) [] []
224 mkIfThenElse :: CoreExpr -> CoreExpr -> CoreExpr -> CoreExpr
225 mkIfThenElse guard then_expr else_expr
226 = Case guard (mkWildId boolTy)
227 [ (DataAlt trueDataCon, [], then_expr),
228 (DataAlt falseDataCon, [], else_expr) ]
231 %************************************************************************
233 \subsection{Figuring out things about expressions}
235 %************************************************************************
237 @exprIsTrivial@ is true of expressions we are unconditionally happy to
238 duplicate; simple variables and constants, and type
239 applications. Note that primop Ids aren't considered
242 @exprIsBottom@ is true of expressions that are guaranteed to diverge
246 exprIsTrivial (Var v)
247 | Just op <- isPrimOpId_maybe v = primOpIsDupable op
249 exprIsTrivial (Type _) = True
250 exprIsTrivial (Lit lit) = True
251 exprIsTrivial (App e arg) = isTypeArg arg && exprIsTrivial e
252 exprIsTrivial (Note _ e) = exprIsTrivial e
253 exprIsTrivial (Lam b body) | isTyVar b = exprIsTrivial body
254 exprIsTrivial other = False
258 @exprIsDupable@ is true of expressions that can be duplicated at a modest
259 cost in code size. This will only happen in different case
260 branches, so there's no issue about duplicating work.
262 That is, exprIsDupable returns True of (f x) even if
263 f is very very expensive to call.
265 Its only purpose is to avoid fruitless let-binding
266 and then inlining of case join points
270 exprIsDupable (Type _) = True
271 exprIsDupable (Var v) = True
272 exprIsDupable (Lit lit) = litIsDupable lit
273 exprIsDupable (Note _ e) = exprIsDupable e
277 go (Var v) n_args = True
278 go (App f a) n_args = n_args < dupAppSize
281 go other n_args = False
284 dupAppSize = 4 -- Size of application we are prepared to duplicate
287 @exprIsCheap@ looks at a Core expression and returns \tr{True} if
288 it is obviously in weak head normal form, or is cheap to get to WHNF.
289 [Note that that's not the same as exprIsDupable; an expression might be
290 big, and hence not dupable, but still cheap.]
292 By ``cheap'' we mean a computation we're willing to:
293 push inside a lambda, or
294 inline at more than one place
295 That might mean it gets evaluated more than once, instead of being
296 shared. The main examples of things which aren't WHNF but are
301 (where e, and all the ei are cheap)
304 (where e and b are cheap)
307 (where op is a cheap primitive operator)
310 (because we are happy to substitute it inside a lambda)
312 Notice that a variable is considered 'cheap': we can push it inside a lambda,
313 because sharing will make sure it is only evaluated once.
316 exprIsCheap :: CoreExpr -> Bool
317 exprIsCheap (Lit lit) = True
318 exprIsCheap (Type _) = True
319 exprIsCheap (Var _) = True
320 exprIsCheap (Note _ e) = exprIsCheap e
321 exprIsCheap (Lam x e) = if isId x then True else exprIsCheap e
322 exprIsCheap (Case e _ alts) = exprIsCheap e &&
323 and [exprIsCheap rhs | (_,_,rhs) <- alts]
324 -- Experimentally, treat (case x of ...) as cheap
325 -- (and case __coerce x etc.)
326 -- This improves arities of overloaded functions where
327 -- there is only dictionary selection (no construction) involved
328 exprIsCheap (Let (NonRec x _) e)
329 | isUnLiftedType (idType x) = exprIsCheap e
331 -- strict lets always have cheap right hand sides, and
334 exprIsCheap other_expr
335 = go other_expr 0 True
337 go (Var f) n_args args_cheap
338 = (idAppIsCheap f n_args && args_cheap)
339 -- A constructor, cheap primop, or partial application
341 || idAppIsBottom f n_args
342 -- Application of a function which
343 -- always gives bottom; we treat this as cheap
344 -- because it certainly doesn't need to be shared!
346 go (App f a) n_args args_cheap
347 | isTypeArg a = go f n_args args_cheap
348 | otherwise = go f (n_args + 1) (exprIsCheap a && args_cheap)
350 go other n_args args_cheap = False
352 idAppIsCheap :: Id -> Int -> Bool
353 idAppIsCheap id n_val_args
354 | n_val_args == 0 = True -- Just a type application of
355 -- a variable (f t1 t2 t3)
357 | otherwise = case idFlavour id of
359 RecordSelId _ -> True -- I'm experimenting with making record selection
360 -- look cheap, so we will substitute it inside a
361 -- lambda. Particularly for dictionary field selection
363 PrimOpId op -> primOpIsCheap op -- In principle we should worry about primops
364 -- that return a type variable, since the result
365 -- might be applied to something, but I'm not going
366 -- to bother to check the number of args
367 other -> n_val_args < idArity id
370 exprOkForSpeculation returns True of an expression that it is
372 * safe to evaluate even if normal order eval might not
373 evaluate the expression at all, or
375 * safe *not* to evaluate even if normal order would do so
379 the expression guarantees to terminate,
381 without raising an exception,
382 without causing a side effect (e.g. writing a mutable variable)
385 let x = case y# +# 1# of { r# -> I# r# }
388 case y# +# 1# of { r# ->
393 We can only do this if the (y+1) is ok for speculation: it has no
394 side effects, and can't diverge or raise an exception.
397 exprOkForSpeculation :: CoreExpr -> Bool
398 exprOkForSpeculation (Lit _) = True
399 exprOkForSpeculation (Var v) = isUnLiftedType (idType v)
400 exprOkForSpeculation (Note _ e) = exprOkForSpeculation e
401 exprOkForSpeculation other_expr
402 = go other_expr 0 True
404 go (Var f) n_args args_ok
405 = case idFlavour f of
406 DataConId _ -> True -- The strictness of the constructor has already
407 -- been expressed by its "wrapper", so we don't need
408 -- to take the arguments into account
410 PrimOpId op -> primOpOkForSpeculation op && args_ok
411 -- A bit conservative: we don't really need
412 -- to care about lazy arguments, but this is easy
416 go (App f a) n_args args_ok
417 | isTypeArg a = go f n_args args_ok
418 | otherwise = go f (n_args + 1) (exprOkForSpeculation a && args_ok)
420 go other n_args args_ok = False
425 exprIsBottom :: CoreExpr -> Bool -- True => definitely bottom
426 exprIsBottom e = go 0 e
428 -- n is the number of args
429 go n (Note _ e) = go n e
430 go n (Let _ e) = go n e
431 go n (Case e _ _) = go 0 e -- Just check the scrut
432 go n (App e _) = go (n+1) e
433 go n (Var v) = idAppIsBottom v n
435 go n (Lam _ _) = False
437 idAppIsBottom :: Id -> Int -> Bool
438 idAppIsBottom id n_val_args = appIsBottom (idStrictness id) n_val_args
441 @exprIsValue@ returns true for expressions that are certainly *already*
442 evaluated to WHNF. This is used to decide wether it's ok to change
443 case x of _ -> e ===> e
445 and to decide whether it's safe to discard a `seq`
447 So, it does *not* treat variables as evaluated, unless they say they are
450 exprIsValue :: CoreExpr -> Bool -- True => Value-lambda, constructor, PAP
451 exprIsValue (Type ty) = True -- Types are honorary Values; we don't mind
453 exprIsValue (Lit l) = True
454 exprIsValue (Lam b e) = isId b || exprIsValue e
455 exprIsValue (Note _ e) = exprIsValue e
456 exprIsValue other_expr
459 go (Var f) n_args = idAppIsValue f n_args
462 | isTypeArg a = go f n_args
463 | otherwise = go f (n_args + 1)
465 go (Note _ f) n_args = go f n_args
467 go other n_args = False
469 idAppIsValue :: Id -> Int -> Bool
470 idAppIsValue id n_val_args
471 = case idFlavour id of
473 PrimOpId _ -> n_val_args < idArity id
474 other | n_val_args == 0 -> isEvaldUnfolding (idUnfolding id)
475 | otherwise -> n_val_args < idArity id
476 -- A worry: what if an Id's unfolding is just itself:
477 -- then we could get an infinite loop...
481 exprIsConApp_maybe :: CoreExpr -> Maybe (DataCon, [CoreExpr])
482 exprIsConApp_maybe expr
483 = analyse (collectArgs expr)
485 analyse (Var fun, args)
486 | maybeToBool maybe_con_app = maybe_con_app
488 maybe_con_app = case isDataConId_maybe fun of
489 Just con | length args >= dataConRepArity con
490 -- Might be > because the arity excludes type args
494 analyse (Var fun, [])
495 = case maybeUnfoldingTemplate (idUnfolding fun) of
497 Just unf -> exprIsConApp_maybe unf
499 analyse other = Nothing
503 %************************************************************************
505 \subsection{Eta reduction and expansion}
507 %************************************************************************
509 @etaReduceExpr@ trys an eta reduction at the top level of a Core Expr.
511 e.g. \ x y -> f x y ===> f
513 But we only do this if it gets rid of a whole lambda, not part.
514 The idea is that lambdas are often quite helpful: they indicate
515 head normal forms, so we don't want to chuck them away lightly.
518 etaReduceExpr :: CoreExpr -> CoreExpr
519 -- ToDo: we should really check that we don't turn a non-bottom
520 -- lambda into a bottom variable. Sigh
522 etaReduceExpr expr@(Lam bndr body)
523 = check (reverse binders) body
525 (binders, body) = collectBinders expr
528 | not (any (`elemVarSet` body_fvs) binders)
531 body_fvs = exprFreeVars body
533 check (b : bs) (App fun arg)
534 | (varToCoreExpr b `cheapEqExpr` arg)
537 check _ _ = expr -- Bale out
539 etaReduceExpr expr = expr -- The common case
544 exprEtaExpandArity :: CoreExpr -> Int -- The number of args the thing can be applied to
545 -- without doing much work
546 -- This is used when eta expanding
547 -- e ==> \xy -> e x y
549 -- It returns 1 (or more) to:
550 -- case x of p -> \s -> ...
551 -- because for I/O ish things we really want to get that \s to the top.
552 -- We are prepared to evaluate x each time round the loop in order to get that
553 -- Hence "generous" arity
556 = go e `max` 0 -- Never go -ve!
558 go (Var v) = idArity v
559 go (App f (Type _)) = go f
560 go (App f a) | exprIsCheap a = go f - 1
561 go (Lam x e) | isId x = go e + 1
563 go (Note n e) | ok_note n = go e
564 go (Case scrut _ alts)
565 | exprIsCheap scrut = min_zero [go rhs | (_,_,rhs) <- alts]
567 | all exprIsCheap (rhssOfBind b) = go e
571 ok_note (Coerce _ _) = True
572 ok_note InlineCall = True
573 ok_note other = False
574 -- Notice that we do not look through __inline_me__
575 -- This one is a bit more surprising, but consider
576 -- f = _inline_me (\x -> e)
577 -- We DO NOT want to eta expand this to
578 -- f = \x -> (_inline_me (\x -> e)) x
579 -- because the _inline_me gets dropped now it is applied,
584 min_zero :: [Int] -> Int -- Find the minimum, but zero is the smallest
585 min_zero (x:xs) = go x xs
587 go 0 xs = 0 -- Nothing beats zero
589 go min (x:xs) | x < min = go x xs
590 | otherwise = go min xs
595 %************************************************************************
597 \subsection{Equality}
599 %************************************************************************
601 @cheapEqExpr@ is a cheap equality test which bales out fast!
602 True => definitely equal
603 False => may or may not be equal
606 cheapEqExpr :: Expr b -> Expr b -> Bool
608 cheapEqExpr (Var v1) (Var v2) = v1==v2
609 cheapEqExpr (Lit lit1) (Lit lit2) = lit1 == lit2
610 cheapEqExpr (Type t1) (Type t2) = t1 == t2
612 cheapEqExpr (App f1 a1) (App f2 a2)
613 = f1 `cheapEqExpr` f2 && a1 `cheapEqExpr` a2
615 cheapEqExpr _ _ = False
617 exprIsBig :: Expr b -> Bool
618 -- Returns True of expressions that are too big to be compared by cheapEqExpr
619 exprIsBig (Lit _) = False
620 exprIsBig (Var v) = False
621 exprIsBig (Type t) = False
622 exprIsBig (App f a) = exprIsBig f || exprIsBig a
623 exprIsBig other = True
628 eqExpr :: CoreExpr -> CoreExpr -> Bool
629 -- Works ok at more general type, but only needed at CoreExpr
631 = eq emptyVarEnv e1 e2
633 -- The "env" maps variables in e1 to variables in ty2
634 -- So when comparing lambdas etc,
635 -- we in effect substitute v2 for v1 in e1 before continuing
636 eq env (Var v1) (Var v2) = case lookupVarEnv env v1 of
637 Just v1' -> v1' == v2
640 eq env (Lit lit1) (Lit lit2) = lit1 == lit2
641 eq env (App f1 a1) (App f2 a2) = eq env f1 f2 && eq env a1 a2
642 eq env (Lam v1 e1) (Lam v2 e2) = eq (extendVarEnv env v1 v2) e1 e2
643 eq env (Let (NonRec v1 r1) e1)
644 (Let (NonRec v2 r2) e2) = eq env r1 r2 && eq (extendVarEnv env v1 v2) e1 e2
645 eq env (Let (Rec ps1) e1)
646 (Let (Rec ps2) e2) = length ps1 == length ps2 &&
647 and (zipWith eq_rhs ps1 ps2) &&
650 env' = extendVarEnvList env [(v1,v2) | ((v1,_),(v2,_)) <- zip ps1 ps2]
651 eq_rhs (_,r1) (_,r2) = eq env' r1 r2
652 eq env (Case e1 v1 a1)
653 (Case e2 v2 a2) = eq env e1 e2 &&
654 length a1 == length a2 &&
655 and (zipWith (eq_alt env') a1 a2)
657 env' = extendVarEnv env v1 v2
659 eq env (Note n1 e1) (Note n2 e2) = eq_note env n1 n2 && eq env e1 e2
660 eq env (Type t1) (Type t2) = t1 == t2
663 eq_list env [] [] = True
664 eq_list env (e1:es1) (e2:es2) = eq env e1 e2 && eq_list env es1 es2
665 eq_list env es1 es2 = False
667 eq_alt env (c1,vs1,r1) (c2,vs2,r2) = c1==c2 &&
668 eq (extendVarEnvList env (vs1 `zip` vs2)) r1 r2
670 eq_note env (SCC cc1) (SCC cc2) = cc1 == cc2
671 eq_note env (Coerce t1 f1) (Coerce t2 f2) = t1==t2 && f1==f2
672 eq_note env InlineCall InlineCall = True
673 eq_note env other1 other2 = False
677 %************************************************************************
679 \subsection{The size of an expression}
681 %************************************************************************
684 coreBindsSize :: [CoreBind] -> Int
685 coreBindsSize bs = foldr ((+) . bindSize) 0 bs
687 exprSize :: CoreExpr -> Int
688 -- A measure of the size of the expressions
689 -- It also forces the expression pretty drastically as a side effect
690 exprSize (Var v) = varSize v
691 exprSize (Lit lit) = lit `seq` 1
692 exprSize (App f a) = exprSize f + exprSize a
693 exprSize (Lam b e) = varSize b + exprSize e
694 exprSize (Let b e) = bindSize b + exprSize e
695 exprSize (Case e b as) = exprSize e + varSize b + foldr ((+) . altSize) 0 as
696 exprSize (Note n e) = noteSize n + exprSize e
697 exprSize (Type t) = seqType t `seq` 1
699 noteSize (SCC cc) = cc `seq` 1
700 noteSize (Coerce t1 t2) = seqType t1 `seq` seqType t2 `seq` 1
701 noteSize InlineCall = 1
702 noteSize InlineMe = 1
703 noteSize (TermUsg usg) = usg `seq` 1
705 exprsSize = foldr ((+) . exprSize) 0
707 varSize :: Var -> Int
708 varSize b | isTyVar b = 1
709 | otherwise = seqType (idType b) `seq`
710 megaSeqIdInfo (idInfo b) `seq`
713 varsSize = foldr ((+) . varSize) 0
715 bindSize (NonRec b e) = varSize b + exprSize e
716 bindSize (Rec prs) = foldr ((+) . pairSize) 0 prs
718 pairSize (b,e) = varSize b + exprSize e
720 altSize (c,bs,e) = c `seq` varsSize bs + exprSize e
724 %************************************************************************
728 %************************************************************************
731 hashExpr :: CoreExpr -> Int
732 hashExpr e | hash < 0 = 77 -- Just in case we hit -maxInt
735 hash = abs (hash_expr e) -- Negative numbers kill UniqFM
737 hash_expr (Note _ e) = hash_expr e
738 hash_expr (Let (NonRec b r) e) = hashId b
739 hash_expr (Let (Rec ((b,r):_)) e) = hashId b
740 hash_expr (Case _ b _) = hashId b
741 hash_expr (App f e) = hash_expr f * fast_hash_expr e
742 hash_expr (Var v) = hashId v
743 hash_expr (Lit lit) = hashLiteral lit
744 hash_expr (Lam b _) = hashId b
745 hash_expr (Type t) = trace "hash_expr: type" 1 -- Shouldn't happen
747 fast_hash_expr (Var v) = hashId v
748 fast_hash_expr (Lit lit) = hashLiteral lit
749 fast_hash_expr (App f (Type _)) = fast_hash_expr f
750 fast_hash_expr (App f a) = fast_hash_expr a
751 fast_hash_expr (Lam b _) = hashId b
752 fast_hash_expr other = 1
755 hashId id = hashName (idName id)