2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
4 \section[CoreUtils]{Utility functions on @Core@ syntax}
7 #include "HsVersions.h"
10 coreExprType, coreAltsType,
12 substCoreExpr, substCoreBindings
16 , unTagBinders, unTagBindersAlts
17 , manifestlyWHNF, manifestlyBottom
20 , squashableDictishCcExpr
21 {- exprSmallEnoughToDup,
28 import IdLoop -- for pananoia-checking purposes
32 import CostCentre ( isDictCC )
33 import Id ( idType, mkSysLocal, getIdArity, isBottomingId,
34 addOneToIdEnv, growIdEnvList, lookupIdEnv,
35 isNullIdEnv, IdEnv(..),
38 import IdInfo ( arityMaybe )
39 import Literal ( literalType, isNoRepLit, Literal(..) )
40 import Maybes ( catMaybes, maybeToBool )
41 import PprCore ( GenCoreExpr{-instances-}, GenCoreArg{-instances-} )
42 import PprStyle ( PprStyle(..) )
43 import PprType ( GenType{-instances-} )
44 import Pretty ( ppAboves )
45 import PrelInfo ( trueDataCon, falseDataCon,
48 import PrimOp ( primOpType, PrimOp(..) )
49 import SrcLoc ( mkUnknownSrcLoc )
50 import TyVar ( isNullTyVarEnv, TyVarEnv(..) )
51 import Type ( mkFunTys, mkForAllTy, mkForAllUsageTy, mkTyVarTy,
52 getFunTy_maybe, applyTy, isPrimType,
53 splitSigmaTy, splitFunTy, eqTy, applyTypeEnvToTy
55 import UniqSupply ( initUs, returnUs, thenUs,
56 mapUs, mapAndUnzipUs, getUnique,
57 UniqSM(..), UniqSupply
59 import Usage ( UVar(..) )
60 import Util ( zipEqual, panic, pprPanic, assertPanic )
62 type TypeEnv = TyVarEnv Type
63 applyUsage = panic "CoreUtils.applyUsage:ToDo"
64 dup_binder = panic "CoreUtils.dup_binder"
67 %************************************************************************
69 \subsection{Find the type of a Core atom/expression}
71 %************************************************************************
74 coreExprType :: CoreExpr -> Type
76 coreExprType (Var var) = idType var
77 coreExprType (Lit lit) = literalType lit
79 coreExprType (Let _ body) = coreExprType body
80 coreExprType (SCC _ expr) = coreExprType expr
81 coreExprType (Case _ alts) = coreAltsType alts
83 -- a Con is a fully-saturated application of a data constructor
84 -- a Prim is <ditto> of a PrimOp
86 coreExprType (Con con args) = applyTypeToArgs (idType con) args
87 coreExprType (Prim op args) = applyTypeToArgs (primOpType op) args
89 coreExprType (Lam (ValBinder binder) expr)
90 = mkFunTys [idType binder] (coreExprType expr)
92 coreExprType (Lam (TyBinder tyvar) expr)
93 = mkForAllTy tyvar (coreExprType expr)
95 coreExprType (Lam (UsageBinder uvar) expr)
96 = mkForAllUsageTy uvar (panic "coreExprType:Lam UsageBinder") (coreExprType expr)
98 coreExprType (App expr (TyArg ty))
99 = applyTy (coreExprType expr) ty
101 coreExprType (App expr (UsageArg use))
102 = applyUsage (coreExprType expr) use
104 coreExprType (App expr val_arg)
105 = ASSERT(isValArg val_arg)
107 fun_ty = coreExprType expr
109 case (getFunTy_maybe fun_ty) of
110 Just (_, result_ty) -> result_ty
112 Nothing -> pprPanic "coreExprType:\n"
113 (ppAboves [ppr PprDebug fun_ty,
114 ppr PprShowAll (App expr val_arg)])
119 coreAltsType :: CoreCaseAlts -> Type
121 coreAltsType (AlgAlts [] deflt) = default_ty deflt
122 coreAltsType (AlgAlts ((_,_,rhs1):_) _) = coreExprType rhs1
124 coreAltsType (PrimAlts [] deflt) = default_ty deflt
125 coreAltsType (PrimAlts ((_,rhs1):_) _) = coreExprType rhs1
127 default_ty NoDefault = panic "coreExprType:Case:default_ty"
128 default_ty (BindDefault _ rhs) = coreExprType rhs
132 applyTypeToArgs op_ty args
133 = foldl applyTy op_ty [ ty | TyArg ty <- args ]
136 %************************************************************************
138 \subsection{Routines to manufacture bits of @CoreExpr@}
140 %************************************************************************
143 mkCoreIfThenElse (Var bool) then_expr else_expr
144 | bool == trueDataCon = then_expr
145 | bool == falseDataCon = else_expr
147 mkCoreIfThenElse guard then_expr else_expr
149 (AlgAlts [ (trueDataCon, [], then_expr),
150 (falseDataCon, [], else_expr) ]
154 For making @Apps@ and @Lets@, we must take appropriate evasive
155 action if the thing being bound has unboxed type. @mkCoApp@ requires
156 a name supply to do its work.
158 @mkCoApps@, @mkCoCon@ and @mkCoPrim@ also handle the
159 arguments-must-be-atoms constraint.
166 mkCoApps :: CoreExpr -> [CoreArgOrExpr] -> UniqSM CoreExpr
167 mkCoCon :: Id -> [CoreArgOrExpr] -> UniqSM CoreExpr
168 mkCoPrim :: PrimOp -> [CoreArgOrExpr] -> UniqSM CoreExpr
170 mkCoApps fun args = co_thing (mkGenApp fun) args
171 mkCoCon con args = co_thing (Con con) args
172 mkCoPrim op args = co_thing (Prim op) args
174 co_thing :: ([CoreArg] -> CoreExpr)
178 co_thing thing arg_exprs
179 = mapAndUnzipUs expr_to_arg arg_exprs `thenUs` \ (args, maybe_binds) ->
180 returnUs (mkCoLetsUnboxedToCase (catMaybes maybe_binds) (thing args))
182 expr_to_arg :: CoreArgOrExpr
183 -> UniqSM (CoreArg, Maybe CoreBinding)
185 expr_to_arg (AnArg arg) = returnUs (arg, Nothing)
186 expr_to_arg (AnExpr (Var v)) = returnUs (VarArg v, Nothing)
187 expr_to_arg (AnExpr (Lit l)) = returnUs (LitArg l, Nothing)
188 expr_to_arg (AnExpr other_expr)
190 e_ty = coreExprType other_expr
192 getUnique `thenUs` \ uniq ->
194 new_var = mkSysLocal SLIT("a") uniq e_ty mkUnknownSrcLoc
196 returnUs (VarArg new_var, Just (NonRec new_var other_expr))
201 GenCoreArg val_occ tyvar uvar -> GenCoreExpr val_bdr val_occ tyvar uvar
203 argToExpr (VarArg v) = Var v
204 argToExpr (LitArg lit) = Lit lit
209 exprSmallEnoughToDup :: GenCoreExpr binder Id -> Bool
211 exprSmallEnoughToDup (Con _ _ _) = True -- Could check # of args
212 exprSmallEnoughToDup (Prim op _ _) = not (fragilePrimOp op) -- Could check # of args
213 exprSmallEnoughToDup (Lit lit) = not (isNoRepLit lit)
215 exprSmallEnoughToDup expr -- for now, just: <var> applied to <args>
216 = case (collectArgs expr) of { (fun, _, _, vargs) ->
218 Var v -> v /= buildId
220 && length vargs <= 6 -- or 10 or 1 or 4 or anything smallish.
225 Question (ADR): What is the above used for? Is a _ccall_ really small
228 @manifestlyWHNF@ looks at a Core expression and returns \tr{True} if
229 it is obviously in weak head normal form. It isn't a disaster if it
230 errs on the conservative side (returning \tr{False})---I've probably
231 left something out... [WDP]
234 manifestlyWHNF :: GenCoreExpr bndr Id tyvar uvar -> Bool
236 manifestlyWHNF (Var _) = True
237 manifestlyWHNF (Lit _) = True
238 manifestlyWHNF (Con _ _) = True
239 manifestlyWHNF (SCC _ e) = manifestlyWHNF e
240 manifestlyWHNF (Let _ e) = False
241 manifestlyWHNF (Case _ _) = False
243 manifestlyWHNF (Lam x e) = if isValBinder x then True else manifestlyWHNF e
245 manifestlyWHNF other_expr -- look for manifest partial application
246 = case (collectArgs other_expr) of { (fun, _, _, vargs) ->
249 num_val_args = length vargs
251 num_val_args == 0 -- Just a type application of
252 -- a variable (f t1 t2 t3);
255 case (arityMaybe (getIdArity f)) of
257 Just arity -> num_val_args < arity
263 @manifestlyBottom@ looks at a Core expression and returns \tr{True} if
264 it is obviously bottom, that is, it will certainly return bottom at
265 some point. It isn't a disaster if it errs on the conservative side
266 (returning \tr{False}).
269 manifestlyBottom :: GenCoreExpr bndr Id tyvar uvar -> Bool
271 manifestlyBottom (Var v) = isBottomingId v
272 manifestlyBottom (Lit _) = False
273 manifestlyBottom (Con _ _) = False
274 manifestlyBottom (Prim _ _) = False
275 manifestlyBottom (SCC _ e) = manifestlyBottom e
276 manifestlyBottom (Let _ e) = manifestlyBottom e
278 -- We do not assume \x.bottom == bottom:
279 manifestlyBottom (Lam x e) = if isValBinder x then False else manifestlyBottom e
281 manifestlyBottom (Case e a)
284 AlgAlts alts def -> all mbalg alts && mbdef def
285 PrimAlts alts def -> all mbprim alts && mbdef def
288 mbalg (_,_,e') = manifestlyBottom e'
290 mbprim (_,e') = manifestlyBottom e'
292 mbdef NoDefault = True
293 mbdef (BindDefault _ e') = manifestlyBottom e'
295 manifestlyBottom other_expr -- look for manifest partial application
296 = case (collectArgs other_expr) of { (fun, _, _, _) ->
298 Var f | isBottomingId f -> True
299 -- Application of a function which always gives
300 -- bottom; we treat this as a WHNF, because it
301 -- certainly doesn't need to be shared!
309 :: (Id -> Maybe (GenCoreExpr bndr Id))
310 -> GenCoreExpr bndr Id
312 coreExprArity f (Lam _ expr) = coreExprArity f expr + 1
313 coreExprArity f (CoTyLam _ expr) = coreExprArity f expr
314 coreExprArity f (App expr arg) = max (coreExprArity f expr - 1) 0
315 coreExprArity f (CoTyApp expr _) = coreExprArity f expr
316 coreExprArity f (Var v) = max further info
321 Just expr -> coreExprArity f expr
322 info = case (arityMaybe (getIdArity v)) of
325 coreExprArity f _ = 0
328 @isWrapperFor@: we want to see exactly:
330 /\ ... \ args -> case <arg> of ... -> case <arg> of ... -> wrkr <stuff>
333 Probably a little too HACKY [WDP].
336 isWrapperFor :: CoreExpr -> Id -> Bool
338 expr `isWrapperFor` var
339 = case (collectBinders expr) of { (_, _, args, body) -> -- lambdas off the front
340 unravel_casing args body
341 --NO, THANKS: && not (null args)
344 var's_worker = getWorkerId (getIdStrictness var)
346 is_elem = isIn "isWrapperFor"
349 unravel_casing case_ables (Case scrut alts)
350 = case (collectArgs scrut) of { (fun, _, _, vargs) ->
354 scrut_var /= var && all (doesn't_mention var) vargs
355 && scrut_var `is_elem` case_ables
356 && unravel_alts case_ables alts
363 unravel_casing case_ables other_expr
364 = case (collectArgs other_expr) of { (fun, _, _, vargs) ->
368 -- DOESN'T WORK: wrkr == var's_worker
371 && all (doesn't_mention var) vargs
372 && all (only_from case_ables) vargs
380 unravel_alts case_ables (AlgAlts [(_,params,rhs)] NoDefault)
381 = unravel_casing (params ++ case_ables) rhs
382 unravel_alts case_ables other = False
384 -------------------------
385 doesn't_mention var (ValArg (VarArg v)) = v /= var
386 doesn't_mention var other = True
388 -------------------------
389 only_from case_ables (ValArg (VarArg v)) = v `is_elem` case_ables
390 only_from case_ables other = True
394 All the following functions operate on binders, perform a uniform
395 transformation on them; ie. the function @(\ x -> (x,False))@
396 annotates all binders with False.
399 unTagBinders :: GenCoreExpr (Id,tag) bdee tv uv -> GenCoreExpr Id bdee tv uv
400 unTagBinders expr = bop_expr fst expr
402 unTagBindersAlts :: GenCoreCaseAlts (Id,tag) bdee tv uv -> GenCoreCaseAlts Id bdee tv uv
403 unTagBindersAlts alts = bop_alts fst alts
407 bop_expr :: (a -> b) -> GenCoreExpr a bdee tv uv -> GenCoreExpr b bdee tv uv
409 bop_expr f (Var b) = Var b
410 bop_expr f (Lit lit) = Lit lit
411 bop_expr f (Con con args) = Con con args
412 bop_expr f (Prim op args) = Prim op args
413 bop_expr f (Lam binder expr) = Lam (bop_binder f binder) (bop_expr f expr)
414 bop_expr f (App expr arg) = App (bop_expr f expr) arg
415 bop_expr f (SCC label expr) = SCC label (bop_expr f expr)
416 bop_expr f (Let bind expr) = Let (bop_bind f bind) (bop_expr f expr)
417 bop_expr f (Case expr alts) = Case (bop_expr f expr) (bop_alts f alts)
419 bop_binder f (ValBinder v) = ValBinder (f v)
420 bop_binder f (TyBinder t) = TyBinder t
421 bop_binder f (UsageBinder u) = UsageBinder u
423 bop_bind f (NonRec b e) = NonRec (f b) (bop_expr f e)
424 bop_bind f (Rec pairs) = Rec [(f b, bop_expr f e) | (b, e) <- pairs]
426 bop_alts f (AlgAlts alts deflt)
427 = AlgAlts [ (con, [f b | b <- binders], bop_expr f e)
428 | (con, binders, e) <- alts ]
431 bop_alts f (PrimAlts alts deflt)
432 = PrimAlts [ (lit, bop_expr f e) | (lit, e) <- alts ]
435 bop_deflt f (NoDefault) = NoDefault
436 bop_deflt f (BindDefault b expr) = BindDefault (f b) (bop_expr f expr)
439 OLD (but left here because of the nice example): @singleAlt@ checks
440 whether a bunch of case alternatives is actually just one alternative.
441 It specifically {\em ignores} alternatives which consist of just a
442 call to @error@, because they won't result in any code duplication.
446 case (case <something> of
448 False -> error "Foo") of
454 True -> case <rhs> of
456 False -> case error "Foo" of
462 True -> case <rhs> of
466 Notice that the \tr{<alts>} don't get duplicated.
469 nonErrorRHSs :: GenCoreCaseAlts a Id TyVar UVar -> [GenCoreExpr a Id TyVar UVar]
472 = filter not_error_app (find_rhss alts)
474 find_rhss (AlgAlts as deflt) = [rhs | (_,_,rhs) <- as] ++ deflt_rhs deflt
475 find_rhss (PrimAlts as deflt) = [rhs | (_,rhs) <- as] ++ deflt_rhs deflt
477 deflt_rhs NoDefault = []
478 deflt_rhs (BindDefault _ rhs) = [rhs]
481 = case (maybeErrorApp rhs Nothing) of
486 maybeErrorApp checks whether an expression is of the form
492 Just (error ty' args)
494 where ty' is supplied as an argument to maybeErrorApp.
496 Here's where it is useful:
498 case (error ty "Foo" e1 e2) of <alts>
502 where ty' is the type of any of the alternatives. You might think
503 this never occurs, but see the comments on the definition of
506 Note: we *avoid* the case where ty' might end up as a primitive type:
507 this is very uncool (totally wrong).
509 NOTICE: in the example above we threw away e1 and e2, but not the
510 string "Foo". How did we know to do that?
512 Answer: for now anyway, we only handle the case of a function whose
515 bottomingFn :: forall a. t1 -> ... -> tn -> a
516 ^---------------------^ NB!
518 Furthermore, we only count a bottomingApp if the function is applied
519 to more than n args. If so, we transform:
521 bottomingFn ty e1 ... en en+1 ... em
523 bottomingFn ty' e1 ... en
525 That is, we discard en+1 .. em
529 :: GenCoreExpr a Id TyVar UVar -- Expr to look at
530 -> Maybe Type -- Just ty => a result type *already cloned*;
531 -- Nothing => don't know result ty; we
532 -- *pretend* that the result ty won't be
533 -- primitive -- somebody later must
535 -> Maybe (GenCoreExpr a Id TyVar UVar)
537 maybeErrorApp expr result_ty_maybe
538 = case (collectArgs expr) of
539 (Var fun, [{-no usage???-}], [ty], other_args)
541 && maybeToBool result_ty_maybe -- we *know* the result type
542 -- (otherwise: live a fairy-tale existence...)
543 && not (isPrimType result_ty) ->
545 case (splitSigmaTy (idType fun)) of
546 ([tyvar], [], tau_ty) ->
547 case (splitFunTy tau_ty) of { (arg_tys, res_ty) ->
549 n_args_to_keep = length arg_tys
550 args_to_keep = take n_args_to_keep other_args
552 if (res_ty `eqTy` mkTyVarTy tyvar)
553 && n_args_to_keep <= length other_args
555 -- Phew! We're in business
556 Just (mkGenApp (Var fun) (TyArg result_ty : args_to_keep))
561 other -> Nothing -- Function type wrong shape
564 Just result_ty = result_ty_maybe
568 squashableDictishCcExpr :: CostCentre -> GenCoreExpr a b c d -> Bool
570 squashableDictishCcExpr cc expr
571 = if not (isDictCC cc) then
572 False -- that was easy...
574 squashable expr -- note: quite like the "atomic_rhs" stuff in simplifier
576 squashable (Var _) = True
577 squashable (Con _ _) = True -- I think so... WDP 94/09
578 squashable (Prim _ _) = True -- ditto
580 | notValArg a = squashable f
581 squashable other = False
584 %************************************************************************
586 \subsection{Core-renaming utils}
588 %************************************************************************
591 substCoreBindings :: ValEnv
592 -> TypeEnv -- TyVar=>Type
594 -> UniqSM [CoreBinding]
596 substCoreExpr :: ValEnv
597 -> TypeEnv -- TyVar=>Type
601 substCoreBindings venv tenv binds
602 -- if the envs are empty, then avoid doing anything
603 = if (isNullIdEnv venv && isNullTyVarEnv tenv) then
606 do_CoreBindings venv tenv binds
608 substCoreExpr venv tenv expr
609 = if (isNullIdEnv venv && isNullTyVarEnv tenv) then
612 do_CoreExpr venv tenv expr
615 The equiv code for @Types@ is in @TyUtils@.
617 Because binders aren't necessarily unique: we don't do @plusEnvs@
618 (which check for duplicates); rather, we use the shadowing version,
619 @growIdEnv@ (and shorthand @addOneToIdEnv@).
621 @do_CoreBindings@ takes into account the semantics of a list of
622 @CoreBindings@---things defined early in the list are visible later in
623 the list, but not vice versa.
626 type ValEnv = IdEnv CoreExpr
628 do_CoreBindings :: ValEnv
631 -> UniqSM [CoreBinding]
633 do_CoreBinding :: ValEnv
636 -> UniqSM (CoreBinding, ValEnv)
638 do_CoreBindings venv tenv [] = returnUs []
639 do_CoreBindings venv tenv (b:bs)
640 = do_CoreBinding venv tenv b `thenUs` \ (new_b, new_venv) ->
641 do_CoreBindings new_venv tenv bs `thenUs` \ new_bs ->
642 returnUs (new_b : new_bs)
644 do_CoreBinding venv tenv (NonRec binder rhs)
645 = do_CoreExpr venv tenv rhs `thenUs` \ new_rhs ->
647 dup_binder tenv binder `thenUs` \ (new_binder, (old, new)) ->
648 -- now plug new bindings into envs
649 let new_venv = addOneToIdEnv venv old new in
651 returnUs (NonRec new_binder new_rhs, new_venv)
653 do_CoreBinding venv tenv (Rec binds)
654 = -- for letrec, we plug in new bindings BEFORE cloning rhss
655 mapAndUnzipUs (dup_binder tenv) binders `thenUs` \ (new_binders, new_maps) ->
656 let new_venv = growIdEnvList venv new_maps in
658 mapUs (do_CoreExpr new_venv tenv) rhss `thenUs` \ new_rhss ->
659 returnUs (Rec (new_binders `zipEqual` new_rhss), new_venv)
661 (binders, rhss) = unzip binds
668 -> UniqSM CoreArgOrExpr
670 do_CoreArg venv tenv a@(VarArg v)
672 case (lookupIdEnv venv v) of
674 Just expr -> AnExpr expr
677 do_CoreArg venv tenv (TyArg ty)
678 = returnUs (AnArg (TyArg (applyTypeEnvToTy tenv ty)))
680 do_CoreArg venv tenv other_arg = returnUs (AnArg other_arg)
684 do_CoreExpr :: ValEnv
689 do_CoreExpr venv tenv orig_expr@(Var var)
691 case (lookupIdEnv venv var) of
692 Nothing -> --false:ASSERT(toplevelishId var) (SIGH)
697 do_CoreExpr venv tenv e@(Lit _) = returnUs e
699 do_CoreExpr venv tenv (Con con as)
700 = mapUs (do_CoreArg venv tenv) as `thenUs` \ new_as ->
703 do_CoreExpr venv tenv (Prim op as)
704 = mapUs (do_CoreArg venv tenv) as `thenUs` \ new_as ->
705 do_PrimOp op `thenUs` \ new_op ->
706 mkCoPrim new_op new_as
708 do_PrimOp (CCallOp label is_asm may_gc arg_tys result_ty)
710 new_arg_tys = map (applyTypeEnvToTy tenv) arg_tys
711 new_result_ty = applyTypeEnvToTy tenv result_ty
713 returnUs (CCallOp label is_asm may_gc new_arg_tys new_result_ty)
715 do_PrimOp other_op = returnUs other_op
717 do_CoreExpr venv tenv (Lam binder expr)
718 = dup_binder tenv binder `thenUs` \(new_binder, (old,new)) ->
719 let new_venv = addOneToIdEnv venv old new in
720 do_CoreExpr new_venv tenv expr `thenUs` \ new_expr ->
721 returnUs (Lam new_binder new_expr)
723 do_CoreExpr venv tenv (App expr arg)
724 = do_CoreExpr venv tenv expr `thenUs` \ new_expr ->
725 do_CoreArg venv tenv arg `thenUs` \ new_arg ->
726 mkCoApps new_expr [new_arg] -- ToDo: more efficiently?
728 do_CoreExpr venv tenv (Case expr alts)
729 = do_CoreExpr venv tenv expr `thenUs` \ new_expr ->
730 do_alts venv tenv alts `thenUs` \ new_alts ->
731 returnUs (Case new_expr new_alts)
733 do_alts venv tenv (AlgAlts alts deflt)
734 = mapUs (do_boxed_alt venv tenv) alts `thenUs` \ new_alts ->
735 do_default venv tenv deflt `thenUs` \ new_deflt ->
736 returnUs (AlgAlts new_alts new_deflt)
738 do_boxed_alt venv tenv (con, binders, expr)
739 = mapAndUnzipUs (dup_binder tenv) binders `thenUs` \ (new_binders, new_vmaps) ->
740 let new_venv = growIdEnvList venv new_vmaps in
741 do_CoreExpr new_venv tenv expr `thenUs` \ new_expr ->
742 returnUs (con, new_binders, new_expr)
745 do_alts venv tenv (PrimAlts alts deflt)
746 = mapUs (do_unboxed_alt venv tenv) alts `thenUs` \ new_alts ->
747 do_default venv tenv deflt `thenUs` \ new_deflt ->
748 returnUs (PrimAlts new_alts new_deflt)
750 do_unboxed_alt venv tenv (lit, expr)
751 = do_CoreExpr venv tenv expr `thenUs` \ new_expr ->
752 returnUs (lit, new_expr)
754 do_default venv tenv NoDefault = returnUs NoDefault
756 do_default venv tenv (BindDefault binder expr)
757 = dup_binder tenv binder `thenUs` \ (new_binder, (old, new)) ->
758 let new_venv = addOneToIdEnv venv old new in
759 do_CoreExpr new_venv tenv expr `thenUs` \ new_expr ->
760 returnUs (BindDefault new_binder new_expr)
762 do_CoreExpr venv tenv (Let core_bind expr)
763 = do_CoreBinding venv tenv core_bind `thenUs` \ (new_bind, new_venv) ->
764 -- and do the body of the let
765 do_CoreExpr new_venv tenv expr `thenUs` \ new_expr ->
766 returnUs (Let new_bind new_expr)
768 do_CoreExpr venv tenv (SCC label expr)
769 = do_CoreExpr venv tenv expr `thenUs` \ new_expr ->
770 returnUs (SCC label new_expr)