ghc/compiler/coreSyn/CoreSyn.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 \section[CoreSyn]{A data type for the Haskell compiler midsection}
   5
   6 \begin{code}
   7 module CoreSyn (
   8         Expr(..), Alt, Bind(..), AltCon(..), Arg, Note(..),
   9         CoreExpr, CoreAlt, CoreBind, CoreArg, CoreBndr,
  10         TaggedExpr, TaggedAlt, TaggedBind, TaggedArg,
  11
  12         mkLets, mkLams,
  13         mkApps, mkTyApps, mkValApps, mkVarApps,
  14         mkLit, mkIntLitInt, mkIntLit,
  15         mkConApp,
  16         varToCoreExpr,
  17
  18         isTyVar, isId, isLocalVar, mustHaveLocalBinding,
  19         bindersOf, bindersOfBinds, rhssOfBind, rhssOfAlts,
  20         collectBinders, collectTyBinders, collectValBinders, collectTyAndValBinders,
  21         collectArgs, collectBindersIgnoringNotes,
  22         coreExprCc,
  23         flattenBinds,
  24
  25         isValArg, isTypeArg, valArgCount, valBndrCount,
  26
  27         -- Unfoldings
  28         Unfolding(..),  UnfoldingGuidance(..),  -- Both abstract everywhere but in CoreUnfold.lhs
  29         noUnfolding, mkOtherCon,
  30         unfoldingTemplate, maybeUnfoldingTemplate, otherCons,
  31         isValueUnfolding, isEvaldUnfolding, isCheapUnfolding, isCompulsoryUnfolding,
  32         hasUnfolding, hasSomeUnfolding, neverUnfold,
  33
  34         -- Seq stuff
  35         seqRules, seqExpr, seqExprs, seqUnfolding,
  36
  37         -- Annotated expressions
  38         AnnExpr, AnnExpr'(..), AnnBind(..), AnnAlt, deAnnotate, deAnnotate',
  39
  40         -- Core rules
  41         CoreRules(..),  -- Representation needed by friends
  42         CoreRule(..),   -- CoreSubst, CoreTidy, CoreFVs, PprCore only
  43         IdCoreRule,
  44         RuleName,
  45         emptyCoreRules, isEmptyCoreRules, rulesRhsFreeVars, rulesRules,
  46         isBuiltinRule
  47     ) where
  48
  49 #include "HsVersions.h"
  50
  51 import CostCentre       ( CostCentre, noCostCentre )
  52 import Var              ( Var, Id, TyVar, isTyVar, isId )
  53 import Type             ( Type, mkTyVarTy, seqType )
  54 import Literal          ( Literal, mkMachInt )
  55 import DataCon          ( DataCon, dataConId )
  56 import VarSet
  57 import Outputable
  58 \end{code}
  59
  60 %************************************************************************
  61 %*                                                                      *
  62 \subsection{The main data types}
  63 %*                                                                      *
  64 %************************************************************************
  65
  66 These data types are the heart of the compiler
  67
  68 \begin{code}
  69 infixl 8 `App`  -- App brackets to the left
  70
  71 data Expr b     -- "b" for the type of binders,
  72   = Var   Id
  73   | Lit   Literal
  74   | App   (Expr b) (Arg b)
  75   | Lam   b (Expr b)
  76   | Let   (Bind b) (Expr b)
  77   | Case  (Expr b) b [Alt b]    -- Binder gets bound to value of scrutinee
  78                                 -- DEFAULT case must be last, if it occurs at all
  79   | Note  Note (Expr b)
  80   | Type  Type                  -- This should only show up at the top
  81                                 -- level of an Arg
  82
  83 type Arg b = Expr b             -- Can be a Type
  84
  85 type Alt b = (AltCon, [b], Expr b)      -- (DEFAULT, [], rhs) is the default alternative
  86
  87 data AltCon = DataAlt DataCon
  88             | LitAlt  Literal
  89             | DEFAULT
  90          deriving (Eq, Ord)
  91
  92 data Bind b = NonRec b (Expr b)
  93               | Rec [(b, (Expr b))]
  94
  95 data Note
  96   = SCC CostCentre
  97
  98   | Coerce
  99         Type            -- The to-type:   type of whole coerce expression
 100         Type            -- The from-type: type of enclosed expression
 101
 102   | InlineCall          -- Instructs simplifier to inline
 103                         -- the enclosed call
 104
 105   | InlineMe            -- Instructs simplifer to treat the enclosed expression
 106                         -- as very small, and inline it at its call sites
 107 \end{code}
 108
 109
 110 %************************************************************************
 111 %*                                                                      *
 112 \subsection{isLocalVar}
 113 %*                                                                      *
 114 %************************************************************************
 115
 116 @isLocalVar@ returns True of all TyVars, and of Ids that are defined in
 117 this module and are not constants like data constructors and record selectors.
 118 These are the variables that we need to pay attention to when finding free
 119 variables, or doing dependency analysis.
 120
 121 \begin{code}
 122 isLocalVar :: Var -> Bool
 123 isLocalVar v = isTyVar v || isLocalId v
 124 \end{code}
 125
 126 \begin{code}
 127 mustHaveLocalBinding :: Var -> Bool
 128 -- True <=> the variable must have a binding in this module
 129 mustHaveLocalBinding v = isTyVar v || (isLocalId v && not (hasNoBinding v))
 130 \end{code}
 131
 132
 133 %************************************************************************
 134 %*                                                                      *
 135 \subsection{Transformation rules}
 136 %*                                                                      *
 137 %************************************************************************
 138
 139 The CoreRule type and its friends are dealt with mainly in CoreRules,
 140 but CoreFVs, Subst, PprCore, CoreTidy also inspect the representation.
 141
 142 \begin{code}
 143 data CoreRules
 144   = Rules [CoreRule]
 145           VarSet                -- Locally-defined free vars of RHSs
 146
 147 emptyCoreRules :: CoreRules
 148 emptyCoreRules = Rules [] emptyVarSet
 149
 150 isEmptyCoreRules :: CoreRules -> Bool
 151 isEmptyCoreRules (Rules rs _) = null rs
 152
 153 rulesRhsFreeVars :: CoreRules -> VarSet
 154 rulesRhsFreeVars (Rules _ fvs) = fvs
 155
 156 rulesRules :: CoreRules -> [CoreRule]
 157 rulesRules (Rules rules _) = rules
 158 \end{code}
 159
 160 \begin{code}
 161 type RuleName = FAST_STRING
 162 type IdCoreRule = (Id,CoreRule)         -- Rules don't have their leading Id inside them
 163
 164 data CoreRule
 165   = Rule RuleName
 166          [CoreBndr]     -- Forall'd variables
 167          [CoreExpr]     -- LHS args
 168          CoreExpr       -- RHS
 169
 170   | BuiltinRule         -- Built-in rules are used for constant folding
 171                         -- and suchlike.  It has no free variables.
 172         ([CoreExpr] -> Maybe (RuleName, CoreExpr))
 173
 174 isBuiltinRule (BuiltinRule _) = True
 175 isBuiltinRule _               = False
 176 \end{code}
 177
 178
 179 %************************************************************************
 180 %*                                                                      *
 181 \subsection{@Unfolding@ type}
 182 %*                                                                      *
 183 %************************************************************************
 184
 185 The @Unfolding@ type is declared here to avoid numerous loops, but it
 186 should be abstract everywhere except in CoreUnfold.lhs
 187
 188 \begin{code}
 189 data Unfolding
 190   = NoUnfolding
 191
 192   | OtherCon [AltCon]           -- It ain't one of these
 193                                 -- (OtherCon xs) also indicates that something has been evaluated
 194                                 -- and hence there's no point in re-evaluating it.
 195                                 -- OtherCon [] is used even for non-data-type values
 196                                 -- to indicated evaluated-ness.  Notably:
 197                                 --      data C = C !(Int -> Int)
 198                                 --      case x of { C f -> ... }
 199                                 -- Here, f gets an OtherCon [] unfolding.
 200
 201   | CompulsoryUnfolding CoreExpr        -- There is no "original" definition,
 202                                         -- so you'd better unfold.
 203
 204   | CoreUnfolding                       -- An unfolding with redundant cached information
 205                 CoreExpr                -- Template; binder-info is correct
 206                 Bool                    -- True <=> top level binding
 207                 Bool                    -- exprIsValue template (cached); it is ok to discard a `seq` on
 208                                         --      this variable
 209                 Bool                    -- True <=> doesn't waste (much) work to expand inside an inlining
 210                                         --      Basically it's exprIsCheap
 211                 UnfoldingGuidance       -- Tells about the *size* of the template.
 212
 213
 214 data UnfoldingGuidance
 215   = UnfoldNever
 216   | UnfoldIfGoodArgs    Int     -- and "n" value args
 217
 218                         [Int]   -- Discount if the argument is evaluated.
 219                                 -- (i.e., a simplification will definitely
 220                                 -- be possible).  One elt of the list per *value* arg.
 221
 222                         Int     -- The "size" of the unfolding; to be elaborated
 223                                 -- later. ToDo
 224
 225                         Int     -- Scrutinee discount: the discount to substract if the thing is in
 226                                 -- a context (case (thing args) of ...),
 227                                 -- (where there are the right number of arguments.)
 228
 229 noUnfolding = NoUnfolding
 230 mkOtherCon  = OtherCon
 231
 232 seqUnfolding :: Unfolding -> ()
 233 seqUnfolding (CoreUnfolding e top b1 b2 g)
 234   = seqExpr e `seq` top `seq` b1 `seq` b2 `seq` seqGuidance g
 235 seqUnfolding other = ()
 236
 237 seqGuidance (UnfoldIfGoodArgs n ns a b) = n `seq` sum ns `seq` a `seq` b `seq` ()
 238 seqGuidance other                       = ()
 239 \end{code}
 240
 241 \begin{code}
 242 unfoldingTemplate :: Unfolding -> CoreExpr
 243 unfoldingTemplate (CoreUnfolding expr _ _ _ _) = expr
 244 unfoldingTemplate (CompulsoryUnfolding expr)   = expr
 245 unfoldingTemplate other = panic "getUnfoldingTemplate"
 246
 247 maybeUnfoldingTemplate :: Unfolding -> Maybe CoreExpr
 248 maybeUnfoldingTemplate (CoreUnfolding expr _ _ _ _) = Just expr
 249 maybeUnfoldingTemplate (CompulsoryUnfolding expr)   = Just expr
 250 maybeUnfoldingTemplate other                        = Nothing
 251
 252 otherCons :: Unfolding -> [AltCon]
 253 otherCons (OtherCon cons) = cons
 254 otherCons other           = []
 255
 256 isValueUnfolding :: Unfolding -> Bool
 257         -- Returns False for OtherCon
 258 isValueUnfolding (CoreUnfolding _ _ is_evald _ _) = is_evald
 259 isValueUnfolding other                            = False
 260
 261 isEvaldUnfolding :: Unfolding -> Bool
 262         -- Returns True for OtherCon
 263 isEvaldUnfolding (OtherCon _)                     = True
 264 isEvaldUnfolding (CoreUnfolding _ _ is_evald _ _) = is_evald
 265 isEvaldUnfolding other                            = False
 266
 267 isCheapUnfolding :: Unfolding -> Bool
 268 isCheapUnfolding (CoreUnfolding _ _ _ is_cheap _) = is_cheap
 269 isCheapUnfolding other                            = False
 270
 271 isCompulsoryUnfolding :: Unfolding -> Bool
 272 isCompulsoryUnfolding (CompulsoryUnfolding _) = True
 273 isCompulsoryUnfolding other                   = False
 274
 275 hasUnfolding :: Unfolding -> Bool
 276 hasUnfolding (CoreUnfolding _ _ _ _ _) = True
 277 hasUnfolding (CompulsoryUnfolding _)   = True
 278 hasUnfolding other                     = False
 279
 280 hasSomeUnfolding :: Unfolding -> Bool
 281 hasSomeUnfolding NoUnfolding = False
 282 hasSomeUnfolding other       = True
 283
 284 neverUnfold :: Unfolding -> Bool
 285 neverUnfold NoUnfolding                         = True
 286 neverUnfold (OtherCon _)                        = True
 287 neverUnfold (CoreUnfolding _ _ _ _ UnfoldNever) = True
 288 neverUnfold other                               = False
 289 \end{code}
 290
 291
 292 %************************************************************************
 293 %*                                                                      *
 294 \subsection{The main data type}
 295 %*                                                                      *
 296 %************************************************************************
 297
 298 \begin{code}
 299 -- The Ord is needed for the FiniteMap used in the lookForConstructor
 300 -- in SimplEnv.  If you declared that lookForConstructor *ignores*
 301 -- constructor-applications with LitArg args, then you could get
 302 -- rid of this Ord.
 303
 304 instance Outputable AltCon where
 305   ppr (DataAlt dc) = ppr dc
 306   ppr (LitAlt lit) = ppr lit
 307   ppr DEFAULT      = ptext SLIT("__DEFAULT")
 308
 309 instance Show AltCon where
 310   showsPrec p con = showsPrecSDoc p (ppr con)
 311 \end{code}
 312
 313
 314 %************************************************************************
 315 %*                                                                      *
 316 \subsection{Useful synonyms}
 317 %*                                                                      *
 318 %************************************************************************
 319
 320 The common case
 321
 322 \begin{code}
 323 type CoreBndr = Var
 324 type CoreExpr = Expr CoreBndr
 325 type CoreArg  = Arg  CoreBndr
 326 type CoreBind = Bind CoreBndr
 327 type CoreAlt  = Alt  CoreBndr
 328 \end{code}
 329
 330 Binders are ``tagged'' with a \tr{t}:
 331
 332 \begin{code}
 333 type Tagged t = (CoreBndr, t)
 334
 335 type TaggedBind t = Bind (Tagged t)
 336 type TaggedExpr t = Expr (Tagged t)
 337 type TaggedArg  t = Arg  (Tagged t)
 338 type TaggedAlt  t = Alt  (Tagged t)
 339 \end{code}
 340
 341
 342 %************************************************************************
 343 %*                                                                      *
 344 \subsection{Core-constructing functions with checking}
 345 %*                                                                      *
 346 %************************************************************************
 347
 348 \begin{code}
 349 mkApps    :: Expr b -> [Arg b]  -> Expr b
 350 mkTyApps  :: Expr b -> [Type]   -> Expr b
 351 mkValApps :: Expr b -> [Expr b] -> Expr b
 352 mkVarApps :: Expr b -> [Var] -> Expr b
 353
 354 mkApps    f args = foldl App                       f args
 355 mkTyApps  f args = foldl (\ e a -> App e (Type a)) f args
 356 mkValApps f args = foldl (\ e a -> App e a)        f args
 357 mkVarApps f vars = foldl (\ e a -> App e (varToCoreExpr a)) f vars
 358
 359 mkLit         :: Literal -> Expr b
 360 mkIntLit      :: Integer -> Expr b
 361 mkIntLitInt   :: Int     -> Expr b
 362 mkConApp      :: DataCon -> [Arg b] -> Expr b
 363 mkLets        :: [Bind b] -> Expr b -> Expr b
 364 mkLams        :: [b] -> Expr b -> Expr b
 365
 366 mkLit lit         = Lit lit
 367 mkConApp con args = mkApps (Var (dataConId con)) args
 368
 369 mkLams binders body = foldr Lam body binders
 370 mkLets binds body   = foldr Let body binds
 371
 372 mkIntLit    n = Lit (mkMachInt n)
 373 mkIntLitInt n = Lit (mkMachInt (toInteger n))
 374
 375 varToCoreExpr :: CoreBndr -> Expr b
 376 varToCoreExpr v | isId v    = Var v
 377                 | otherwise = Type (mkTyVarTy v)
 378 \end{code}
 379
 380
 381 %************************************************************************
 382 %*                                                                      *
 383 \subsection{Simple access functions}
 384 %*                                                                      *
 385 %************************************************************************
 386
 387 \begin{code}
 388 bindersOf  :: Bind b -> [b]
 389 bindersOf (NonRec binder _) = [binder]
 390 bindersOf (Rec pairs)       = [binder | (binder, _) <- pairs]
 391
 392 bindersOfBinds :: [Bind b] -> [b]
 393 bindersOfBinds binds = foldr ((++) . bindersOf) [] binds
 394
 395 rhssOfBind :: Bind b -> [Expr b]
 396 rhssOfBind (NonRec _ rhs) = [rhs]
 397 rhssOfBind (Rec pairs)    = [rhs | (_,rhs) <- pairs]
 398
 399 rhssOfAlts :: [Alt b] -> [Expr b]
 400 rhssOfAlts alts = [e | (_,_,e) <- alts]
 401
 402 flattenBinds :: [Bind b] -> [(b, Expr b)]       -- Get all the lhs/rhs pairs
 403 flattenBinds (NonRec b r : binds) = (b,r) : flattenBinds binds
 404 flattenBinds (Rec prs1   : binds) = prs1 ++ flattenBinds binds
 405 flattenBinds []                   = []
 406 \end{code}
 407
 408 We often want to strip off leading lambdas before getting down to
 409 business.  @collectBinders@ is your friend.
 410
 411 We expect (by convention) type-, and value- lambdas in that
 412 order.
 413
 414 \begin{code}
 415 collectBinders               :: Expr b -> ([b],         Expr b)
 416 collectBindersIgnoringNotes  :: Expr b -> ([b],         Expr b)
 417 collectTyBinders             :: CoreExpr -> ([TyVar],     CoreExpr)
 418 collectValBinders            :: CoreExpr -> ([Id],        CoreExpr)
 419 collectTyAndValBinders       :: CoreExpr -> ([TyVar], [Id], CoreExpr)
 420
 421 collectBinders expr
 422   = go [] expr
 423   where
 424     go bs (Lam b e) = go (b:bs) e
 425     go bs e          = (reverse bs, e)
 426
 427 -- This one ignores notes.  It's used in CoreUnfold and StrAnal
 428 -- when we aren't going to put the expression back together from
 429 -- the pieces, so we don't mind losing the Notes
 430 collectBindersIgnoringNotes expr
 431   = go [] expr
 432   where
 433     go bs (Lam b e)  = go (b:bs) e
 434     go bs (Note _ e) = go    bs  e
 435     go bs e          = (reverse bs, e)
 436
 437 collectTyAndValBinders expr
 438   = (tvs, ids, body)
 439   where
 440     (tvs, body1) = collectTyBinders expr
 441     (ids, body)  = collectValBinders body1
 442
 443 collectTyBinders expr
 444   = go [] expr
 445   where
 446     go tvs (Lam b e) | isTyVar b = go (b:tvs) e
 447     go tvs e                     = (reverse tvs, e)
 448
 449 collectValBinders expr
 450   = go [] expr
 451   where
 452     go ids (Lam b e) | isId b = go (b:ids) e
 453     go ids body               = (reverse ids, body)
 454 \end{code}
 455
 456
 457 @collectArgs@ takes an application expression, returning the function
 458 and the arguments to which it is applied.
 459
 460 \begin{code}
 461 collectArgs :: Expr b -> (Expr b, [Arg b])
 462 collectArgs expr
 463   = go expr []
 464   where
 465     go (App f a) as = go f (a:as)
 466     go e         as = (e, as)
 467 \end{code}
 468
 469 coreExprCc gets the cost centre enclosing an expression, if any.
 470 It looks inside lambdas because (scc "foo" \x.e) = \x.scc "foo" e
 471
 472 \begin{code}
 473 coreExprCc :: Expr b -> CostCentre
 474 coreExprCc (Note (SCC cc) e)   = cc
 475 coreExprCc (Note other_note e) = coreExprCc e
 476 coreExprCc (Lam _ e)           = coreExprCc e
 477 coreExprCc other               = noCostCentre
 478 \end{code}
 479
 480
 481 %************************************************************************
 482 %*                                                                      *
 483 \subsection{Predicates}
 484 %*                                                                      *
 485 %************************************************************************
 486
 487 \begin{code}
 488 isValArg (Type _) = False
 489 isValArg other    = True
 490
 491 isTypeArg (Type _) = True
 492 isTypeArg other    = False
 493
 494 valBndrCount :: [CoreBndr] -> Int
 495 valBndrCount []                   = 0
 496 valBndrCount (b : bs) | isId b    = 1 + valBndrCount bs
 497                       | otherwise = valBndrCount bs
 498
 499 valArgCount :: [Arg b] -> Int
 500 valArgCount []              = 0
 501 valArgCount (Type _ : args) = valArgCount args
 502 valArgCount (other  : args) = 1 + valArgCount args
 503 \end{code}
 504
 505
 506 %************************************************************************
 507 %*                                                                      *
 508 \subsection{Seq stuff}
 509 %*                                                                      *
 510 %************************************************************************
 511
 512 \begin{code}
 513 seqExpr :: CoreExpr -> ()
 514 seqExpr (Var v)       = v `seq` ()
 515 seqExpr (Lit lit)     = lit `seq` ()
 516 seqExpr (App f a)     = seqExpr f `seq` seqExpr a
 517 seqExpr (Lam b e)     = seqBndr b `seq` seqExpr e
 518 seqExpr (Let b e)     = seqBind b `seq` seqExpr e
 519 seqExpr (Case e b as) = seqExpr e `seq` seqBndr b `seq` seqAlts as
 520 seqExpr (Note n e)    = seqNote n `seq` seqExpr e
 521 seqExpr (Type t)      = seqType t
 522
 523 seqExprs [] = ()
 524 seqExprs (e:es) = seqExpr e `seq` seqExprs es
 525
 526 seqNote (Coerce t1 t2) = seqType t1 `seq` seqType t2
 527 seqNote other          = ()
 528
 529 seqBndr b = b `seq` ()
 530
 531 seqBndrs [] = ()
 532 seqBndrs (b:bs) = seqBndr b `seq` seqBndrs bs
 533
 534 seqBind (NonRec b e) = seqBndr b `seq` seqExpr e
 535 seqBind (Rec prs)    = seqPairs prs
 536
 537 seqPairs [] = ()
 538 seqPairs ((b,e):prs) = seqBndr b `seq` seqExpr e `seq` seqPairs prs
 539
 540 seqAlts [] = ()
 541 seqAlts ((c,bs,e):alts) = seqBndrs bs `seq` seqExpr e `seq` seqAlts alts
 542
 543 seqRules :: CoreRules -> ()
 544 seqRules (Rules rules fvs) = seq_rules rules `seq` seqVarSet fvs
 545
 546 seq_rules [] = ()
 547 seq_rules (Rule fs bs es e : rules) = seqBndrs bs `seq` seqExprs (e:es) `seq` seq_rules rules
 548 seq_rules (BuiltinRule _ : rules) = seq_rules rules
 549 \end{code}
 550
 551
 552
 553 %************************************************************************
 554 %*                                                                      *
 555 \subsection{Annotated core; annotation at every node in the tree}
 556 %*                                                                      *
 557 %************************************************************************
 558
 559 \begin{code}
 560 type AnnExpr bndr annot = (annot, AnnExpr' bndr annot)
 561
 562 data AnnExpr' bndr annot
 563   = AnnVar      Id
 564   | AnnLit      Literal
 565   | AnnLam      bndr (AnnExpr bndr annot)
 566   | AnnApp      (AnnExpr bndr annot) (AnnExpr bndr annot)
 567   | AnnCase     (AnnExpr bndr annot) bndr [AnnAlt bndr annot]
 568   | AnnLet      (AnnBind bndr annot) (AnnExpr bndr annot)
 569   | AnnNote     Note (AnnExpr bndr annot)
 570   | AnnType     Type
 571
 572 type AnnAlt bndr annot = (AltCon, [bndr], AnnExpr bndr annot)
 573
 574 data AnnBind bndr annot
 575   = AnnNonRec bndr (AnnExpr bndr annot)
 576   | AnnRec    [(bndr, AnnExpr bndr annot)]
 577 \end{code}
 578
 579 \begin{code}
 580 deAnnotate :: AnnExpr bndr annot -> Expr bndr
 581 deAnnotate (_, e) = deAnnotate' e
 582
 583 deAnnotate' (AnnType t)           = Type t
 584 deAnnotate' (AnnVar  v)           = Var v
 585 deAnnotate' (AnnLit  lit)         = Lit lit
 586 deAnnotate' (AnnLam  binder body) = Lam binder (deAnnotate body)
 587 deAnnotate' (AnnApp  fun arg)     = App (deAnnotate fun) (deAnnotate arg)
 588 deAnnotate' (AnnNote note body)   = Note note (deAnnotate body)
 589
 590 deAnnotate' (AnnLet bind body)
 591   = Let (deAnnBind bind) (deAnnotate body)
 592   where
 593     deAnnBind (AnnNonRec var rhs) = NonRec var (deAnnotate rhs)
 594     deAnnBind (AnnRec pairs) = Rec [(v,deAnnotate rhs) | (v,rhs) <- pairs]
 595
 596 deAnnotate' (AnnCase scrut v alts)
 597   = Case (deAnnotate scrut) v (map deAnnAlt alts)
 598   where
 599     deAnnAlt (con,args,rhs) = (con,args,deAnnotate rhs)
 600 \end{code}
 601