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,
23 collectArgs, coreExprCc,
24 mkTyBind, flattenBinds,
26 isValArg, isTypeArg, valArgCount, valBndrCount, isRuntimeArg, isRuntimeVar,
29 Unfolding(..), UnfoldingGuidance(..), -- Both abstract everywhere but in CoreUnfold.lhs
30 noUnfolding, evaldUnfolding, mkOtherCon,
31 unfoldingTemplate, maybeUnfoldingTemplate, otherCons,
32 isValueUnfolding, isEvaldUnfolding, isCheapUnfolding, isCompulsoryUnfolding,
33 hasUnfolding, hasSomeUnfolding, neverUnfold,
36 seqExpr, seqExprs, seqUnfolding,
38 -- Annotated expressions
39 AnnExpr, AnnExpr'(..), AnnBind(..), AnnAlt,
40 deAnnotate, deAnnotate', deAnnAlt, collectAnnBndrs,
43 CoreRule(..), -- CoreSubst, CoreTidy, CoreFVs, PprCore only
44 RuleName, seqRules, ruleArity,
45 isBuiltinRule, ruleName, isLocalRule, ruleIdName, setRuleIdName
48 #include "HsVersions.h"
63 infixl 4 `mkApps`, `mkValApps`, `mkTyApps`, `mkVarApps`
64 -- Left associative, so that we can say (f `mkTyApps` xs `mkVarApps` ys)
67 %************************************************************************
69 \subsection{The main data types}
71 %************************************************************************
73 These data types are the heart of the compiler
76 infixl 8 `App` -- App brackets to the left
78 data Expr b -- "b" for the type of binders,
81 | App (Expr b) (Arg b) -- See Note [CoreSyn let/app invariant]
83 | Let (Bind b) (Expr b) -- See [CoreSyn let/app invariant],
84 -- and [CoreSyn letrec invariant]
85 | Case (Expr b) b Type [Alt b] -- Binder gets bound to value of scrutinee
86 -- See Note [CoreSyn case invariants]
87 | Cast (Expr b) Coercion
89 | Type Type -- This should only show up at the top
92 type Arg b = Expr b -- Can be a Type
94 type Alt b = (AltCon, [b], Expr b) -- (DEFAULT, [], rhs) is the default alternative
96 data AltCon = DataAlt DataCon -- Invariant: the DataCon is always from
97 -- a *data* type, and never from a *newtype*
103 data Bind b = NonRec b (Expr b)
104 | Rec [(b, (Expr b))]
107 -------------------------- CoreSyn INVARIANTS ---------------------------
109 Note [CoreSyn top-level invariant]
110 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
111 * The RHSs of all top-level lets must be of LIFTED type.
113 Note [CoreSyn letrec invariant]
114 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
115 * The RHS of a letrec must be of LIFTED type.
117 Note [CoreSyn let/app invariant]
118 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
119 * The RHS of a non-recursive let, *and* the argument of an App,
120 may be of UNLIFTED type, but only if the expression
121 is ok-for-speculation. This means that the let can be floated around
122 without difficulty. e.g.
124 y::Int# = fac 4# not ok [use case instead]
125 This is intially enforced by DsUtils.mkDsLet and mkDsApp
127 Note [CoreSyn case invariants]
128 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
129 Invariant: The DEFAULT case must be *first*, if it occurs at all
131 Invariant: The remaining cases are in order of increasing
134 This makes finding the relevant constructor easy,
135 and makes comparison easier too
137 Invariant: The list of alternatives is ALWAYS EXHAUSTIVE,
138 meaning that it covers all cases that can occur
140 An "exhaustive" case does not necessarily mention all constructors:
141 data Foo = Red | Green | Blue
145 other -> f (case x of
148 The inner case does not need a Red alternative, because x can't be Red at
152 Note [CoreSyn let goal]
153 ~~~~~~~~~~~~~~~~~~~~~~~
154 * The simplifier tries to ensure that if the RHS of a let is a constructor
155 application, its arguments are trivial, so that the constructor can be
161 We allow a *non-recursive* let to bind a type variable, thus
162 Let (NonRec tv (Type ty)) body
163 This can be very convenient for postponing type substitutions until
164 the next run of the simplifier.
166 At the moment, the rest of the compiler only deals with type-let
167 in a Let expression, rather than at top level. We may want to revist
174 | InlineMe -- Instructs simplifer to treat the enclosed expression
175 -- as very small, and inline it at its call sites
177 | CoreNote String -- A generic core annotation, propagated but not used by GHC
179 -- NOTE: we also treat expressions wrapped in InlineMe as
180 -- 'cheap' and 'dupable' (in the sense of exprIsCheap, exprIsDupable)
181 -- What this means is that we obediently inline even things that don't
182 -- look like valuse. This is sometimes important:
185 -- Here, f looks like a redex, and we aren't going to inline (.) because it's
186 -- inside an INLINE, so it'll stay looking like a redex. Nevertheless, we
187 -- should inline f even inside lambdas. In effect, we should trust the programmer.
191 %************************************************************************
193 \subsection{Transformation rules}
195 %************************************************************************
197 The CoreRule type and its friends are dealt with mainly in CoreRules,
198 but CoreFVs, Subst, PprCore, CoreTidy also inspect the representation.
202 "local" if the function it is a rule for is defined in the
203 same module as the rule itself.
205 "orphan" if nothing on the LHS is defined in the same module
212 ru_act :: Activation, -- When the rule is active
214 -- Rough-matching stuff
215 -- see comments with InstEnv.Instance( is_cls, is_rough )
216 ru_fn :: Name, -- Name of the Id at the head of this rule
217 ru_rough :: [Maybe Name], -- Name at the head of each argument
219 -- Proper-matching stuff
220 -- see comments with InstEnv.Instance( is_tvs, is_tys )
221 ru_bndrs :: [CoreBndr], -- Forall'd variables
222 ru_args :: [CoreExpr], -- LHS args
224 -- And the right-hand side
228 ru_local :: Bool -- The fn at the head of the rule is
229 -- defined in the same module as the rule
230 -- and is not an implicit Id (like a record sel
231 -- class op, or data con)
232 -- NB: ru_local is *not* used to decide orphan-hood
233 -- c.g. MkIface.coreRuleToIfaceRule
236 | BuiltinRule { -- Built-in rules are used for constant folding
237 ru_name :: RuleName, -- and suchlike. It has no free variables.
238 ru_fn :: Name, -- Name of the Id at
239 -- the head of this rule
240 ru_nargs :: Int, -- Number of args that ru_try expects,
241 -- including type args
242 ru_try :: [CoreExpr] -> Maybe CoreExpr }
243 -- This function does the rewrite. It given too many
244 -- arguments, it simply discards them; the returned CoreExpr
245 -- is just the rewrite of ru_fn applied to the first ru_nargs args
246 -- See Note [Extra args in rule matching] in Rules.lhs
248 isBuiltinRule :: CoreRule -> Bool
249 isBuiltinRule (BuiltinRule {}) = True
250 isBuiltinRule _ = False
252 ruleArity :: CoreRule -> Int
253 ruleArity (BuiltinRule {ru_nargs = n}) = n
254 ruleArity (Rule {ru_args = args}) = length args
256 ruleName :: CoreRule -> RuleName
259 ruleIdName :: CoreRule -> Name
262 isLocalRule :: CoreRule -> Bool
263 isLocalRule = ru_local
265 setRuleIdName :: Name -> CoreRule -> CoreRule
266 setRuleIdName nm ru = ru { ru_fn = nm }
270 %************************************************************************
274 %************************************************************************
276 The @Unfolding@ type is declared here to avoid numerous loops, but it
277 should be abstract everywhere except in CoreUnfold.lhs
283 | OtherCon [AltCon] -- It ain't one of these
284 -- (OtherCon xs) also indicates that something has been evaluated
285 -- and hence there's no point in re-evaluating it.
286 -- OtherCon [] is used even for non-data-type values
287 -- to indicated evaluated-ness. Notably:
288 -- data C = C !(Int -> Int)
289 -- case x of { C f -> ... }
290 -- Here, f gets an OtherCon [] unfolding.
292 | CompulsoryUnfolding CoreExpr -- There is no "original" definition,
293 -- so you'd better unfold.
295 | CoreUnfolding -- An unfolding with redundant cached information
296 CoreExpr -- Template; binder-info is correct
297 Bool -- True <=> top level binding
298 Bool -- exprIsHNF template (cached); it is ok to discard a `seq` on
300 Bool -- True <=> doesn't waste (much) work to expand inside an inlining
301 -- Basically it's exprIsCheap
302 UnfoldingGuidance -- Tells about the *size* of the template.
305 data UnfoldingGuidance
307 | UnfoldIfGoodArgs Int -- and "n" value args
309 [Int] -- Discount if the argument is evaluated.
310 -- (i.e., a simplification will definitely
311 -- be possible). One elt of the list per *value* arg.
313 Int -- The "size" of the unfolding; to be elaborated
316 Int -- Scrutinee discount: the discount to substract if the thing is in
317 -- a context (case (thing args) of ...),
318 -- (where there are the right number of arguments.)
320 noUnfolding, evaldUnfolding :: Unfolding
321 noUnfolding = NoUnfolding
322 evaldUnfolding = OtherCon []
324 mkOtherCon :: [AltCon] -> Unfolding
325 mkOtherCon = OtherCon
327 seqUnfolding :: Unfolding -> ()
328 seqUnfolding (CoreUnfolding e top b1 b2 g)
329 = seqExpr e `seq` top `seq` b1 `seq` b2 `seq` seqGuidance g
332 seqGuidance :: UnfoldingGuidance -> ()
333 seqGuidance (UnfoldIfGoodArgs n ns a b) = n `seq` sum ns `seq` a `seq` b `seq` ()
338 unfoldingTemplate :: Unfolding -> CoreExpr
339 unfoldingTemplate (CoreUnfolding expr _ _ _ _) = expr
340 unfoldingTemplate (CompulsoryUnfolding expr) = expr
341 unfoldingTemplate _ = panic "getUnfoldingTemplate"
343 maybeUnfoldingTemplate :: Unfolding -> Maybe CoreExpr
344 maybeUnfoldingTemplate (CoreUnfolding expr _ _ _ _) = Just expr
345 maybeUnfoldingTemplate (CompulsoryUnfolding expr) = Just expr
346 maybeUnfoldingTemplate _ = Nothing
348 otherCons :: Unfolding -> [AltCon]
349 otherCons (OtherCon cons) = cons
352 isValueUnfolding :: Unfolding -> Bool
353 -- Returns False for OtherCon
354 isValueUnfolding (CoreUnfolding _ _ is_evald _ _) = is_evald
355 isValueUnfolding _ = False
357 isEvaldUnfolding :: Unfolding -> Bool
358 -- Returns True for OtherCon
359 isEvaldUnfolding (OtherCon _) = True
360 isEvaldUnfolding (CoreUnfolding _ _ is_evald _ _) = is_evald
361 isEvaldUnfolding _ = False
363 isCheapUnfolding :: Unfolding -> Bool
364 isCheapUnfolding (CoreUnfolding _ _ _ is_cheap _) = is_cheap
365 isCheapUnfolding _ = False
367 isCompulsoryUnfolding :: Unfolding -> Bool
368 isCompulsoryUnfolding (CompulsoryUnfolding _) = True
369 isCompulsoryUnfolding _ = False
371 hasUnfolding :: Unfolding -> Bool
372 hasUnfolding (CoreUnfolding _ _ _ _ _) = True
373 hasUnfolding (CompulsoryUnfolding _) = True
374 hasUnfolding _ = False
376 hasSomeUnfolding :: Unfolding -> Bool
377 hasSomeUnfolding NoUnfolding = False
378 hasSomeUnfolding _ = True
380 neverUnfold :: Unfolding -> Bool
381 neverUnfold NoUnfolding = True
382 neverUnfold (OtherCon _) = True
383 neverUnfold (CoreUnfolding _ _ _ _ UnfoldNever) = True
384 neverUnfold _ = False
388 %************************************************************************
390 \subsection{The main data type}
392 %************************************************************************
395 -- The Ord is needed for the FiniteMap used in the lookForConstructor
396 -- in SimplEnv. If you declared that lookForConstructor *ignores*
397 -- constructor-applications with LitArg args, then you could get
400 instance Outputable AltCon where
401 ppr (DataAlt dc) = ppr dc
402 ppr (LitAlt lit) = ppr lit
403 ppr DEFAULT = ptext (sLit "__DEFAULT")
405 instance Show AltCon where
406 showsPrec p con = showsPrecSDoc p (ppr con)
408 cmpAlt :: Alt b -> Alt b -> Ordering
409 cmpAlt (con1, _, _) (con2, _, _) = con1 `cmpAltCon` con2
411 ltAlt :: Alt b -> Alt b -> Bool
412 ltAlt a1 a2 = (a1 `cmpAlt` a2) == LT
414 cmpAltCon :: AltCon -> AltCon -> Ordering
415 -- Compares AltCons within a single list of alternatives
416 cmpAltCon DEFAULT DEFAULT = EQ
417 cmpAltCon DEFAULT _ = LT
419 cmpAltCon (DataAlt d1) (DataAlt d2) = dataConTag d1 `compare` dataConTag d2
420 cmpAltCon (DataAlt _) DEFAULT = GT
421 cmpAltCon (LitAlt l1) (LitAlt l2) = l1 `compare` l2
422 cmpAltCon (LitAlt _) DEFAULT = GT
424 cmpAltCon con1 con2 = WARN( True, text "Comparing incomparable AltCons" <+>
425 ppr con1 <+> ppr con2 )
430 %************************************************************************
432 \subsection{Useful synonyms}
434 %************************************************************************
440 type CoreExpr = Expr CoreBndr
441 type CoreArg = Arg CoreBndr
442 type CoreBind = Bind CoreBndr
443 type CoreAlt = Alt CoreBndr
446 Binders are ``tagged'' with a \tr{t}:
449 data TaggedBndr t = TB CoreBndr t -- TB for "tagged binder"
451 type TaggedBind t = Bind (TaggedBndr t)
452 type TaggedExpr t = Expr (TaggedBndr t)
453 type TaggedArg t = Arg (TaggedBndr t)
454 type TaggedAlt t = Alt (TaggedBndr t)
456 instance Outputable b => Outputable (TaggedBndr b) where
457 ppr (TB b l) = char '<' <> ppr b <> comma <> ppr l <> char '>'
459 instance Outputable b => OutputableBndr (TaggedBndr b) where
460 pprBndr _ b = ppr b -- Simple
464 %************************************************************************
466 \subsection{Core-constructing functions with checking}
468 %************************************************************************
471 mkApps :: Expr b -> [Arg b] -> Expr b
472 mkTyApps :: Expr b -> [Type] -> Expr b
473 mkValApps :: Expr b -> [Expr b] -> Expr b
474 mkVarApps :: Expr b -> [Var] -> Expr b
476 mkApps f args = foldl App f args
477 mkTyApps f args = foldl (\ e a -> App e (Type a)) f args
478 mkValApps f args = foldl (\ e a -> App e a) f args
479 mkVarApps f vars = foldl (\ e a -> App e (varToCoreExpr a)) f vars
481 mkLit :: Literal -> Expr b
482 mkIntLit :: Integer -> Expr b
483 mkIntLitInt :: Int -> Expr b
484 mkConApp :: DataCon -> [Arg b] -> Expr b
485 mkLets :: [Bind b] -> Expr b -> Expr b
486 mkLams :: [b] -> Expr b -> Expr b
489 mkConApp con args = mkApps (Var (dataConWorkId con)) args
491 mkLams binders body = foldr Lam body binders
492 mkLets binds body = foldr Let body binds
494 mkIntLit n = Lit (mkMachInt n)
495 mkIntLitInt n = Lit (mkMachInt (toInteger n))
497 varToCoreExpr :: CoreBndr -> Expr b
498 varToCoreExpr v | isId v = Var v
499 | otherwise = Type (mkTyVarTy v)
501 varsToCoreExprs :: [CoreBndr] -> [Expr b]
502 varsToCoreExprs vs = map varToCoreExpr vs
504 mkCast :: Expr b -> Coercion -> Expr b
505 mkCast e co = Cast e co
509 %************************************************************************
511 \subsection{Simple access functions}
513 %************************************************************************
516 mkTyBind :: TyVar -> Type -> CoreBind
517 mkTyBind tv ty = NonRec tv (Type ty)
519 -- A non-recursive let can bind a type variable
521 bindersOf :: Bind b -> [b]
522 bindersOf (NonRec binder _) = [binder]
523 bindersOf (Rec pairs) = [binder | (binder, _) <- pairs]
525 bindersOfBinds :: [Bind b] -> [b]
526 bindersOfBinds binds = foldr ((++) . bindersOf) [] binds
528 rhssOfBind :: Bind b -> [Expr b]
529 rhssOfBind (NonRec _ rhs) = [rhs]
530 rhssOfBind (Rec pairs) = [rhs | (_,rhs) <- pairs]
532 rhssOfAlts :: [Alt b] -> [Expr b]
533 rhssOfAlts alts = [e | (_,_,e) <- alts]
535 flattenBinds :: [Bind b] -> [(b, Expr b)] -- Get all the lhs/rhs pairs
536 flattenBinds (NonRec b r : binds) = (b,r) : flattenBinds binds
537 flattenBinds (Rec prs1 : binds) = prs1 ++ flattenBinds binds
541 We often want to strip off leading lambdas before getting down to
542 business. @collectBinders@ is your friend.
544 We expect (by convention) type-, and value- lambdas in that
548 collectBinders :: Expr b -> ([b], Expr b)
549 collectTyBinders :: CoreExpr -> ([TyVar], CoreExpr)
550 collectValBinders :: CoreExpr -> ([Id], CoreExpr)
551 collectTyAndValBinders :: CoreExpr -> ([TyVar], [Id], CoreExpr)
556 go bs (Lam b e) = go (b:bs) e
557 go bs e = (reverse bs, e)
559 collectTyAndValBinders expr
562 (tvs, body1) = collectTyBinders expr
563 (ids, body) = collectValBinders body1
565 collectTyBinders expr
568 go tvs (Lam b e) | isTyVar b = go (b:tvs) e
569 go tvs e = (reverse tvs, e)
571 collectValBinders expr
574 go ids (Lam b e) | isId b = go (b:ids) e
575 go ids body = (reverse ids, body)
579 @collectArgs@ takes an application expression, returning the function
580 and the arguments to which it is applied.
583 collectArgs :: Expr b -> (Expr b, [Arg b])
587 go (App f a) as = go f (a:as)
591 coreExprCc gets the cost centre enclosing an expression, if any.
592 It looks inside lambdas because (scc "foo" \x.e) = \x.scc "foo" e
595 coreExprCc :: Expr b -> CostCentre
596 coreExprCc (Note (SCC cc) _) = cc
597 coreExprCc (Note _ e) = coreExprCc e
598 coreExprCc (Lam _ e) = coreExprCc e
599 coreExprCc _ = noCostCentre
604 %************************************************************************
606 \subsection{Predicates}
608 %************************************************************************
610 At one time we optionally carried type arguments through to runtime.
611 @isRuntimeVar v@ returns if (Lam v _) really becomes a lambda at runtime,
612 i.e. if type applications are actual lambdas because types are kept around
613 at runtime. Similarly isRuntimeArg.
616 isRuntimeVar :: Var -> Bool
619 isRuntimeArg :: CoreExpr -> Bool
620 isRuntimeArg = isValArg
622 isValArg :: Expr b -> Bool
623 isValArg (Type _) = False
626 isTypeArg :: Expr b -> Bool
627 isTypeArg (Type _) = True
630 valBndrCount :: [CoreBndr] -> Int
631 valBndrCount = count isId
633 valArgCount :: [Arg b] -> Int
634 valArgCount = count isValArg
638 %************************************************************************
640 \subsection{Seq stuff}
642 %************************************************************************
645 seqExpr :: CoreExpr -> ()
646 seqExpr (Var v) = v `seq` ()
647 seqExpr (Lit lit) = lit `seq` ()
648 seqExpr (App f a) = seqExpr f `seq` seqExpr a
649 seqExpr (Lam b e) = seqBndr b `seq` seqExpr e
650 seqExpr (Let b e) = seqBind b `seq` seqExpr e
651 seqExpr (Case e b t as) = seqExpr e `seq` seqBndr b `seq` seqType t `seq` seqAlts as
652 seqExpr (Cast e co) = seqExpr e `seq` seqType co
653 seqExpr (Note n e) = seqNote n `seq` seqExpr e
654 seqExpr (Type t) = seqType t
656 seqExprs :: [CoreExpr] -> ()
658 seqExprs (e:es) = seqExpr e `seq` seqExprs es
660 seqNote :: Note -> ()
661 seqNote (CoreNote s) = s `seq` ()
664 seqBndr :: CoreBndr -> ()
665 seqBndr b = b `seq` ()
667 seqBndrs :: [CoreBndr] -> ()
669 seqBndrs (b:bs) = seqBndr b `seq` seqBndrs bs
671 seqBind :: Bind CoreBndr -> ()
672 seqBind (NonRec b e) = seqBndr b `seq` seqExpr e
673 seqBind (Rec prs) = seqPairs prs
675 seqPairs :: [(CoreBndr, CoreExpr)] -> ()
677 seqPairs ((b,e):prs) = seqBndr b `seq` seqExpr e `seq` seqPairs prs
679 seqAlts :: [CoreAlt] -> ()
681 seqAlts ((c,bs,e):alts) = c `seq` seqBndrs bs `seq` seqExpr e `seq` seqAlts alts
683 seqRules :: [CoreRule] -> ()
685 seqRules (Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs } : rules)
686 = seqBndrs bndrs `seq` seqExprs (rhs:args) `seq` seqRules rules
687 seqRules (BuiltinRule {} : rules) = seqRules rules
692 %************************************************************************
694 \subsection{Annotated core; annotation at every node in the tree}
696 %************************************************************************
699 type AnnExpr bndr annot = (annot, AnnExpr' bndr annot)
701 data AnnExpr' bndr annot
704 | AnnLam bndr (AnnExpr bndr annot)
705 | AnnApp (AnnExpr bndr annot) (AnnExpr bndr annot)
706 | AnnCase (AnnExpr bndr annot) bndr Type [AnnAlt bndr annot]
707 | AnnLet (AnnBind bndr annot) (AnnExpr bndr annot)
708 | AnnCast (AnnExpr bndr annot) Coercion
709 | AnnNote Note (AnnExpr bndr annot)
712 type AnnAlt bndr annot = (AltCon, [bndr], AnnExpr bndr annot)
714 data AnnBind bndr annot
715 = AnnNonRec bndr (AnnExpr bndr annot)
716 | AnnRec [(bndr, AnnExpr bndr annot)]
720 deAnnotate :: AnnExpr bndr annot -> Expr bndr
721 deAnnotate (_, e) = deAnnotate' e
723 deAnnotate' :: AnnExpr' bndr annot -> Expr bndr
724 deAnnotate' (AnnType t) = Type t
725 deAnnotate' (AnnVar v) = Var v
726 deAnnotate' (AnnLit lit) = Lit lit
727 deAnnotate' (AnnLam binder body) = Lam binder (deAnnotate body)
728 deAnnotate' (AnnApp fun arg) = App (deAnnotate fun) (deAnnotate arg)
729 deAnnotate' (AnnCast e co) = Cast (deAnnotate e) co
730 deAnnotate' (AnnNote note body) = Note note (deAnnotate body)
732 deAnnotate' (AnnLet bind body)
733 = Let (deAnnBind bind) (deAnnotate body)
735 deAnnBind (AnnNonRec var rhs) = NonRec var (deAnnotate rhs)
736 deAnnBind (AnnRec pairs) = Rec [(v,deAnnotate rhs) | (v,rhs) <- pairs]
738 deAnnotate' (AnnCase scrut v t alts)
739 = Case (deAnnotate scrut) v t (map deAnnAlt alts)
741 deAnnAlt :: AnnAlt bndr annot -> Alt bndr
742 deAnnAlt (con,args,rhs) = (con,args,deAnnotate rhs)
746 collectAnnBndrs :: AnnExpr bndr annot -> ([bndr], AnnExpr bndr annot)
750 collect bs (_, AnnLam b body) = collect (b:bs) body
751 collect bs body = (reverse bs, body)