CoreSyn.lhs 18.8 KB
Newer Older
1
%
2
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
3 4 5 6 7
%
\section[CoreSyn]{A data type for the Haskell compiler midsection}

\begin{code}
module CoreSyn (
8
	Expr(..), Alt, Bind(..), AltCon(..), Arg, Note(..),
9
	CoreExpr, CoreAlt, CoreBind, CoreArg, CoreBndr,
10
	TaggedExpr, TaggedAlt, TaggedBind, TaggedArg, TaggedBndr(..),
11

12
	mkLets, mkLams, 
13
	mkApps, mkTyApps, mkValApps, mkVarApps,
14
	mkLit, mkIntLitInt, mkIntLit, 
15
	mkConApp, 
16
	varToCoreExpr,
17

18
	isTyVar, isId, 
19
	bindersOf, bindersOfBinds, rhssOfBind, rhssOfAlts, 
20
	collectBinders, collectTyBinders, collectValBinders, collectTyAndValBinders,
21
	collectArgs, 
22
	coreExprCc,
23
	flattenBinds, 
24

25
	isValArg, isTypeArg, valArgCount, valBndrCount, isRuntimeArg, isRuntimeVar,
26

27 28 29 30 31
	-- Unfoldings
	Unfolding(..),	UnfoldingGuidance(..), 	-- Both abstract everywhere but in CoreUnfold.lhs
	noUnfolding, mkOtherCon,
	unfoldingTemplate, maybeUnfoldingTemplate, otherCons, 
	isValueUnfolding, isEvaldUnfolding, isCheapUnfolding, isCompulsoryUnfolding,
32
	hasUnfolding, hasSomeUnfolding, neverUnfold,
33

34 35
	-- Seq stuff
	seqRules, seqExpr, seqExprs, seqUnfolding,
36

37
	-- Annotated expressions
38
	AnnExpr, AnnExpr'(..), AnnBind(..), AnnAlt, 
39
	deAnnotate, deAnnotate', deAnnAlt, collectAnnBndrs,
40 41 42 43

	-- Core rules
	CoreRules(..), 	-- Representation needed by friends
	CoreRule(..),	-- CoreSubst, CoreTidy, CoreFVs, PprCore only
44
	IdCoreRule,
45
	RuleName,
46
	emptyCoreRules, isEmptyCoreRules, rulesRhsFreeVars, rulesRules,
47
	isBuiltinRule, ruleName
48 49
    ) where

50
#include "HsVersions.h"
51

52
import CmdLineOpts	( opt_RuntimeTypes )
53
import CostCentre	( CostCentre, noCostCentre )
54
import Var		( Var, Id, TyVar, isTyVar, isId )
55
import Type		( Type, mkTyVarTy, seqType )
56
import Literal	        ( Literal, mkMachInt )
57
import DataCon		( DataCon, dataConWorkId )
58
import BasicTypes	( Activation )
59
import VarSet
60
import FastString
61
import Outputable
62 63 64 65
\end{code}

%************************************************************************
%*									*
66
\subsection{The main data types}
67 68 69
%*									*
%************************************************************************

70
These data types are the heart of the compiler
71

72
\begin{code}
73 74
infixl 8 `App`	-- App brackets to the left

75 76
data Expr b	-- "b" for the type of binders, 
  = Var	  Id
77
  | Lit   Literal
78 79 80 81
  | App   (Expr b) (Arg b)
  | Lam   b (Expr b)
  | Let   (Bind b) (Expr b)
  | Case  (Expr b) b [Alt b]  	-- Binder gets bound to value of scrutinee
82
				-- DEFAULT case must be *first*, if it occurs at all
83 84 85 86 87 88
  | Note  Note (Expr b)
  | Type  Type			-- This should only show up at the top
				-- level of an Arg

type Arg b = Expr b		-- Can be a Type

89 90 91 92 93 94
type Alt b = (AltCon, [b], Expr b)	-- (DEFAULT, [], rhs) is the default alternative

data AltCon = DataAlt DataCon
	    | LitAlt  Literal
	    | DEFAULT
	 deriving (Eq, Ord)
95

96 97
data Bind b = NonRec b (Expr b)
	      | Rec [(b, (Expr b))]
98

99
data Note
100
  = SCC CostCentre
101

102
  | Coerce	
103 104
	Type		-- The to-type:   type of whole coerce expression
	Type		-- The from-type: type of enclosed expression
105

106 107
  | InlineCall		-- Instructs simplifier to inline
			-- the enclosed call
108

109 110
  | InlineMe		-- Instructs simplifer to treat the enclosed expression
			-- as very small, and inline it at its call sites
111

112 113
  | CoreNote String     -- A generic core annotation, propagated but not used by GHC

114 115 116 117 118 119 120 121 122
-- NOTE: we also treat expressions wrapped in InlineMe as
-- 'cheap' and 'dupable' (in the sense of exprIsCheap, exprIsDupable)
-- What this means is that we obediently inline even things that don't
-- look like valuse.  This is sometimes important:
--	{-# INLINE f #-}
--	f = g . h
-- Here, f looks like a redex, and we aren't going to inline (.) because it's
-- inside an INLINE, so it'll stay looking like a redex.  Nevertheless, we 
-- should inline f even inside lambdas.  In effect, we should trust the programmer.
123
\end{code}
124

125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141
INVARIANTS:

* The RHS of a letrec, and the RHSs of all top-level lets,
  must be of LIFTED type.

* The RHS of a let, may be of UNLIFTED type, but only if the expression 
  is ok-for-speculation.  This means that the let can be floated around 
  without difficulty.  e.g.
	y::Int# = x +# 1#	ok
	y::Int# = fac 4#	not ok [use case instead]

* The argument of an App can be of any type.

* The simplifier tries to ensure that if the RHS of a let is a constructor
  application, its arguments are trivial, so that the constructor can be
  inlined vigorously.

142

143 144 145 146 147 148 149 150 151 152 153 154
%************************************************************************
%*									*
\subsection{Transformation rules}
%*									*
%************************************************************************

The CoreRule type and its friends are dealt with mainly in CoreRules,
but CoreFVs, Subst, PprCore, CoreTidy also inspect the representation.

\begin{code}
data CoreRules 
  = Rules [CoreRule]
155
	  VarSet		-- Locally-defined free vars of RHSs
156

157 158 159 160 161 162 163 164 165 166 167 168 169 170
emptyCoreRules :: CoreRules
emptyCoreRules = Rules [] emptyVarSet

isEmptyCoreRules :: CoreRules -> Bool
isEmptyCoreRules (Rules rs _) = null rs

rulesRhsFreeVars :: CoreRules -> VarSet
rulesRhsFreeVars (Rules _ fvs) = fvs

rulesRules :: CoreRules -> [CoreRule]
rulesRules (Rules rules _) = rules
\end{code}

\begin{code}
171
type RuleName = FastString
172
type IdCoreRule = (Id,CoreRule)		-- Rules don't have their leading Id inside them
173

174
data CoreRule
175
  = Rule RuleName
176
	 Activation	-- When the rule is active
177 178 179 180
	 [CoreBndr]	-- Forall'd variables
	 [CoreExpr]	-- LHS args
	 CoreExpr	-- RHS

181
  | BuiltinRule		-- Built-in rules are used for constant folding
182 183
	RuleName	-- and suchlike.  It has no free variables.
	([CoreExpr] -> Maybe CoreExpr)
184

185 186 187 188
isBuiltinRule (BuiltinRule _ _) = True
isBuiltinRule _		        = False

ruleName :: CoreRule -> RuleName
189
ruleName (Rule n _ _ _ _)  = n
190
ruleName (BuiltinRule n _) = n
191 192 193
\end{code}


194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220
%************************************************************************
%*									*
\subsection{@Unfolding@ type}
%*									*
%************************************************************************

The @Unfolding@ type is declared here to avoid numerous loops, but it
should be abstract everywhere except in CoreUnfold.lhs

\begin{code}
data Unfolding
  = NoUnfolding

  | OtherCon [AltCon]		-- It ain't one of these
				-- (OtherCon xs) also indicates that something has been evaluated
				-- and hence there's no point in re-evaluating it.
				-- OtherCon [] is used even for non-data-type values
				-- to indicated evaluated-ness.  Notably:
				--	data C = C !(Int -> Int)
				-- 	case x of { C f -> ... }
				-- Here, f gets an OtherCon [] unfolding.

  | CompulsoryUnfolding CoreExpr	-- There is no "original" definition,
					-- so you'd better unfold.

  | CoreUnfolding			-- An unfolding with redundant cached information
		CoreExpr		-- Template; binder-info is correct
221
		Bool			-- True <=> top level binding
222 223
		Bool			-- exprIsValue template (cached); it is ok to discard a `seq` on
					--	this variable
224 225
		Bool			-- True <=> doesn't waste (much) work to expand inside an inlining
					-- 	Basically it's exprIsCheap
226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247
		UnfoldingGuidance	-- Tells about the *size* of the template.


data UnfoldingGuidance
  = UnfoldNever
  | UnfoldIfGoodArgs	Int	-- and "n" value args

			[Int]	-- Discount if the argument is evaluated.
				-- (i.e., a simplification will definitely
				-- be possible).  One elt of the list per *value* arg.

			Int	-- The "size" of the unfolding; to be elaborated
				-- later. ToDo

			Int	-- Scrutinee discount: the discount to substract if the thing is in
				-- a context (case (thing args) of ...),
				-- (where there are the right number of arguments.)

noUnfolding = NoUnfolding
mkOtherCon  = OtherCon

seqUnfolding :: Unfolding -> ()
248 249
seqUnfolding (CoreUnfolding e top b1 b2 g)
  = seqExpr e `seq` top `seq` b1 `seq` b2 `seq` seqGuidance g
250 251 252 253 254 255 256 257
seqUnfolding other = ()

seqGuidance (UnfoldIfGoodArgs n ns a b) = n `seq` sum ns `seq` a `seq` b `seq` ()
seqGuidance other			= ()
\end{code}

\begin{code}
unfoldingTemplate :: Unfolding -> CoreExpr
258 259
unfoldingTemplate (CoreUnfolding expr _ _ _ _) = expr
unfoldingTemplate (CompulsoryUnfolding expr)   = expr
260 261 262
unfoldingTemplate other = panic "getUnfoldingTemplate"

maybeUnfoldingTemplate :: Unfolding -> Maybe CoreExpr
263 264 265
maybeUnfoldingTemplate (CoreUnfolding expr _ _ _ _) = Just expr
maybeUnfoldingTemplate (CompulsoryUnfolding expr)   = Just expr
maybeUnfoldingTemplate other 			    = Nothing
266 267 268 269 270 271 272

otherCons :: Unfolding -> [AltCon]
otherCons (OtherCon cons) = cons
otherCons other		  = []

isValueUnfolding :: Unfolding -> Bool
	-- Returns False for OtherCon
273 274
isValueUnfolding (CoreUnfolding _ _ is_evald _ _) = is_evald
isValueUnfolding other			          = False
275 276 277

isEvaldUnfolding :: Unfolding -> Bool
	-- Returns True for OtherCon
278 279 280
isEvaldUnfolding (OtherCon _)		          = True
isEvaldUnfolding (CoreUnfolding _ _ is_evald _ _) = is_evald
isEvaldUnfolding other			          = False
281 282

isCheapUnfolding :: Unfolding -> Bool
283 284
isCheapUnfolding (CoreUnfolding _ _ _ is_cheap _) = is_cheap
isCheapUnfolding other			  	  = False
285 286 287 288 289 290

isCompulsoryUnfolding :: Unfolding -> Bool
isCompulsoryUnfolding (CompulsoryUnfolding _) = True
isCompulsoryUnfolding other		      = False

hasUnfolding :: Unfolding -> Bool
291 292 293
hasUnfolding (CoreUnfolding _ _ _ _ _) = True
hasUnfolding (CompulsoryUnfolding _)   = True
hasUnfolding other 	 	       = False
294 295 296 297

hasSomeUnfolding :: Unfolding -> Bool
hasSomeUnfolding NoUnfolding = False
hasSomeUnfolding other	     = True
298 299 300 301 302 303

neverUnfold :: Unfolding -> Bool
neverUnfold NoUnfolding				= True
neverUnfold (OtherCon _)			= True
neverUnfold (CoreUnfolding _ _ _ _ UnfoldNever) = True
neverUnfold other 				= False
304 305 306
\end{code}


307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328
%************************************************************************
%*									*
\subsection{The main data type}
%*									*
%************************************************************************

\begin{code}
-- The Ord is needed for the FiniteMap used in the lookForConstructor
-- in SimplEnv.  If you declared that lookForConstructor *ignores*
-- constructor-applications with LitArg args, then you could get
-- rid of this Ord.

instance Outputable AltCon where
  ppr (DataAlt dc) = ppr dc
  ppr (LitAlt lit) = ppr lit
  ppr DEFAULT      = ptext SLIT("__DEFAULT")

instance Show AltCon where
  showsPrec p con = showsPrecSDoc p (ppr con)
\end{code}


329 330
%************************************************************************
%*									*
331
\subsection{Useful synonyms}
332 333 334
%*									*
%************************************************************************

335
The common case
dnt's avatar
dnt committed
336

337
\begin{code}
338
type CoreBndr = Var
339 340 341 342
type CoreExpr = Expr CoreBndr
type CoreArg  = Arg  CoreBndr
type CoreBind = Bind CoreBndr
type CoreAlt  = Alt  CoreBndr
343 344
\end{code}

345
Binders are ``tagged'' with a \tr{t}:
346 347

\begin{code}
348
data TaggedBndr t = TB CoreBndr t	-- TB for "tagged binder"
349

350 351 352 353 354 355 356 357 358 359
type TaggedBind t = Bind (TaggedBndr t)
type TaggedExpr t = Expr (TaggedBndr t)
type TaggedArg  t = Arg  (TaggedBndr t)
type TaggedAlt  t = Alt  (TaggedBndr t)

instance Outputable b => Outputable (TaggedBndr b) where
  ppr (TB b l) = char '<' <> ppr b <> comma <> ppr l <> char '>'

instance Outputable b => OutputableBndr (TaggedBndr b) where
  pprBndr _ b = ppr b	-- Simple
360 361
\end{code}

362

363 364
%************************************************************************
%*									*
365
\subsection{Core-constructing functions with checking}
366 367
%*									*
%************************************************************************
368 369

\begin{code}
370 371 372
mkApps    :: Expr b -> [Arg b]  -> Expr b
mkTyApps  :: Expr b -> [Type]   -> Expr b
mkValApps :: Expr b -> [Expr b] -> Expr b
373
mkVarApps :: Expr b -> [Var] -> Expr b
374 375 376 377

mkApps    f args = foldl App		  	   f args
mkTyApps  f args = foldl (\ e a -> App e (Type a)) f args
mkValApps f args = foldl (\ e a -> App e a)	   f args
378
mkVarApps f vars = foldl (\ e a -> App e (varToCoreExpr a)) f vars
379

380
mkLit         :: Literal -> Expr b
381 382
mkIntLit      :: Integer -> Expr b
mkIntLitInt   :: Int     -> Expr b
383
mkConApp      :: DataCon -> [Arg b] -> Expr b
384 385
mkLets	      :: [Bind b] -> Expr b -> Expr b
mkLams	      :: [b] -> Expr b -> Expr b
386

387
mkLit lit	  = Lit lit
388
mkConApp con args = mkApps (Var (dataConWorkId con)) args
389

390 391 392
mkLams binders body = foldr Lam body binders
mkLets binds body   = foldr Let body binds

393 394
mkIntLit    n = Lit (mkMachInt n)
mkIntLitInt n = Lit (mkMachInt (toInteger n))
395

396
varToCoreExpr :: CoreBndr -> Expr b
397 398
varToCoreExpr v | isId v    = Var v
                | otherwise = Type (mkTyVarTy v)
399 400
\end{code}

401

402 403
%************************************************************************
%*									*
404
\subsection{Simple access functions}
405 406 407 408
%*									*
%************************************************************************

\begin{code}
409
bindersOf  :: Bind b -> [b]
410 411
bindersOf (NonRec binder _) = [binder]
bindersOf (Rec pairs)       = [binder | (binder, _) <- pairs]
412

413 414 415
bindersOfBinds :: [Bind b] -> [b]
bindersOfBinds binds = foldr ((++) . bindersOf) [] binds

416
rhssOfBind :: Bind b -> [Expr b]
417 418
rhssOfBind (NonRec _ rhs) = [rhs]
rhssOfBind (Rec pairs)    = [rhs | (_,rhs) <- pairs]
419

420
rhssOfAlts :: [Alt b] -> [Expr b]
421
rhssOfAlts alts = [e | (_,_,e) <- alts]
422

423 424 425 426
flattenBinds :: [Bind b] -> [(b, Expr b)]	-- Get all the lhs/rhs pairs
flattenBinds (NonRec b r : binds) = (b,r) : flattenBinds binds
flattenBinds (Rec prs1   : binds) = prs1 ++ flattenBinds binds
flattenBinds []			  = []
427 428
\end{code}

429
We often want to strip off leading lambdas before getting down to
430
business.  @collectBinders@ is your friend.
431

432
We expect (by convention) type-, and value- lambdas in that
433 434
order.

435
\begin{code}
436 437 438 439 440 441 442 443 444 445 446
collectBinders	             :: Expr b -> ([b],         Expr b)
collectTyBinders       	     :: CoreExpr -> ([TyVar],     CoreExpr)
collectValBinders      	     :: CoreExpr -> ([Id],        CoreExpr)
collectTyAndValBinders 	     :: CoreExpr -> ([TyVar], [Id], CoreExpr)

collectBinders expr
  = go [] expr
  where
    go bs (Lam b e) = go (b:bs) e
    go bs e	     = (reverse bs, e)

447 448 449 450 451
collectTyAndValBinders expr
  = (tvs, ids, body)
  where
    (tvs, body1) = collectTyBinders expr
    (ids, body)  = collectValBinders body1
452

453
collectTyBinders expr
454
  = go [] expr
455
  where
456 457
    go tvs (Lam b e) | isTyVar b = go (b:tvs) e
    go tvs e			 = (reverse tvs, e)
458

459
collectValBinders expr
460
  = go [] expr
461
  where
462 463
    go ids (Lam b e) | isId b = go (b:ids) e
    go ids body		      = (reverse ids, body)
464 465 466 467 468 469 470
\end{code}


@collectArgs@ takes an application expression, returning the function
and the arguments to which it is applied.

\begin{code}
471
collectArgs :: Expr b -> (Expr b, [Arg b])
472
collectArgs expr
473
  = go expr []
474
  where
475 476
    go (App f a) as = go f (a:as)
    go e 	 as = (e, as)
477 478
\end{code}

479 480
coreExprCc gets the cost centre enclosing an expression, if any.
It looks inside lambdas because (scc "foo" \x.e) = \x.scc "foo" e
481 482

\begin{code}
483
coreExprCc :: Expr b -> CostCentre
484 485 486 487
coreExprCc (Note (SCC cc) e)   = cc
coreExprCc (Note other_note e) = coreExprCc e
coreExprCc (Lam _ e)           = coreExprCc e
coreExprCc other               = noCostCentre
488 489 490
\end{code}


491

492 493
%************************************************************************
%*									*
494
\subsection{Predicates}
495 496 497
%*									*
%************************************************************************

498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513
@isRuntimeVar v@ returns if (Lam v _) really becomes a lambda at runtime,
i.e. if type applications are actual lambdas because types are kept around
at runtime.  

Similarly isRuntimeArg.  

\begin{code}
isRuntimeVar :: Var -> Bool
isRuntimeVar | opt_RuntimeTypes = \v -> True
	     | otherwise	= \v -> isId v

isRuntimeArg :: CoreExpr -> Bool
isRuntimeArg | opt_RuntimeTypes = \e -> True
	     | otherwise	= \e -> isValArg e
\end{code}

514
\begin{code}
515 516 517 518 519
isValArg (Type _) = False
isValArg other    = True

isTypeArg (Type _) = True
isTypeArg other    = False
520

521 522 523 524 525
valBndrCount :: [CoreBndr] -> Int
valBndrCount []		    	  = 0
valBndrCount (b : bs) | isId b    = 1 + valBndrCount bs
		      | otherwise = valBndrCount bs

526
valArgCount :: [Arg b] -> Int
527 528 529
valArgCount []		    = 0
valArgCount (Type _ : args) = valArgCount args
valArgCount (other  : args) = 1 + valArgCount args
530 531
\end{code}

532

533 534 535 536 537 538 539 540 541
%************************************************************************
%*									*
\subsection{Seq stuff}
%*									*
%************************************************************************

\begin{code}
seqExpr :: CoreExpr -> ()
seqExpr (Var v)       = v `seq` ()
542
seqExpr (Lit lit)     = lit `seq` ()
543 544 545 546 547 548 549 550 551 552 553
seqExpr (App f a)     = seqExpr f `seq` seqExpr a
seqExpr (Lam b e)     = seqBndr b `seq` seqExpr e
seqExpr (Let b e)     = seqBind b `seq` seqExpr e
seqExpr (Case e b as) = seqExpr e `seq` seqBndr b `seq` seqAlts as
seqExpr (Note n e)    = seqNote n `seq` seqExpr e
seqExpr (Type t)      = seqType t

seqExprs [] = ()
seqExprs (e:es) = seqExpr e `seq` seqExprs es

seqNote (Coerce t1 t2) = seqType t1 `seq` seqType t2
554
seqNote (CoreNote s)   = s `seq` ()
555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574
seqNote other	       = ()

seqBndr b = b `seq` ()

seqBndrs [] = ()
seqBndrs (b:bs) = seqBndr b `seq` seqBndrs bs

seqBind (NonRec b e) = seqBndr b `seq` seqExpr e
seqBind (Rec prs)    = seqPairs prs

seqPairs [] = ()
seqPairs ((b,e):prs) = seqBndr b `seq` seqExpr e `seq` seqPairs prs

seqAlts [] = ()
seqAlts ((c,bs,e):alts) = seqBndrs bs `seq` seqExpr e `seq` seqAlts alts

seqRules :: CoreRules -> ()
seqRules (Rules rules fvs) = seq_rules rules `seq` seqVarSet fvs

seq_rules [] = ()
575 576
seq_rules (Rule fs _ bs es e : rules) = seqBndrs bs `seq` seqExprs (e:es) `seq` seq_rules rules
seq_rules (BuiltinRule _ _   : rules) = seq_rules rules
577 578 579 580
\end{code}



581 582
%************************************************************************
%*									*
583
\subsection{Annotated core; annotation at every node in the tree}
584 585
%*									*
%************************************************************************
586 587

\begin{code}
588 589 590 591
type AnnExpr bndr annot = (annot, AnnExpr' bndr annot)

data AnnExpr' bndr annot
  = AnnVar	Id
592
  | AnnLit	Literal
593 594 595 596
  | AnnLam	bndr (AnnExpr bndr annot)
  | AnnApp	(AnnExpr bndr annot) (AnnExpr bndr annot)
  | AnnCase	(AnnExpr bndr annot) bndr [AnnAlt bndr annot]
  | AnnLet	(AnnBind bndr annot) (AnnExpr bndr annot)
597
  | AnnNote	Note (AnnExpr bndr annot)
598 599
  | AnnType	Type

600
type AnnAlt bndr annot = (AltCon, [bndr], AnnExpr bndr annot)
601 602 603 604

data AnnBind bndr annot
  = AnnNonRec bndr (AnnExpr bndr annot)
  | AnnRec    [(bndr, AnnExpr bndr annot)]
605 606 607
\end{code}

\begin{code}
608
deAnnotate :: AnnExpr bndr annot -> Expr bndr
609
deAnnotate (_, e) = deAnnotate' e
610

611 612 613 614 615 616
deAnnotate' (AnnType t)           = Type t
deAnnotate' (AnnVar  v)           = Var v
deAnnotate' (AnnLit  lit)         = Lit lit
deAnnotate' (AnnLam  binder body) = Lam binder (deAnnotate body)
deAnnotate' (AnnApp  fun arg)     = App (deAnnotate fun) (deAnnotate arg)
deAnnotate' (AnnNote note body)   = Note note (deAnnotate body)
617

618
deAnnotate' (AnnLet bind body)
619 620 621 622
  = Let (deAnnBind bind) (deAnnotate body)
  where
    deAnnBind (AnnNonRec var rhs) = NonRec var (deAnnotate rhs)
    deAnnBind (AnnRec pairs) = Rec [(v,deAnnotate rhs) | (v,rhs) <- pairs]
623

624
deAnnotate' (AnnCase scrut v alts)
625
  = Case (deAnnotate scrut) v (map deAnnAlt alts)
626 627 628

deAnnAlt :: AnnAlt bndr annot -> Alt bndr
deAnnAlt (con,args,rhs) = (con,args,deAnnotate rhs)
629
\end{code}
630

631 632 633 634 635 636 637 638
\begin{code}
collectAnnBndrs :: AnnExpr bndr annot -> ([bndr], AnnExpr bndr annot)
collectAnnBndrs e
  = collect [] e
  where
    collect bs (_, AnnLam b body) = collect (b:bs) body
    collect bs body		  = (reverse bs, body)
\end{code}