compiler/coreSyn/CoreSyn.lhs

   1 %
   2 % (c) The University of Glasgow 2006
   3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   4 %
   5
   6 \begin{code}
   7
   8 -- | CoreSyn holds all the main data types for use by for the Glasgow Haskell Compiler midsection
   9 module CoreSyn (
  10         -- * Main data types
  11         Expr(..), Alt, Bind(..), AltCon(..), Arg, Note(..),
  12         CoreExpr, CoreAlt, CoreBind, CoreArg, CoreBndr,
  13         TaggedExpr, TaggedAlt, TaggedBind, TaggedArg, TaggedBndr(..),
  14
  15         -- ** 'Expr' construction
  16         mkLets, mkLams,
  17         mkApps, mkTyApps, mkVarApps,
  18
  19         mkIntLit, mkIntLitInt,
  20         mkWordLit, mkWordLitWord,
  21         mkCharLit, mkStringLit,
  22         mkFloatLit, mkFloatLitFloat,
  23         mkDoubleLit, mkDoubleLitDouble,
  24
  25         mkConApp, mkTyBind,
  26         varToCoreExpr, varsToCoreExprs,
  27
  28         isTyVar, isId, cmpAltCon, cmpAlt, ltAlt,
  29
  30         -- ** Simple 'Expr' access functions and predicates
  31         bindersOf, bindersOfBinds, rhssOfBind, rhssOfAlts,
  32         collectBinders, collectTyBinders, collectValBinders, collectTyAndValBinders,
  33         collectArgs, coreExprCc, flattenBinds,
  34
  35         isValArg, isTypeArg, valArgCount, valBndrCount, isRuntimeArg, isRuntimeVar,
  36
  37         -- * Unfolding data types
  38         Unfolding(..),  UnfoldingGuidance(..), InlineRuleInfo(..), InlSatFlag(..),
  39                 -- Abstract everywhere but in CoreUnfold.lhs
  40
  41         -- ** Constructing 'Unfolding's
  42         noUnfolding, evaldUnfolding, mkOtherCon,
  43
  44         -- ** Predicates and deconstruction on 'Unfolding'
  45         unfoldingTemplate, setUnfoldingTemplate,
  46         maybeUnfoldingTemplate, otherCons, unfoldingArity,
  47         isValueUnfolding, isEvaldUnfolding, isCheapUnfolding,
  48         isExpandableUnfolding, isConLikeUnfolding,
  49         isInlineRule, isInlineRule_maybe, isClosedUnfolding, hasSomeUnfolding,
  50         isStableUnfolding, canUnfold, neverUnfoldGuidance,
  51
  52         -- * Strictness
  53         seqExpr, seqExprs, seqUnfolding,
  54
  55         -- * Annotated expression data types
  56         AnnExpr, AnnExpr'(..), AnnBind(..), AnnAlt,
  57
  58         -- ** Operations on annotations
  59         deAnnotate, deAnnotate', deAnnAlt, collectAnnBndrs,
  60
  61         -- * Core rule data types
  62         CoreRule(..),   -- CoreSubst, CoreTidy, CoreFVs, PprCore only
  63         RuleName,
  64
  65         -- ** Operations on 'CoreRule's
  66         seqRules, ruleArity, ruleName, ruleIdName, ruleActivation_maybe,
  67         setRuleIdName,
  68         isBuiltinRule, isLocalRule
  69     ) where
  70
  71 #include "HsVersions.h"
  72
  73 import CostCentre
  74 import Var
  75 import Type
  76 import Coercion
  77 import Name
  78 import Literal
  79 import DataCon
  80 import BasicTypes
  81 import FastString
  82 import Outputable
  83 import Util
  84
  85 import Data.Word
  86
  87 infixl 4 `mkApps`, `mkTyApps`, `mkVarApps`
  88 -- Left associative, so that we can say (f `mkTyApps` xs `mkVarApps` ys)
  89 \end{code}
  90
  91 %************************************************************************
  92 %*                                                                      *
  93 \subsection{The main data types}
  94 %*                                                                      *
  95 %************************************************************************
  96
  97 These data types are the heart of the compiler
  98
  99 \begin{code}
 100 infixl 8 `App`  -- App brackets to the left
 101
 102 -- | This is the data type that represents GHCs core intermediate language. Currently
 103 -- GHC uses System FC <http://research.microsoft.com/~simonpj/papers/ext-f/> for this purpose,
 104 -- which is closely related to the simpler and better known System F <http://en.wikipedia.org/wiki/System_F>.
 105 --
 106 -- We get from Haskell source to this Core language in a number of stages:
 107 --
 108 -- 1. The source code is parsed into an abstract syntax tree, which is represented
 109 --    by the data type 'HsExpr.HsExpr' with the names being 'RdrName.RdrNames'
 110 --
 111 -- 2. This syntax tree is /renamed/, which attaches a 'Unique.Unique' to every 'RdrName.RdrName'
 112 --    (yielding a 'Name.Name') to disambiguate identifiers which are lexically identical.
 113 --    For example, this program:
 114 --
 115 -- @
 116 --      f x = let f x = x + 1
 117 --            in f (x - 2)
 118 -- @
 119 --
 120 --    Would be renamed by having 'Unique's attached so it looked something like this:
 121 --
 122 -- @
 123 --      f_1 x_2 = let f_3 x_4 = x_4 + 1
 124 --                in f_3 (x_2 - 2)
 125 -- @
 126 --
 127 -- 3. The resulting syntax tree undergoes type checking (which also deals with instantiating
 128 --    type class arguments) to yield a 'HsExpr.HsExpr' type that has 'Id.Id' as it's names.
 129 --
 130 -- 4. Finally the syntax tree is /desugared/ from the expressive 'HsExpr.HsExpr' type into
 131 --    this 'Expr' type, which has far fewer constructors and hence is easier to perform
 132 --    optimization, analysis and code generation on.
 133 --
 134 -- The type parameter @b@ is for the type of binders in the expression tree.
 135 data Expr b
 136   = Var   Id                            -- ^ Variables
 137   | Lit   Literal                       -- ^ Primitive literals
 138   | App   (Expr b) (Arg b)              -- ^ Applications: note that the argument may be a 'Type'.
 139                                         --
 140                                         -- See "CoreSyn#let_app_invariant" for another invariant
 141   | Lam   b (Expr b)                    -- ^ Lambda abstraction
 142   | Let   (Bind b) (Expr b)             -- ^ Recursive and non recursive @let@s. Operationally
 143                                         -- this corresponds to allocating a thunk for the things
 144                                         -- bound and then executing the sub-expression.
 145                                         --
 146                                         -- #top_level_invariant#
 147                                         -- #letrec_invariant#
 148                                         --
 149                                         -- The right hand sides of all top-level and recursive @let@s
 150                                         -- /must/ be of lifted type (see "Type#type_classification" for
 151                                         -- the meaning of /lifted/ vs. /unlifted/).
 152                                         --
 153                                         -- #let_app_invariant#
 154                                         -- The right hand side of of a non-recursive 'Let' _and_ the argument of an 'App',
 155                                         -- /may/ be of unlifted type, but only if the expression
 156                                         -- is ok-for-speculation.  This means that the let can be floated around
 157                                         -- without difficulty. For example, this is OK:
 158                                         --
 159                                         -- > y::Int# = x +# 1#
 160                                         --
 161                                         -- But this is not, as it may affect termination if the expression is floated out:
 162                                         --
 163                                         -- > y::Int# = fac 4#
 164                                         --
 165                                         -- In this situation you should use @case@ rather than a @let@. The function
 166                                         -- 'CoreUtils.needsCaseBinding' can help you determine which to generate, or
 167                                         -- alternatively use 'MkCore.mkCoreLet' rather than this constructor directly,
 168                                         -- which will generate a @case@ if necessary
 169                                         --
 170                                         -- #type_let#
 171                                         -- We allow a /non-recursive/ let to bind a type variable, thus:
 172                                         --
 173                                         -- > Let (NonRec tv (Type ty)) body
 174                                         --
 175                                         -- This can be very convenient for postponing type substitutions until
 176                                         -- the next run of the simplifier.
 177                                         --
 178                                         -- At the moment, the rest of the compiler only deals with type-let
 179                                         -- in a Let expression, rather than at top level.  We may want to revist
 180                                         -- this choice.
 181   | Case  (Expr b) b Type [Alt b]       -- ^ Case split. Operationally this corresponds to evaluating
 182                                         -- the scrutinee (expression examined) to weak head normal form
 183                                         -- and then examining at most one level of resulting constructor (i.e. you
 184                                         -- cannot do nested pattern matching directly with this).
 185                                         --
 186                                         -- The binder gets bound to the value of the scrutinee,
 187                                         -- and the 'Type' must be that of all the case alternatives
 188                                         --
 189                                         -- #case_invariants#
 190                                         -- This is one of the more complicated elements of the Core language, and comes
 191                                         -- with a number of restrictions:
 192                                         --
 193                                         -- The 'DEFAULT' case alternative must be first in the list, if it occurs at all.
 194                                         --
 195                                         -- The remaining cases are in order of increasing
 196                                         --      tag     (for 'DataAlts') or
 197                                         --      lit     (for 'LitAlts').
 198                                         -- This makes finding the relevant constructor easy, and makes comparison easier too.
 199                                         --
 200                                         -- The list of alternatives must be exhaustive. An /exhaustive/ case
 201                                         -- does not necessarily mention all constructors:
 202                                         --
 203                                         -- @
 204                                         --      data Foo = Red | Green | Blue
 205                                         -- ... case x of
 206                                         --      Red   -> True
 207                                         --      other -> f (case x of
 208                                         --                      Green -> ...
 209                                         --                      Blue  -> ... ) ...
 210                                         -- @
 211                                         --
 212                                         -- The inner case does not need a @Red@ alternative, because @x@ can't be @Red@ at
 213                                         -- that program point.
 214   | Cast  (Expr b) Coercion             -- ^ Cast an expression to a particular type. This is used to implement @newtype@s
 215                                         -- (a @newtype@ constructor or destructor just becomes a 'Cast' in Core) and GADTs.
 216   | Note  Note (Expr b)                 -- ^ Notes. These allow general information to be
 217                                         -- added to expressions in the syntax tree
 218   | Type  Type                          -- ^ A type: this should only show up at the top
 219                                         -- level of an Arg
 220
 221 -- | Type synonym for expressions that occur in function argument positions.
 222 -- Only 'Arg' should contain a 'Type' at top level, general 'Expr' should not
 223 type Arg b = Expr b
 224
 225 -- | A case split alternative. Consists of the constructor leading to the alternative,
 226 -- the variables bound from the constructor, and the expression to be executed given that binding.
 227 -- The default alternative is @(DEFAULT, [], rhs)@
 228 type Alt b = (AltCon, [b], Expr b)
 229
 230 -- | A case alternative constructor (i.e. pattern match)
 231 data AltCon = DataAlt DataCon   -- ^ A plain data constructor: @case e of { Foo x -> ... }@.
 232                                 -- Invariant: the 'DataCon' is always from a @data@ type, and never from a @newtype@
 233             | LitAlt  Literal   -- ^ A literal: @case e of { 1 -> ... }@
 234             | DEFAULT           -- ^ Trivial alternative: @case e of { _ -> ... }@
 235          deriving (Eq, Ord)
 236
 237 -- | Binding, used for top level bindings in a module and local bindings in a @let@.
 238 data Bind b = NonRec b (Expr b)
 239             | Rec [(b, (Expr b))]
 240 \end{code}
 241
 242 -------------------------- CoreSyn INVARIANTS ---------------------------
 243
 244 Note [CoreSyn top-level invariant]
 245 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 246 See #toplevel_invariant#
 247
 248 Note [CoreSyn letrec invariant]
 249 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 250 See #letrec_invariant#
 251
 252 Note [CoreSyn let/app invariant]
 253 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 254 See #let_app_invariant#
 255
 256 This is intially enforced by DsUtils.mkCoreLet and mkCoreApp
 257
 258 Note [CoreSyn case invariants]
 259 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 260 See #case_invariants#
 261
 262 Note [CoreSyn let goal]
 263 ~~~~~~~~~~~~~~~~~~~~~~~
 264 * The simplifier tries to ensure that if the RHS of a let is a constructor
 265   application, its arguments are trivial, so that the constructor can be
 266   inlined vigorously.
 267
 268
 269 Note [Type let]
 270 ~~~~~~~~~~~~~~~
 271 See #type_let#
 272
 273 \begin{code}
 274
 275 -- | Allows attaching extra information to points in expressions rather than e.g. identifiers.
 276 data Note
 277   = SCC CostCentre      -- ^ A cost centre annotation for profiling
 278   | CoreNote String     -- ^ A generic core annotation, propagated but not used by GHC
 279 \end{code}
 280
 281
 282 %************************************************************************
 283 %*                                                                      *
 284 \subsection{Transformation rules}
 285 %*                                                                      *
 286 %************************************************************************
 287
 288 The CoreRule type and its friends are dealt with mainly in CoreRules,
 289 but CoreFVs, Subst, PprCore, CoreTidy also inspect the representation.
 290
 291 \begin{code}
 292 -- | A 'CoreRule' is:
 293 --
 294 -- * \"Local\" if the function it is a rule for is defined in the
 295 --   same module as the rule itself.
 296 --
 297 -- * \"Orphan\" if nothing on the LHS is defined in the same module
 298 --   as the rule itself
 299 data CoreRule
 300   = Rule {
 301         ru_name :: RuleName,            -- ^ Name of the rule, for communication with the user
 302         ru_act  :: Activation,          -- ^ When the rule is active
 303
 304         -- Rough-matching stuff
 305         -- see comments with InstEnv.Instance( is_cls, is_rough )
 306         ru_fn    :: Name,               -- ^ Name of the 'Id.Id' at the head of this rule
 307         ru_rough :: [Maybe Name],       -- ^ Name at the head of each argument to the left hand side
 308
 309         -- Proper-matching stuff
 310         -- see comments with InstEnv.Instance( is_tvs, is_tys )
 311         ru_bndrs :: [CoreBndr],         -- ^ Variables quantified over
 312         ru_args  :: [CoreExpr],         -- ^ Left hand side arguments
 313
 314         -- And the right-hand side
 315         ru_rhs   :: CoreExpr,           -- ^ Right hand side of the rule
 316                                         -- Occurrence info is guaranteed correct
 317                                         -- See Note [OccInfo in unfoldings and rules]
 318
 319         -- Locality
 320         ru_local :: Bool        -- ^ @True@ iff the fn at the head of the rule is
 321                                 -- defined in the same module as the rule
 322                                 -- and is not an implicit 'Id' (like a record selector,
 323                                 -- class operation, or data constructor)
 324
 325                 -- NB: ru_local is *not* used to decide orphan-hood
 326                 --      c.g. MkIface.coreRuleToIfaceRule
 327     }
 328
 329   -- | Built-in rules are used for constant folding
 330   -- and suchlike.  They have no free variables.
 331   | BuiltinRule {
 332         ru_name  :: RuleName,   -- ^ As above
 333         ru_fn    :: Name,       -- ^ As above
 334         ru_nargs :: Int,        -- ^ Number of arguments that 'ru_try' consumes,
 335                                 -- if it fires, including type arguments
 336         ru_try  :: [CoreExpr] -> Maybe CoreExpr
 337                 -- ^ This function does the rewrite.  It given too many
 338                 -- arguments, it simply discards them; the returned 'CoreExpr'
 339                 -- is just the rewrite of 'ru_fn' applied to the first 'ru_nargs' args
 340     }
 341                 -- See Note [Extra args in rule matching] in Rules.lhs
 342
 343 isBuiltinRule :: CoreRule -> Bool
 344 isBuiltinRule (BuiltinRule {}) = True
 345 isBuiltinRule _                = False
 346
 347 -- | The number of arguments the 'ru_fn' must be applied
 348 -- to before the rule can match on it
 349 ruleArity :: CoreRule -> Int
 350 ruleArity (BuiltinRule {ru_nargs = n}) = n
 351 ruleArity (Rule {ru_args = args})      = length args
 352
 353 ruleName :: CoreRule -> RuleName
 354 ruleName = ru_name
 355
 356 ruleActivation_maybe :: CoreRule -> Maybe Activation
 357 ruleActivation_maybe (BuiltinRule { })       = Nothing
 358 ruleActivation_maybe (Rule { ru_act = act }) = Just act
 359
 360 -- | The 'Name' of the 'Id.Id' at the head of the rule left hand side
 361 ruleIdName :: CoreRule -> Name
 362 ruleIdName = ru_fn
 363
 364 isLocalRule :: CoreRule -> Bool
 365 isLocalRule = ru_local
 366
 367 -- | Set the 'Name' of the 'Id.Id' at the head of the rule left hand side
 368 setRuleIdName :: Name -> CoreRule -> CoreRule
 369 setRuleIdName nm ru = ru { ru_fn = nm }
 370 \end{code}
 371
 372
 373 %************************************************************************
 374 %*                                                                      *
 375                 Unfoldings
 376 %*                                                                      *
 377 %************************************************************************
 378
 379 The @Unfolding@ type is declared here to avoid numerous loops
 380
 381 \begin{code}
 382 -- | Records the /unfolding/ of an identifier, which is approximately the form the
 383 -- identifier would have if we substituted its definition in for the identifier.
 384 -- This type should be treated as abstract everywhere except in "CoreUnfold"
 385 data Unfolding
 386   = NoUnfolding        -- ^ We have no information about the unfolding
 387
 388   | OtherCon [AltCon]  -- ^ It ain't one of these constructors.
 389                        -- @OtherCon xs@ also indicates that something has been evaluated
 390                        -- and hence there's no point in re-evaluating it.
 391                        -- @OtherCon []@ is used even for non-data-type values
 392                        -- to indicated evaluated-ness.  Notably:
 393                        --
 394                        -- > data C = C !(Int -> Int)
 395                        -- > case x of { C f -> ... }
 396                        --
 397                        -- Here, @f@ gets an @OtherCon []@ unfolding.
 398
 399   | DFunUnfolding DataCon [CoreExpr]
 400                         -- The Unfolding of a DFunId
 401                         --     df = /\a1..am. \d1..dn. MkD (op1 a1..am d1..dn)
 402                         --                                 (op2 a1..am d1..dn)
 403                         -- where Arity = n, the number of dict args to the dfun
 404                         -- The [CoreExpr] are the superclasses and methods [op1,op2],
 405                         -- in positional order.
 406                         -- They are usually variables, but can be trivial expressions
 407                         -- instead (e.g. a type application).
 408
 409   | CoreUnfolding {             -- An unfolding for an Id with no pragma, or perhaps a NOINLINE pragma
 410                                 -- (For NOINLINE, the phase, if any, is in the InlinePragInfo for this Id.)
 411         uf_tmpl       :: CoreExpr,      -- Template; occurrence info is correct
 412         uf_arity      :: Arity,         -- Number of value arguments expected
 413         uf_is_top     :: Bool,          -- True <=> top level binding
 414         uf_is_value   :: Bool,          -- exprIsHNF template (cached); it is ok to discard a `seq` on
 415                                         --      this variable
 416         uf_is_conlike :: Bool,          -- True <=> application of constructor or CONLIKE function
 417                                         --      Cached version of exprIsConLike
 418         uf_is_cheap   :: Bool,          -- True <=> doesn't waste (much) work to expand inside an inlining
 419                                         --      Cached version of exprIsCheap
 420         uf_expandable :: Bool,          -- True <=> can expand in RULE matching
 421                                         --      Cached version of exprIsExpandable
 422         uf_guidance   :: UnfoldingGuidance      -- Tells about the *size* of the template.
 423     }
 424   -- ^ An unfolding with redundant cached information. Parameters:
 425   --
 426   --  uf_tmpl: Template used to perform unfolding;
 427   --           NB: Occurrence info is guaranteed correct:
 428   --               see Note [OccInfo in unfoldings and rules]
 429   --
 430   --  uf_is_top: Is this a top level binding?
 431   --
 432   --  uf_is_value: 'exprIsHNF' template (cached); it is ok to discard a 'seq' on
 433   --     this variable
 434   --
 435   --  uf_is_cheap:  Does this waste only a little work if we expand it inside an inlining?
 436   --     Basically this is a cached version of 'exprIsCheap'
 437   --
 438   --  uf_guidance:  Tells us about the /size/ of the unfolding template
 439
 440 ------------------------------------------------
 441 -- | 'UnfoldingGuidance' says when unfolding should take place
 442 data UnfoldingGuidance
 443   = InlineRule {        -- Be very keen to inline this; See Note [InlineRules]
 444                         -- The uf_tmpl is the *original* RHS; do *not* replace it on
 445                         --   each simlifier run.  Hence, the *actual* RHS of the function
 446                         --   may be different by now, because it may have been optimised.
 447
 448         ir_sat  :: InlSatFlag,
 449         ir_info :: InlineRuleInfo
 450     }
 451
 452   | UnfoldIfGoodArgs {  -- Arose from a normal Id; the info here is the
 453                         -- result of a simple analysis of the RHS
 454
 455       ug_args ::  [Int],  -- Discount if the argument is evaluated.
 456                           -- (i.e., a simplification will definitely
 457                           -- be possible).  One elt of the list per *value* arg.
 458
 459       ug_size :: Int,     -- The "size" of the unfolding.
 460
 461       ug_res :: Int       -- Scrutinee discount: the discount to substract if the thing is in
 462     }                     -- a context (case (thing args) of ...),
 463                           -- (where there are the right number of arguments.)
 464
 465   | UnfoldNever           -- A variant of UnfoldIfGoodArgs, used for big RHSs
 466
 467 data InlineRuleInfo
 468   = InlAlways       -- Inline absolutely always, however boring the context.
 469                     -- There is /no original definition/. Only a few primop-like things
 470                     -- have this property (see MkId.lhs, calls to mkCompulsoryUnfolding).
 471
 472   | InlSmall        -- The RHS is very small (eg no bigger than a call), so inline any
 473                     -- /saturated/ application, regardless of context
 474                     -- See Note [INLINE for small functions] in CoreUnfold
 475
 476   | InlVanilla
 477
 478   | InlWrapper Id   -- This unfolding is a the wrapper in a
 479                     --     worker/wrapper split from the strictness analyser
 480                     -- The Id is the worker-id
 481                     -- Used to abbreviate the uf_tmpl in interface files
 482                     --  which don't need to contain the RHS;
 483                     --  it can be derived from the strictness info
 484                     -- [In principle this is orthogonal to the InlSmall/InVanilla thing,
 485                     --  but it's convenient to have it here.]
 486
 487 data InlSatFlag = InlSat | InlUnSat
 488     -- Specifies whether to INLINE only if the thing is applied to 'arity' args
 489
 490 ------------------------------------------------
 491 noUnfolding :: Unfolding
 492 -- ^ There is no known 'Unfolding'
 493 evaldUnfolding :: Unfolding
 494 -- ^ This unfolding marks the associated thing as being evaluated
 495
 496 noUnfolding    = NoUnfolding
 497 evaldUnfolding = OtherCon []
 498
 499 mkOtherCon :: [AltCon] -> Unfolding
 500 mkOtherCon = OtherCon
 501
 502 seqUnfolding :: Unfolding -> ()
 503 seqUnfolding (CoreUnfolding { uf_tmpl = e, uf_is_top = top,
 504                 uf_is_value = b1, uf_is_cheap = b2,
 505                 uf_expandable = b3, uf_is_conlike = b4,
 506                 uf_arity = a, uf_guidance = g})
 507   = seqExpr e `seq` top `seq` b1 `seq` a `seq` b2 `seq` b3 `seq` b4 `seq` seqGuidance g
 508
 509 seqUnfolding _ = ()
 510
 511 seqGuidance :: UnfoldingGuidance -> ()
 512 seqGuidance (UnfoldIfGoodArgs ns n b) = n `seq` sum ns `seq` b `seq` ()
 513 seqGuidance _                         = ()
 514 \end{code}
 515
 516 \begin{code}
 517 -- | Retrieves the template of an unfolding: panics if none is known
 518 unfoldingTemplate :: Unfolding -> CoreExpr
 519 unfoldingTemplate = uf_tmpl
 520
 521 setUnfoldingTemplate :: Unfolding -> CoreExpr -> Unfolding
 522 setUnfoldingTemplate unf rhs = unf { uf_tmpl = rhs }
 523
 524 -- | Retrieves the template of an unfolding if possible
 525 maybeUnfoldingTemplate :: Unfolding -> Maybe CoreExpr
 526 maybeUnfoldingTemplate (CoreUnfolding { uf_tmpl = expr })       = Just expr
 527 maybeUnfoldingTemplate _                                        = Nothing
 528
 529 -- | The constructors that the unfolding could never be:
 530 -- returns @[]@ if no information is available
 531 otherCons :: Unfolding -> [AltCon]
 532 otherCons (OtherCon cons) = cons
 533 otherCons _               = []
 534
 535 -- | Determines if it is certainly the case that the unfolding will
 536 -- yield a value (something in HNF): returns @False@ if unsure
 537 isValueUnfolding :: Unfolding -> Bool
 538         -- Returns False for OtherCon
 539 isValueUnfolding (CoreUnfolding { uf_is_value = is_evald }) = is_evald
 540 isValueUnfolding _                                          = False
 541
 542 -- | Determines if it possibly the case that the unfolding will
 543 -- yield a value. Unlike 'isValueUnfolding' it returns @True@
 544 -- for 'OtherCon'
 545 isEvaldUnfolding :: Unfolding -> Bool
 546         -- Returns True for OtherCon
 547 isEvaldUnfolding (OtherCon _)                               = True
 548 isEvaldUnfolding (CoreUnfolding { uf_is_value = is_evald }) = is_evald
 549 isEvaldUnfolding _                                          = False
 550
 551 -- | @True@ if the unfolding is a constructor application, the application
 552 -- of a CONLIKE function or 'OtherCon'
 553 isConLikeUnfolding :: Unfolding -> Bool
 554 isConLikeUnfolding (OtherCon _)                             = True
 555 isConLikeUnfolding (CoreUnfolding { uf_is_conlike = con })  = con
 556 isConLikeUnfolding _                                        = False
 557
 558 -- | Is the thing we will unfold into certainly cheap?
 559 isCheapUnfolding :: Unfolding -> Bool
 560 isCheapUnfolding (CoreUnfolding { uf_is_cheap = is_cheap }) = is_cheap
 561 isCheapUnfolding _                                          = False
 562
 563 isExpandableUnfolding :: Unfolding -> Bool
 564 isExpandableUnfolding (CoreUnfolding { uf_expandable = is_expable }) = is_expable
 565 isExpandableUnfolding _                                              = False
 566
 567 isInlineRule :: Unfolding -> Bool
 568 isInlineRule (CoreUnfolding { uf_guidance = InlineRule {}}) = True
 569 isInlineRule _                                              = False
 570
 571 isInlineRule_maybe :: Unfolding -> Maybe (InlineRuleInfo, InlSatFlag)
 572 isInlineRule_maybe (CoreUnfolding { uf_guidance =
 573                         InlineRule { ir_info = inl, ir_sat = sat } }) = Just (inl,sat)
 574 isInlineRule_maybe _                                                  = Nothing
 575
 576 isStableUnfolding :: Unfolding -> Bool
 577 -- True of unfoldings that should not be overwritten
 578 -- by a CoreUnfolding for the RHS of a let-binding
 579 isStableUnfolding (CoreUnfolding { uf_guidance = InlineRule {} }) = True
 580 isStableUnfolding (DFunUnfolding {})                              = True
 581 isStableUnfolding _                                               = False
 582
 583 unfoldingArity :: Unfolding -> Arity
 584 unfoldingArity (CoreUnfolding { uf_arity = arity }) = arity
 585 unfoldingArity _                                    = panic "unfoldingArity"
 586
 587 isClosedUnfolding :: Unfolding -> Bool          -- No free variables
 588 isClosedUnfolding (CoreUnfolding {}) = False
 589 isClosedUnfolding _                  = True
 590
 591 -- | Only returns False if there is no unfolding information available at all
 592 hasSomeUnfolding :: Unfolding -> Bool
 593 hasSomeUnfolding NoUnfolding = False
 594 hasSomeUnfolding _           = True
 595
 596 neverUnfoldGuidance :: UnfoldingGuidance -> Bool
 597 neverUnfoldGuidance UnfoldNever = True
 598 neverUnfoldGuidance _           = False
 599
 600 canUnfold :: Unfolding -> Bool
 601 canUnfold (CoreUnfolding { uf_guidance = g }) = not (neverUnfoldGuidance g)
 602 canUnfold _                                   = False
 603 \end{code}
 604
 605 Note [InlineRule]
 606 ~~~~~~~~~~~~~~~~~
 607 When you say
 608       {-# INLINE f #-}
 609       f x = <rhs>
 610 you intend that calls (f e) are replaced by <rhs>[e/x] So we
 611 should capture (\x.<rhs>) in the Unfolding of 'f', and never meddle
 612 with it.  Meanwhile, we can optimise <rhs> to our heart's content,
 613 leaving the original unfolding intact in Unfolding of 'f'.
 614
 615 So the representation of an Unfolding has changed quite a bit
 616 (see CoreSyn).  An INLINE pragma gives rise to an InlineRule
 617 unfolding.
 618
 619 Moreover, it's only used when 'f' is applied to the
 620 specified number of arguments; that is, the number of argument on
 621 the LHS of the '=' sign in the original source definition.
 622 For example, (.) is now defined in the libraries like this
 623    {-# INLINE (.) #-}
 624    (.) f g = \x -> f (g x)
 625 so that it'll inline when applied to two arguments. If 'x' appeared
 626 on the left, thus
 627    (.) f g x = f (g x)
 628 it'd only inline when applied to three arguments.  This slightly-experimental
 629 change was requested by Roman, but it seems to make sense.
 630
 631 See also Note [Inlining an InlineRule] in CoreUnfold.
 632
 633
 634 Note [OccInfo in unfoldings and rules]
 635 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 636 In unfoldings and rules, we guarantee that the template is occ-analysed,
 637 so that the occurence info on the binders is correct.  This is important,
 638 because the Simplifier does not re-analyse the template when using it. If
 639 the occurrence info is wrong
 640   - We may get more simpifier iterations than necessary, because
 641     once-occ info isn't there
 642   - More seriously, we may get an infinite loop if there's a Rec
 643     without a loop breaker marked
 644
 645
 646 %************************************************************************
 647 %*                                                                      *
 648 \subsection{The main data type}
 649 %*                                                                      *
 650 %************************************************************************
 651
 652 \begin{code}
 653 -- The Ord is needed for the FiniteMap used in the lookForConstructor
 654 -- in SimplEnv.  If you declared that lookForConstructor *ignores*
 655 -- constructor-applications with LitArg args, then you could get
 656 -- rid of this Ord.
 657
 658 instance Outputable AltCon where
 659   ppr (DataAlt dc) = ppr dc
 660   ppr (LitAlt lit) = ppr lit
 661   ppr DEFAULT      = ptext (sLit "__DEFAULT")
 662
 663 instance Show AltCon where
 664   showsPrec p con = showsPrecSDoc p (ppr con)
 665
 666 cmpAlt :: Alt b -> Alt b -> Ordering
 667 cmpAlt (con1, _, _) (con2, _, _) = con1 `cmpAltCon` con2
 668
 669 ltAlt :: Alt b -> Alt b -> Bool
 670 ltAlt a1 a2 = (a1 `cmpAlt` a2) == LT
 671
 672 cmpAltCon :: AltCon -> AltCon -> Ordering
 673 -- ^ Compares 'AltCon's within a single list of alternatives
 674 cmpAltCon DEFAULT      DEFAULT     = EQ
 675 cmpAltCon DEFAULT      _           = LT
 676
 677 cmpAltCon (DataAlt d1) (DataAlt d2) = dataConTag d1 `compare` dataConTag d2
 678 cmpAltCon (DataAlt _)  DEFAULT      = GT
 679 cmpAltCon (LitAlt  l1) (LitAlt  l2) = l1 `compare` l2
 680 cmpAltCon (LitAlt _)   DEFAULT      = GT
 681
 682 cmpAltCon con1 con2 = WARN( True, text "Comparing incomparable AltCons" <+>
 683                                   ppr con1 <+> ppr con2 )
 684                       LT
 685 \end{code}
 686
 687 %************************************************************************
 688 %*                                                                      *
 689 \subsection{Useful synonyms}
 690 %*                                                                      *
 691 %************************************************************************
 692
 693 \begin{code}
 694 -- | The common case for the type of binders and variables when
 695 -- we are manipulating the Core language within GHC
 696 type CoreBndr = Var
 697 -- | Expressions where binders are 'CoreBndr's
 698 type CoreExpr = Expr CoreBndr
 699 -- | Argument expressions where binders are 'CoreBndr's
 700 type CoreArg  = Arg  CoreBndr
 701 -- | Binding groups where binders are 'CoreBndr's
 702 type CoreBind = Bind CoreBndr
 703 -- | Case alternatives where binders are 'CoreBndr's
 704 type CoreAlt  = Alt  CoreBndr
 705 \end{code}
 706
 707 %************************************************************************
 708 %*                                                                      *
 709 \subsection{Tagging}
 710 %*                                                                      *
 711 %************************************************************************
 712
 713 \begin{code}
 714 -- | Binders are /tagged/ with a t
 715 data TaggedBndr t = TB CoreBndr t       -- TB for "tagged binder"
 716
 717 type TaggedBind t = Bind (TaggedBndr t)
 718 type TaggedExpr t = Expr (TaggedBndr t)
 719 type TaggedArg  t = Arg  (TaggedBndr t)
 720 type TaggedAlt  t = Alt  (TaggedBndr t)
 721
 722 instance Outputable b => Outputable (TaggedBndr b) where
 723   ppr (TB b l) = char '<' <> ppr b <> comma <> ppr l <> char '>'
 724
 725 instance Outputable b => OutputableBndr (TaggedBndr b) where
 726   pprBndr _ b = ppr b   -- Simple
 727 \end{code}
 728
 729
 730 %************************************************************************
 731 %*                                                                      *
 732 \subsection{Core-constructing functions with checking}
 733 %*                                                                      *
 734 %************************************************************************
 735
 736 \begin{code}
 737 -- | Apply a list of argument expressions to a function expression in a nested fashion. Prefer to
 738 -- use 'CoreUtils.mkCoreApps' if possible
 739 mkApps    :: Expr b -> [Arg b]  -> Expr b
 740 -- | Apply a list of type argument expressions to a function expression in a nested fashion
 741 mkTyApps  :: Expr b -> [Type]   -> Expr b
 742 -- | Apply a list of type or value variables to a function expression in a nested fashion
 743 mkVarApps :: Expr b -> [Var] -> Expr b
 744 -- | Apply a list of argument expressions to a data constructor in a nested fashion. Prefer to
 745 -- use 'MkCore.mkCoreConApps' if possible
 746 mkConApp      :: DataCon -> [Arg b] -> Expr b
 747
 748 mkApps    f args = foldl App                       f args
 749 mkTyApps  f args = foldl (\ e a -> App e (Type a)) f args
 750 mkVarApps f vars = foldl (\ e a -> App e (varToCoreExpr a)) f vars
 751 mkConApp con args = mkApps (Var (dataConWorkId con)) args
 752
 753
 754 -- | Create a machine integer literal expression of type @Int#@ from an @Integer@.
 755 -- If you want an expression of type @Int@ use 'MkCore.mkIntExpr'
 756 mkIntLit      :: Integer -> Expr b
 757 -- | Create a machine integer literal expression of type @Int#@ from an @Int@.
 758 -- If you want an expression of type @Int@ use 'MkCore.mkIntExpr'
 759 mkIntLitInt   :: Int     -> Expr b
 760
 761 mkIntLit    n = Lit (mkMachInt n)
 762 mkIntLitInt n = Lit (mkMachInt (toInteger n))
 763
 764 -- | Create a machine word literal expression of type  @Word#@ from an @Integer@.
 765 -- If you want an expression of type @Word@ use 'MkCore.mkWordExpr'
 766 mkWordLit     :: Integer -> Expr b
 767 -- | Create a machine word literal expression of type  @Word#@ from a @Word@.
 768 -- If you want an expression of type @Word@ use 'MkCore.mkWordExpr'
 769 mkWordLitWord :: Word -> Expr b
 770
 771 mkWordLit     w = Lit (mkMachWord w)
 772 mkWordLitWord w = Lit (mkMachWord (toInteger w))
 773
 774 -- | Create a machine character literal expression of type @Char#@.
 775 -- If you want an expression of type @Char@ use 'MkCore.mkCharExpr'
 776 mkCharLit :: Char -> Expr b
 777 -- | Create a machine string literal expression of type @Addr#@.
 778 -- If you want an expression of type @String@ use 'MkCore.mkStringExpr'
 779 mkStringLit :: String -> Expr b
 780
 781 mkCharLit   c = Lit (mkMachChar c)
 782 mkStringLit s = Lit (mkMachString s)
 783
 784 -- | Create a machine single precision literal expression of type @Float#@ from a @Rational@.
 785 -- If you want an expression of type @Float@ use 'MkCore.mkFloatExpr'
 786 mkFloatLit :: Rational -> Expr b
 787 -- | Create a machine single precision literal expression of type @Float#@ from a @Float@.
 788 -- If you want an expression of type @Float@ use 'MkCore.mkFloatExpr'
 789 mkFloatLitFloat :: Float -> Expr b
 790
 791 mkFloatLit      f = Lit (mkMachFloat f)
 792 mkFloatLitFloat f = Lit (mkMachFloat (toRational f))
 793
 794 -- | Create a machine double precision literal expression of type @Double#@ from a @Rational@.
 795 -- If you want an expression of type @Double@ use 'MkCore.mkDoubleExpr'
 796 mkDoubleLit :: Rational -> Expr b
 797 -- | Create a machine double precision literal expression of type @Double#@ from a @Double@.
 798 -- If you want an expression of type @Double@ use 'MkCore.mkDoubleExpr'
 799 mkDoubleLitDouble :: Double -> Expr b
 800
 801 mkDoubleLit       d = Lit (mkMachDouble d)
 802 mkDoubleLitDouble d = Lit (mkMachDouble (toRational d))
 803
 804 -- | Bind all supplied binding groups over an expression in a nested let expression. Prefer to
 805 -- use 'CoreUtils.mkCoreLets' if possible
 806 mkLets        :: [Bind b] -> Expr b -> Expr b
 807 -- | Bind all supplied binders over an expression in a nested lambda expression. Prefer to
 808 -- use 'CoreUtils.mkCoreLams' if possible
 809 mkLams        :: [b] -> Expr b -> Expr b
 810
 811 mkLams binders body = foldr Lam body binders
 812 mkLets binds body   = foldr Let body binds
 813
 814
 815 -- | Create a binding group where a type variable is bound to a type. Per "CoreSyn#type_let",
 816 -- this can only be used to bind something in a non-recursive @let@ expression
 817 mkTyBind :: TyVar -> Type -> CoreBind
 818 mkTyBind tv ty      = NonRec tv (Type ty)
 819
 820 -- | Convert a binder into either a 'Var' or 'Type' 'Expr' appropriately
 821 varToCoreExpr :: CoreBndr -> Expr b
 822 varToCoreExpr v | isId v = Var v
 823                 | otherwise = Type (mkTyVarTy v)
 824
 825 varsToCoreExprs :: [CoreBndr] -> [Expr b]
 826 varsToCoreExprs vs = map varToCoreExpr vs
 827 \end{code}
 828
 829
 830 %************************************************************************
 831 %*                                                                      *
 832 \subsection{Simple access functions}
 833 %*                                                                      *
 834 %************************************************************************
 835
 836 \begin{code}
 837 -- | Extract every variable by this group
 838 bindersOf  :: Bind b -> [b]
 839 bindersOf (NonRec binder _) = [binder]
 840 bindersOf (Rec pairs)       = [binder | (binder, _) <- pairs]
 841
 842 -- | 'bindersOf' applied to a list of binding groups
 843 bindersOfBinds :: [Bind b] -> [b]
 844 bindersOfBinds binds = foldr ((++) . bindersOf) [] binds
 845
 846 rhssOfBind :: Bind b -> [Expr b]
 847 rhssOfBind (NonRec _ rhs) = [rhs]
 848 rhssOfBind (Rec pairs)    = [rhs | (_,rhs) <- pairs]
 849
 850 rhssOfAlts :: [Alt b] -> [Expr b]
 851 rhssOfAlts alts = [e | (_,_,e) <- alts]
 852
 853 -- | Collapse all the bindings in the supplied groups into a single
 854 -- list of lhs\/rhs pairs suitable for binding in a 'Rec' binding group
 855 flattenBinds :: [Bind b] -> [(b, Expr b)]
 856 flattenBinds (NonRec b r : binds) = (b,r) : flattenBinds binds
 857 flattenBinds (Rec prs1   : binds) = prs1 ++ flattenBinds binds
 858 flattenBinds []                   = []
 859 \end{code}
 860
 861 \begin{code}
 862 -- | We often want to strip off leading lambdas before getting down to
 863 -- business. This function is your friend.
 864 collectBinders               :: Expr b -> ([b],         Expr b)
 865 -- | Collect as many type bindings as possible from the front of a nested lambda
 866 collectTyBinders             :: CoreExpr -> ([TyVar],     CoreExpr)
 867 -- | Collect as many value bindings as possible from the front of a nested lambda
 868 collectValBinders            :: CoreExpr -> ([Id],        CoreExpr)
 869 -- | Collect type binders from the front of the lambda first,
 870 -- then follow up by collecting as many value bindings as possible
 871 -- from the resulting stripped expression
 872 collectTyAndValBinders       :: CoreExpr -> ([TyVar], [Id], CoreExpr)
 873
 874 collectBinders expr
 875   = go [] expr
 876   where
 877     go bs (Lam b e) = go (b:bs) e
 878     go bs e          = (reverse bs, e)
 879
 880 collectTyAndValBinders expr
 881   = (tvs, ids, body)
 882   where
 883     (tvs, body1) = collectTyBinders expr
 884     (ids, body)  = collectValBinders body1
 885
 886 collectTyBinders expr
 887   = go [] expr
 888   where
 889     go tvs (Lam b e) | isTyVar b = go (b:tvs) e
 890     go tvs e                     = (reverse tvs, e)
 891
 892 collectValBinders expr
 893   = go [] expr
 894   where
 895     go ids (Lam b e) | isId b = go (b:ids) e
 896     go ids body               = (reverse ids, body)
 897 \end{code}
 898
 899 \begin{code}
 900 -- | Takes a nested application expression and returns the the function
 901 -- being applied and the arguments to which it is applied
 902 collectArgs :: Expr b -> (Expr b, [Arg b])
 903 collectArgs expr
 904   = go expr []
 905   where
 906     go (App f a) as = go f (a:as)
 907     go e         as = (e, as)
 908 \end{code}
 909
 910 \begin{code}
 911 -- | Gets the cost centre enclosing an expression, if any.
 912 -- It looks inside lambdas because @(scc \"foo\" \\x.e) = \\x. scc \"foo\" e@
 913 coreExprCc :: Expr b -> CostCentre
 914 coreExprCc (Note (SCC cc) _)   = cc
 915 coreExprCc (Note _ e)          = coreExprCc e
 916 coreExprCc (Lam _ e)           = coreExprCc e
 917 coreExprCc _                   = noCostCentre
 918 \end{code}
 919
 920 %************************************************************************
 921 %*                                                                      *
 922 \subsection{Predicates}
 923 %*                                                                      *
 924 %************************************************************************
 925
 926 At one time we optionally carried type arguments through to runtime.
 927 @isRuntimeVar v@ returns if (Lam v _) really becomes a lambda at runtime,
 928 i.e. if type applications are actual lambdas because types are kept around
 929 at runtime.  Similarly isRuntimeArg.
 930
 931 \begin{code}
 932 -- | Will this variable exist at runtime?
 933 isRuntimeVar :: Var -> Bool
 934 isRuntimeVar = isId
 935
 936 -- | Will this argument expression exist at runtime?
 937 isRuntimeArg :: CoreExpr -> Bool
 938 isRuntimeArg = isValArg
 939
 940 -- | Returns @False@ iff the expression is a 'Type' expression at its top level
 941 isValArg :: Expr b -> Bool
 942 isValArg (Type _) = False
 943 isValArg _        = True
 944
 945 -- | Returns @True@ iff the expression is a 'Type' expression at its top level
 946 isTypeArg :: Expr b -> Bool
 947 isTypeArg (Type _) = True
 948 isTypeArg _        = False
 949
 950 -- | The number of binders that bind values rather than types
 951 valBndrCount :: [CoreBndr] -> Int
 952 valBndrCount = count isId
 953
 954 -- | The number of argument expressions that are values rather than types at their top level
 955 valArgCount :: [Arg b] -> Int
 956 valArgCount = count isValArg
 957 \end{code}
 958
 959
 960 %************************************************************************
 961 %*                                                                      *
 962 \subsection{Seq stuff}
 963 %*                                                                      *
 964 %************************************************************************
 965
 966 \begin{code}
 967 seqExpr :: CoreExpr -> ()
 968 seqExpr (Var v)         = v `seq` ()
 969 seqExpr (Lit lit)       = lit `seq` ()
 970 seqExpr (App f a)       = seqExpr f `seq` seqExpr a
 971 seqExpr (Lam b e)       = seqBndr b `seq` seqExpr e
 972 seqExpr (Let b e)       = seqBind b `seq` seqExpr e
 973 seqExpr (Case e b t as) = seqExpr e `seq` seqBndr b `seq` seqType t `seq` seqAlts as
 974 seqExpr (Cast e co)     = seqExpr e `seq` seqType co
 975 seqExpr (Note n e)      = seqNote n `seq` seqExpr e
 976 seqExpr (Type t)        = seqType t
 977
 978 seqExprs :: [CoreExpr] -> ()
 979 seqExprs [] = ()
 980 seqExprs (e:es) = seqExpr e `seq` seqExprs es
 981
 982 seqNote :: Note -> ()
 983 seqNote (CoreNote s)   = s `seq` ()
 984 seqNote _              = ()
 985
 986 seqBndr :: CoreBndr -> ()
 987 seqBndr b = b `seq` ()
 988
 989 seqBndrs :: [CoreBndr] -> ()
 990 seqBndrs [] = ()
 991 seqBndrs (b:bs) = seqBndr b `seq` seqBndrs bs
 992
 993 seqBind :: Bind CoreBndr -> ()
 994 seqBind (NonRec b e) = seqBndr b `seq` seqExpr e
 995 seqBind (Rec prs)    = seqPairs prs
 996
 997 seqPairs :: [(CoreBndr, CoreExpr)] -> ()
 998 seqPairs [] = ()
 999 seqPairs ((b,e):prs) = seqBndr b `seq` seqExpr e `seq` seqPairs prs
1000
1001 seqAlts :: [CoreAlt] -> ()
1002 seqAlts [] = ()
1003 seqAlts ((c,bs,e):alts) = c `seq` seqBndrs bs `seq` seqExpr e `seq` seqAlts alts
1004
1005 seqRules :: [CoreRule] -> ()
1006 seqRules [] = ()
1007 seqRules (Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs } : rules)
1008   = seqBndrs bndrs `seq` seqExprs (rhs:args) `seq` seqRules rules
1009 seqRules (BuiltinRule {} : rules) = seqRules rules
1010 \end{code}
1011
1012 %************************************************************************
1013 %*                                                                      *
1014 \subsection{Annotated core}
1015 %*                                                                      *
1016 %************************************************************************
1017
1018 \begin{code}
1019 -- | Annotated core: allows annotation at every node in the tree
1020 type AnnExpr bndr annot = (annot, AnnExpr' bndr annot)
1021
1022 -- | A clone of the 'Expr' type but allowing annotation at every tree node
1023 data AnnExpr' bndr annot
1024   = AnnVar      Id
1025   | AnnLit      Literal
1026   | AnnLam      bndr (AnnExpr bndr annot)
1027   | AnnApp      (AnnExpr bndr annot) (AnnExpr bndr annot)
1028   | AnnCase     (AnnExpr bndr annot) bndr Type [AnnAlt bndr annot]
1029   | AnnLet      (AnnBind bndr annot) (AnnExpr bndr annot)
1030   | AnnCast     (AnnExpr bndr annot) Coercion
1031   | AnnNote     Note (AnnExpr bndr annot)
1032   | AnnType     Type
1033
1034 -- | A clone of the 'Alt' type but allowing annotation at every tree node
1035 type AnnAlt bndr annot = (AltCon, [bndr], AnnExpr bndr annot)
1036
1037 -- | A clone of the 'Bind' type but allowing annotation at every tree node
1038 data AnnBind bndr annot
1039   = AnnNonRec bndr (AnnExpr bndr annot)
1040   | AnnRec    [(bndr, AnnExpr bndr annot)]
1041 \end{code}
1042
1043 \begin{code}
1044 deAnnotate :: AnnExpr bndr annot -> Expr bndr
1045 deAnnotate (_, e) = deAnnotate' e
1046
1047 deAnnotate' :: AnnExpr' bndr annot -> Expr bndr
1048 deAnnotate' (AnnType t)           = Type t
1049 deAnnotate' (AnnVar  v)           = Var v
1050 deAnnotate' (AnnLit  lit)         = Lit lit
1051 deAnnotate' (AnnLam  binder body) = Lam binder (deAnnotate body)
1052 deAnnotate' (AnnApp  fun arg)     = App (deAnnotate fun) (deAnnotate arg)
1053 deAnnotate' (AnnCast e co)        = Cast (deAnnotate e) co
1054 deAnnotate' (AnnNote note body)   = Note note (deAnnotate body)
1055
1056 deAnnotate' (AnnLet bind body)
1057   = Let (deAnnBind bind) (deAnnotate body)
1058   where
1059     deAnnBind (AnnNonRec var rhs) = NonRec var (deAnnotate rhs)
1060     deAnnBind (AnnRec pairs) = Rec [(v,deAnnotate rhs) | (v,rhs) <- pairs]
1061
1062 deAnnotate' (AnnCase scrut v t alts)
1063   = Case (deAnnotate scrut) v t (map deAnnAlt alts)
1064
1065 deAnnAlt :: AnnAlt bndr annot -> Alt bndr
1066 deAnnAlt (con,args,rhs) = (con,args,deAnnotate rhs)
1067 \end{code}
1068
1069 \begin{code}
1070 -- | As 'collectBinders' but for 'AnnExpr' rather than 'Expr'
1071 collectAnnBndrs :: AnnExpr bndr annot -> ([bndr], AnnExpr bndr annot)
1072 collectAnnBndrs e
1073   = collect [] e
1074   where
1075     collect bs (_, AnnLam b body) = collect (b:bs) body
1076     collect bs body               = (reverse bs, body)
1077 \end{code}