2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
6 CoreSyn: A data type for the Haskell compiler midsection
10 Expr(..), Alt, Bind(..), AltCon(..), Arg, Note(..),
11 CoreExpr, CoreAlt, CoreBind, CoreArg, CoreBndr,
12 TaggedExpr, TaggedAlt, TaggedBind, TaggedArg, TaggedBndr(..),
15 mkApps, mkTyApps, mkValApps, mkVarApps,
16 mkLit, mkIntLitInt, mkIntLit,
18 varToCoreExpr, varsToCoreExprs,
20 isTyVar, isId, cmpAltCon, cmpAlt, ltAlt,
21 bindersOf, bindersOfBinds, rhssOfBind, rhssOfAlts,
22 collectBinders, collectTyBinders, collectValBinders, collectTyAndValBinders,
27 isValArg, isTypeArg, valArgCount, valBndrCount, isRuntimeArg, isRuntimeVar,
30 Unfolding(..), UnfoldingGuidance(..), -- Both abstract everywhere but in CoreUnfold.lhs
31 noUnfolding, evaldUnfolding, mkOtherCon,
32 unfoldingTemplate, maybeUnfoldingTemplate, otherCons,
33 isValueUnfolding, isEvaldUnfolding, isCheapUnfolding, isCompulsoryUnfolding,
34 hasUnfolding, hasSomeUnfolding, neverUnfold,
37 seqExpr, seqExprs, seqUnfolding,
39 -- Annotated expressions
40 AnnExpr, AnnExpr'(..), AnnBind(..), AnnAlt,
41 deAnnotate, deAnnotate', deAnnAlt, collectAnnBndrs,
44 CoreRule(..), -- CoreSubst, CoreTidy, CoreFVs, PprCore only
45 RuleName, seqRules, ruleArity,
46 isBuiltinRule, ruleName, isLocalRule, ruleIdName
49 #include "HsVersions.h"
64 infixl 4 `mkApps`, `mkValApps`, `mkTyApps`, `mkVarApps`
65 -- Left associative, so that we can say (f `mkTyApps` xs `mkVarApps` ys)
68 %************************************************************************
70 \subsection{The main data types}
72 %************************************************************************
74 These data types are the heart of the compiler
77 infixl 8 `App` -- App brackets to the left
79 data Expr b -- "b" for the type of binders,
82 | App (Expr b) (Arg b) -- See Note [CoreSyn let/app invariant]
84 | Let (Bind b) (Expr b) -- See [CoreSyn let/app invariant],
85 -- and [CoreSyn letrec invariant]
86 | Case (Expr b) b Type [Alt b] -- Binder gets bound to value of scrutinee
87 -- See Note [CoreSyn case invariants]
88 | Cast (Expr b) Coercion
90 | Type Type -- This should only show up at the top
93 type Arg b = Expr b -- Can be a Type
95 type Alt b = (AltCon, [b], Expr b) -- (DEFAULT, [], rhs) is the default alternative
97 data AltCon = DataAlt DataCon -- Invariant: the DataCon is always from
98 -- a *data* type, and never from a *newtype*
104 data Bind b = NonRec b (Expr b)
105 | Rec [(b, (Expr b))]
108 -------------------------- CoreSyn INVARIANTS ---------------------------
110 Note [CoreSyn top-level invariant]
111 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
112 * The RHSs of all top-level lets must be of LIFTED type.
114 Note [CoreSyn letrec invariant]
115 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
116 * The RHS of a letrec must be of LIFTED type.
118 Note [CoreSyn let/app invariant]
119 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
120 * The RHS of a non-recursive let, *and* the argument of an App,
121 may be of UNLIFTED type, but only if the expression
122 is ok-for-speculation. This means that the let can be floated around
123 without difficulty. e.g.
125 y::Int# = fac 4# not ok [use case instead]
126 This is intially enforced by DsUtils.mkDsLet and mkDsApp
128 Note [CoreSyn case invariants]
129 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
130 Invariant: The DEFAULT case must be *first*, if it occurs at all
132 Invariant: The remaining cases are in order of increasing
135 This makes finding the relevant constructor easy,
136 and makes comparison easier too
138 Invariant: The list of alternatives is ALWAYS EXHAUSTIVE,
139 meaning that it covers all cases that can occur
141 An "exhaustive" case does not necessarily mention all constructors:
142 data Foo = Red | Green | Blue
146 other -> f (case x of
149 The inner case does not need a Red alternative, because x can't be Red at
153 Note [CoreSyn let goal]
154 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
155 * The simplifier tries to ensure that if the RHS of a let is a constructor
156 application, its arguments are trivial, so that the constructor can be
164 | InlineMe -- Instructs simplifer to treat the enclosed expression
165 -- as very small, and inline it at its call sites
167 | CoreNote String -- A generic core annotation, propagated but not used by GHC
169 -- NOTE: we also treat expressions wrapped in InlineMe as
170 -- 'cheap' and 'dupable' (in the sense of exprIsCheap, exprIsDupable)
171 -- What this means is that we obediently inline even things that don't
172 -- look like valuse. This is sometimes important:
175 -- Here, f looks like a redex, and we aren't going to inline (.) because it's
176 -- inside an INLINE, so it'll stay looking like a redex. Nevertheless, we
177 -- should inline f even inside lambdas. In effect, we should trust the programmer.
181 %************************************************************************
183 \subsection{Transformation rules}
185 %************************************************************************
187 The CoreRule type and its friends are dealt with mainly in CoreRules,
188 but CoreFVs, Subst, PprCore, CoreTidy also inspect the representation.
192 "local" if the function it is a rule for is defined in the
193 same module as the rule itself.
195 "orphan" if nothing on the LHS is defined in the same module
199 type RuleName = FastString
204 ru_act :: Activation, -- When the rule is active
206 -- Rough-matching stuff
207 -- see comments with InstEnv.Instance( is_cls, is_rough )
208 ru_fn :: Name, -- Name of the Id at the head of this rule
209 ru_rough :: [Maybe Name], -- Name at the head of each argument
211 -- Proper-matching stuff
212 -- see comments with InstEnv.Instance( is_tvs, is_tys )
213 ru_bndrs :: [CoreBndr], -- Forall'd variables
214 ru_args :: [CoreExpr], -- LHS args
216 -- And the right-hand side
220 ru_local :: Bool -- The fn at the head of the rule is
221 -- defined in the same module as the rule
222 -- and is not an implicit Id (like a record sel
223 -- class op, or data con)
224 -- NB: ru_local is *not* used to decide orphan-hood
225 -- c.g. MkIface.coreRuleToIfaceRule
228 | BuiltinRule { -- Built-in rules are used for constant folding
229 ru_name :: RuleName, -- and suchlike. It has no free variables.
230 ru_fn :: Name, -- Name of the Id at
231 -- the head of this rule
232 ru_nargs :: Int, -- Number of args that ru_try expects,
233 -- including type args
234 ru_try :: [CoreExpr] -> Maybe CoreExpr }
235 -- This function does the rewrite. It given too many
236 -- arguments, it simply discards them; the returned CoreExpr
237 -- is just the rewrite of ru_fn applied to the first ru_nargs args
238 -- See Note [Extra args in rule matching] in Rules.lhs
240 isBuiltinRule :: CoreRule -> Bool
241 isBuiltinRule (BuiltinRule {}) = True
242 isBuiltinRule _ = False
244 ruleArity :: CoreRule -> Int
245 ruleArity (BuiltinRule {ru_nargs = n}) = n
246 ruleArity (Rule {ru_args = args}) = length args
248 ruleName :: CoreRule -> RuleName
251 ruleIdName :: CoreRule -> Name
254 isLocalRule :: CoreRule -> Bool
255 isLocalRule = ru_local
259 %************************************************************************
263 %************************************************************************
265 The @Unfolding@ type is declared here to avoid numerous loops, but it
266 should be abstract everywhere except in CoreUnfold.lhs
272 | OtherCon [AltCon] -- It ain't one of these
273 -- (OtherCon xs) also indicates that something has been evaluated
274 -- and hence there's no point in re-evaluating it.
275 -- OtherCon [] is used even for non-data-type values
276 -- to indicated evaluated-ness. Notably:
277 -- data C = C !(Int -> Int)
278 -- case x of { C f -> ... }
279 -- Here, f gets an OtherCon [] unfolding.
281 | CompulsoryUnfolding CoreExpr -- There is no "original" definition,
282 -- so you'd better unfold.
284 | CoreUnfolding -- An unfolding with redundant cached information
285 CoreExpr -- Template; binder-info is correct
286 Bool -- True <=> top level binding
287 Bool -- exprIsHNF template (cached); it is ok to discard a `seq` on
289 Bool -- True <=> doesn't waste (much) work to expand inside an inlining
290 -- Basically it's exprIsCheap
291 UnfoldingGuidance -- Tells about the *size* of the template.
294 data UnfoldingGuidance
296 | UnfoldIfGoodArgs Int -- and "n" value args
298 [Int] -- Discount if the argument is evaluated.
299 -- (i.e., a simplification will definitely
300 -- be possible). One elt of the list per *value* arg.
302 Int -- The "size" of the unfolding; to be elaborated
305 Int -- Scrutinee discount: the discount to substract if the thing is in
306 -- a context (case (thing args) of ...),
307 -- (where there are the right number of arguments.)
309 noUnfolding, evaldUnfolding :: Unfolding
310 noUnfolding = NoUnfolding
311 evaldUnfolding = OtherCon []
313 mkOtherCon :: [AltCon] -> Unfolding
314 mkOtherCon = OtherCon
316 seqUnfolding :: Unfolding -> ()
317 seqUnfolding (CoreUnfolding e top b1 b2 g)
318 = seqExpr e `seq` top `seq` b1 `seq` b2 `seq` seqGuidance g
321 seqGuidance :: UnfoldingGuidance -> ()
322 seqGuidance (UnfoldIfGoodArgs n ns a b) = n `seq` sum ns `seq` a `seq` b `seq` ()
327 unfoldingTemplate :: Unfolding -> CoreExpr
328 unfoldingTemplate (CoreUnfolding expr _ _ _ _) = expr
329 unfoldingTemplate (CompulsoryUnfolding expr) = expr
330 unfoldingTemplate _ = panic "getUnfoldingTemplate"
332 maybeUnfoldingTemplate :: Unfolding -> Maybe CoreExpr
333 maybeUnfoldingTemplate (CoreUnfolding expr _ _ _ _) = Just expr
334 maybeUnfoldingTemplate (CompulsoryUnfolding expr) = Just expr
335 maybeUnfoldingTemplate _ = Nothing
337 otherCons :: Unfolding -> [AltCon]
338 otherCons (OtherCon cons) = cons
341 isValueUnfolding :: Unfolding -> Bool
342 -- Returns False for OtherCon
343 isValueUnfolding (CoreUnfolding _ _ is_evald _ _) = is_evald
344 isValueUnfolding _ = False
346 isEvaldUnfolding :: Unfolding -> Bool
347 -- Returns True for OtherCon
348 isEvaldUnfolding (OtherCon _) = True
349 isEvaldUnfolding (CoreUnfolding _ _ is_evald _ _) = is_evald
350 isEvaldUnfolding _ = False
352 isCheapUnfolding :: Unfolding -> Bool
353 isCheapUnfolding (CoreUnfolding _ _ _ is_cheap _) = is_cheap
354 isCheapUnfolding _ = False
356 isCompulsoryUnfolding :: Unfolding -> Bool
357 isCompulsoryUnfolding (CompulsoryUnfolding _) = True
358 isCompulsoryUnfolding _ = False
360 hasUnfolding :: Unfolding -> Bool
361 hasUnfolding (CoreUnfolding _ _ _ _ _) = True
362 hasUnfolding (CompulsoryUnfolding _) = True
363 hasUnfolding _ = False
365 hasSomeUnfolding :: Unfolding -> Bool
366 hasSomeUnfolding NoUnfolding = False
367 hasSomeUnfolding _ = True
369 neverUnfold :: Unfolding -> Bool
370 neverUnfold NoUnfolding = True
371 neverUnfold (OtherCon _) = True
372 neverUnfold (CoreUnfolding _ _ _ _ UnfoldNever) = True
373 neverUnfold _ = False
377 %************************************************************************
379 \subsection{The main data type}
381 %************************************************************************
384 -- The Ord is needed for the FiniteMap used in the lookForConstructor
385 -- in SimplEnv. If you declared that lookForConstructor *ignores*
386 -- constructor-applications with LitArg args, then you could get
389 instance Outputable AltCon where
390 ppr (DataAlt dc) = ppr dc
391 ppr (LitAlt lit) = ppr lit
392 ppr DEFAULT = ptext SLIT("__DEFAULT")
394 instance Show AltCon where
395 showsPrec p con = showsPrecSDoc p (ppr con)
397 cmpAlt :: Alt b -> Alt b -> Ordering
398 cmpAlt (con1, _, _) (con2, _, _) = con1 `cmpAltCon` con2
400 ltAlt :: Alt b -> Alt b -> Bool
401 ltAlt a1 a2 = (a1 `cmpAlt` a2) == LT
403 cmpAltCon :: AltCon -> AltCon -> Ordering
404 -- Compares AltCons within a single list of alternatives
405 cmpAltCon DEFAULT DEFAULT = EQ
406 cmpAltCon DEFAULT _ = LT
408 cmpAltCon (DataAlt d1) (DataAlt d2) = dataConTag d1 `compare` dataConTag d2
409 cmpAltCon (DataAlt _) DEFAULT = GT
410 cmpAltCon (LitAlt l1) (LitAlt l2) = l1 `compare` l2
411 cmpAltCon (LitAlt _) DEFAULT = GT
413 cmpAltCon con1 con2 = WARN( True, text "Comparing incomparable AltCons" <+>
414 ppr con1 <+> ppr con2 )
419 %************************************************************************
421 \subsection{Useful synonyms}
423 %************************************************************************
429 type CoreExpr = Expr CoreBndr
430 type CoreArg = Arg CoreBndr
431 type CoreBind = Bind CoreBndr
432 type CoreAlt = Alt CoreBndr
435 Binders are ``tagged'' with a \tr{t}:
438 data TaggedBndr t = TB CoreBndr t -- TB for "tagged binder"
440 type TaggedBind t = Bind (TaggedBndr t)
441 type TaggedExpr t = Expr (TaggedBndr t)
442 type TaggedArg t = Arg (TaggedBndr t)
443 type TaggedAlt t = Alt (TaggedBndr t)
445 instance Outputable b => Outputable (TaggedBndr b) where
446 ppr (TB b l) = char '<' <> ppr b <> comma <> ppr l <> char '>'
448 instance Outputable b => OutputableBndr (TaggedBndr b) where
449 pprBndr _ b = ppr b -- Simple
453 %************************************************************************
455 \subsection{Core-constructing functions with checking}
457 %************************************************************************
460 mkApps :: Expr b -> [Arg b] -> Expr b
461 mkTyApps :: Expr b -> [Type] -> Expr b
462 mkValApps :: Expr b -> [Expr b] -> Expr b
463 mkVarApps :: Expr b -> [Var] -> Expr b
465 mkApps f args = foldl App f args
466 mkTyApps f args = foldl (\ e a -> App e (Type a)) f args
467 mkValApps f args = foldl (\ e a -> App e a) f args
468 mkVarApps f vars = foldl (\ e a -> App e (varToCoreExpr a)) f vars
470 mkLit :: Literal -> Expr b
471 mkIntLit :: Integer -> Expr b
472 mkIntLitInt :: Int -> Expr b
473 mkConApp :: DataCon -> [Arg b] -> Expr b
474 mkLets :: [Bind b] -> Expr b -> Expr b
475 mkLams :: [b] -> Expr b -> Expr b
478 mkConApp con args = mkApps (Var (dataConWorkId con)) args
480 mkLams binders body = foldr Lam body binders
481 mkLets binds body = foldr Let body binds
483 mkIntLit n = Lit (mkMachInt n)
484 mkIntLitInt n = Lit (mkMachInt (toInteger n))
486 varToCoreExpr :: CoreBndr -> Expr b
487 varToCoreExpr v | isId v = Var v
488 | otherwise = Type (mkTyVarTy v)
490 varsToCoreExprs :: [CoreBndr] -> [Expr b]
491 varsToCoreExprs vs = map varToCoreExpr vs
493 mkCast :: Expr b -> Coercion -> Expr b
494 mkCast e co = Cast e co
498 %************************************************************************
500 \subsection{Simple access functions}
502 %************************************************************************
505 bindersOf :: Bind b -> [b]
506 bindersOf (NonRec binder _) = [binder]
507 bindersOf (Rec pairs) = [binder | (binder, _) <- pairs]
509 bindersOfBinds :: [Bind b] -> [b]
510 bindersOfBinds binds = foldr ((++) . bindersOf) [] binds
512 rhssOfBind :: Bind b -> [Expr b]
513 rhssOfBind (NonRec _ rhs) = [rhs]
514 rhssOfBind (Rec pairs) = [rhs | (_,rhs) <- pairs]
516 rhssOfAlts :: [Alt b] -> [Expr b]
517 rhssOfAlts alts = [e | (_,_,e) <- alts]
519 flattenBinds :: [Bind b] -> [(b, Expr b)] -- Get all the lhs/rhs pairs
520 flattenBinds (NonRec b r : binds) = (b,r) : flattenBinds binds
521 flattenBinds (Rec prs1 : binds) = prs1 ++ flattenBinds binds
525 We often want to strip off leading lambdas before getting down to
526 business. @collectBinders@ is your friend.
528 We expect (by convention) type-, and value- lambdas in that
532 collectBinders :: Expr b -> ([b], Expr b)
533 collectTyBinders :: CoreExpr -> ([TyVar], CoreExpr)
534 collectValBinders :: CoreExpr -> ([Id], CoreExpr)
535 collectTyAndValBinders :: CoreExpr -> ([TyVar], [Id], CoreExpr)
540 go bs (Lam b e) = go (b:bs) e
541 go bs e = (reverse bs, e)
543 collectTyAndValBinders expr
546 (tvs, body1) = collectTyBinders expr
547 (ids, body) = collectValBinders body1
549 collectTyBinders expr
552 go tvs (Lam b e) | isTyVar b = go (b:tvs) e
553 go tvs e = (reverse tvs, e)
555 collectValBinders expr
558 go ids (Lam b e) | isId b = go (b:ids) e
559 go ids body = (reverse ids, body)
563 @collectArgs@ takes an application expression, returning the function
564 and the arguments to which it is applied.
567 collectArgs :: Expr b -> (Expr b, [Arg b])
571 go (App f a) as = go f (a:as)
575 coreExprCc gets the cost centre enclosing an expression, if any.
576 It looks inside lambdas because (scc "foo" \x.e) = \x.scc "foo" e
579 coreExprCc :: Expr b -> CostCentre
580 coreExprCc (Note (SCC cc) _) = cc
581 coreExprCc (Note _ e) = coreExprCc e
582 coreExprCc (Lam _ e) = coreExprCc e
583 coreExprCc _ = noCostCentre
588 %************************************************************************
590 \subsection{Predicates}
592 %************************************************************************
594 @isRuntimeVar v@ returns if (Lam v _) really becomes a lambda at runtime,
595 i.e. if type applications are actual lambdas because types are kept around
598 Similarly isRuntimeArg.
601 isRuntimeVar :: Var -> Bool
602 isRuntimeVar | opt_RuntimeTypes = \_ -> True
603 | otherwise = \v -> isId v
605 isRuntimeArg :: CoreExpr -> Bool
606 isRuntimeArg | opt_RuntimeTypes = \_ -> True
607 | otherwise = \e -> isValArg e
611 isValArg :: Expr b -> Bool
612 isValArg (Type _) = False
615 isTypeArg :: Expr b -> Bool
616 isTypeArg (Type _) = True
619 valBndrCount :: [CoreBndr] -> Int
620 valBndrCount = count isId
622 valArgCount :: [Arg b] -> Int
623 valArgCount = count isValArg
627 %************************************************************************
629 \subsection{Seq stuff}
631 %************************************************************************
634 seqExpr :: CoreExpr -> ()
635 seqExpr (Var v) = v `seq` ()
636 seqExpr (Lit lit) = lit `seq` ()
637 seqExpr (App f a) = seqExpr f `seq` seqExpr a
638 seqExpr (Lam b e) = seqBndr b `seq` seqExpr e
639 seqExpr (Let b e) = seqBind b `seq` seqExpr e
640 seqExpr (Case e b t as) = seqExpr e `seq` seqBndr b `seq` seqType t `seq` seqAlts as
641 seqExpr (Cast e co) = seqExpr e `seq` seqType co
642 seqExpr (Note n e) = seqNote n `seq` seqExpr e
643 seqExpr (Type t) = seqType t
645 seqExprs :: [CoreExpr] -> ()
647 seqExprs (e:es) = seqExpr e `seq` seqExprs es
649 seqNote :: Note -> ()
650 seqNote (CoreNote s) = s `seq` ()
653 seqBndr :: CoreBndr -> ()
654 seqBndr b = b `seq` ()
656 seqBndrs :: [CoreBndr] -> ()
658 seqBndrs (b:bs) = seqBndr b `seq` seqBndrs bs
660 seqBind :: Bind CoreBndr -> ()
661 seqBind (NonRec b e) = seqBndr b `seq` seqExpr e
662 seqBind (Rec prs) = seqPairs prs
664 seqPairs :: [(CoreBndr, CoreExpr)] -> ()
666 seqPairs ((b,e):prs) = seqBndr b `seq` seqExpr e `seq` seqPairs prs
668 seqAlts :: [CoreAlt] -> ()
670 seqAlts ((c,bs,e):alts) = c `seq` seqBndrs bs `seq` seqExpr e `seq` seqAlts alts
672 seqRules :: [CoreRule] -> ()
674 seqRules (Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs } : rules)
675 = seqBndrs bndrs `seq` seqExprs (rhs:args) `seq` seqRules rules
676 seqRules (BuiltinRule {} : rules) = seqRules rules
681 %************************************************************************
683 \subsection{Annotated core; annotation at every node in the tree}
685 %************************************************************************
688 type AnnExpr bndr annot = (annot, AnnExpr' bndr annot)
690 data AnnExpr' bndr annot
693 | AnnLam bndr (AnnExpr bndr annot)
694 | AnnApp (AnnExpr bndr annot) (AnnExpr bndr annot)
695 | AnnCase (AnnExpr bndr annot) bndr Type [AnnAlt bndr annot]
696 | AnnLet (AnnBind bndr annot) (AnnExpr bndr annot)
697 | AnnCast (AnnExpr bndr annot) Coercion
698 | AnnNote Note (AnnExpr bndr annot)
701 type AnnAlt bndr annot = (AltCon, [bndr], AnnExpr bndr annot)
703 data AnnBind bndr annot
704 = AnnNonRec bndr (AnnExpr bndr annot)
705 | AnnRec [(bndr, AnnExpr bndr annot)]
709 deAnnotate :: AnnExpr bndr annot -> Expr bndr
710 deAnnotate (_, e) = deAnnotate' e
712 deAnnotate' :: AnnExpr' bndr annot -> Expr bndr
713 deAnnotate' (AnnType t) = Type t
714 deAnnotate' (AnnVar v) = Var v
715 deAnnotate' (AnnLit lit) = Lit lit
716 deAnnotate' (AnnLam binder body) = Lam binder (deAnnotate body)
717 deAnnotate' (AnnApp fun arg) = App (deAnnotate fun) (deAnnotate arg)
718 deAnnotate' (AnnCast e co) = Cast (deAnnotate e) co
719 deAnnotate' (AnnNote note body) = Note note (deAnnotate body)
721 deAnnotate' (AnnLet bind body)
722 = Let (deAnnBind bind) (deAnnotate body)
724 deAnnBind (AnnNonRec var rhs) = NonRec var (deAnnotate rhs)
725 deAnnBind (AnnRec pairs) = Rec [(v,deAnnotate rhs) | (v,rhs) <- pairs]
727 deAnnotate' (AnnCase scrut v t alts)
728 = Case (deAnnotate scrut) v t (map deAnnAlt alts)
730 deAnnAlt :: AnnAlt bndr annot -> Alt bndr
731 deAnnAlt (con,args,rhs) = (con,args,deAnnotate rhs)
735 collectAnnBndrs :: AnnExpr bndr annot -> ([bndr], AnnExpr bndr annot)
739 collect bs (_, AnnLam b body) = collect (b:bs) body
740 collect bs body = (reverse bs, body)