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(..),
  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,
  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_cheap   :: Bool,          -- True <=> doesn't waste (much) work to expand inside an inlining
 417                                         --      Cached version of exprIsCheap
 418         uf_expandable :: Bool,          -- True <=> can expand in RULE matching
 419                                         --      Cached version of exprIsExpandable
 420         uf_guidance   :: UnfoldingGuidance      -- Tells about the *size* of the template.
 421     }
 422   -- ^ An unfolding with redundant cached information. Parameters:
 423   --
 424   --  uf_tmpl: Template used to perform unfolding;
 425   --           NB: Occurrence info is guaranteed correct:
 426   --               see Note [OccInfo in unfoldings and rules]
 427   --
 428   --  uf_is_top: Is this a top level binding?
 429   --
 430   --  uf_is_value: 'exprIsHNF' template (cached); it is ok to discard a 'seq' on
 431   --     this variable
 432   --
 433   --  uf_is_cheap:  Does this waste only a little work if we expand it inside an inlining?
 434   --     Basically this is a cached version of 'exprIsCheap'
 435   --
 436   --  uf_guidance:  Tells us about the /size/ of the unfolding template
 437
 438 ------------------------------------------------
 439 -- | 'UnfoldingGuidance' says when unfolding should take place
 440 data UnfoldingGuidance
 441   = UnfoldAlways        -- There is /no original definition/, so you'd better unfold.
 442                         -- The unfolding is guaranteed to have no free variables
 443                         -- so no need to think about it during dependency analysis
 444
 445   | InlineRule {        -- See Note [InlineRules]
 446                         -- Be very keen to inline this
 447                         -- The uf_tmpl is the *original* RHS; do *not* replace it on
 448                         --   each simlifier run.  Hence, the *actual* RHS of the function
 449                         --   may be different by now, because it may have been optimised.
 450       ug_ir_info :: InlineRuleInfo,     -- Supplementary info about the InlineRule
 451       ug_small :: Bool                  -- True <=> the RHS is so small (eg no bigger than a call)
 452                                         --          that you should always inline a saturated call,
 453     }                                   --           regardless of how boring the context is
 454                                         -- See Note [INLINE for small functions] in CoreUnfold]
 455
 456   | UnfoldIfGoodArgs {  -- Arose from a normal Id; the info here is the
 457                         -- result of a simple analysis of the RHS
 458
 459       ug_args ::  [Int],  -- Discount if the argument is evaluated.
 460                           -- (i.e., a simplification will definitely
 461                           -- be possible).  One elt of the list per *value* arg.
 462
 463       ug_size :: Int,     -- The "size" of the unfolding.
 464
 465       ug_res :: Int       -- Scrutinee discount: the discount to substract if the thing is in
 466     }                     -- a context (case (thing args) of ...),
 467                           -- (where there are the right number of arguments.)
 468
 469   | UnfoldNever
 470
 471 data InlineRuleInfo
 472   = InlSat              -- A user-specifed or compiler injected INLINE pragma
 473                         -- ONLY inline when it's applied to 'arity' arguments
 474
 475   | InlUnSat            -- The compiler decided to "capture" the RHS into an
 476                         -- InlineRule, but do not require that it appears saturated
 477
 478   | InlWrapper Id       -- This unfolding is a the wrapper in a
 479                         --     worker/wrapper split from the strictness analyser
 480                         -- Used to abbreviate the uf_tmpl in interface files
 481                         --      which don't need to contain the RHS;
 482                         --      it can be derived from the strictness info
 483
 484 ------------------------------------------------
 485 noUnfolding :: Unfolding
 486 -- ^ There is no known 'Unfolding'
 487 evaldUnfolding :: Unfolding
 488 -- ^ This unfolding marks the associated thing as being evaluated
 489
 490 noUnfolding    = NoUnfolding
 491 evaldUnfolding = OtherCon []
 492
 493 mkOtherCon :: [AltCon] -> Unfolding
 494 mkOtherCon = OtherCon
 495
 496 seqUnfolding :: Unfolding -> ()
 497 seqUnfolding (CoreUnfolding { uf_tmpl = e, uf_is_top = top,
 498                 uf_is_value = b1, uf_is_cheap = b2,
 499                 uf_expandable = b3, uf_arity = a, uf_guidance = g})
 500   = seqExpr e `seq` top `seq` b1 `seq` a `seq` b2 `seq` b3 `seq` seqGuidance g
 501
 502 seqUnfolding _ = ()
 503
 504 seqGuidance :: UnfoldingGuidance -> ()
 505 seqGuidance (UnfoldIfGoodArgs ns n b) = n `seq` sum ns `seq` b `seq` ()
 506 seqGuidance _                         = ()
 507 \end{code}
 508
 509 \begin{code}
 510 -- | Retrieves the template of an unfolding: panics if none is known
 511 unfoldingTemplate :: Unfolding -> CoreExpr
 512 unfoldingTemplate = uf_tmpl
 513
 514 setUnfoldingTemplate :: Unfolding -> CoreExpr -> Unfolding
 515 setUnfoldingTemplate unf rhs = unf { uf_tmpl = rhs }
 516
 517 -- | Retrieves the template of an unfolding if possible
 518 maybeUnfoldingTemplate :: Unfolding -> Maybe CoreExpr
 519 maybeUnfoldingTemplate (CoreUnfolding { uf_tmpl = expr })       = Just expr
 520 maybeUnfoldingTemplate _                                        = Nothing
 521
 522 -- | The constructors that the unfolding could never be:
 523 -- returns @[]@ if no information is available
 524 otherCons :: Unfolding -> [AltCon]
 525 otherCons (OtherCon cons) = cons
 526 otherCons _               = []
 527
 528 -- | Determines if it is certainly the case that the unfolding will
 529 -- yield a value (something in HNF): returns @False@ if unsure
 530 isValueUnfolding :: Unfolding -> Bool
 531         -- Returns False for OtherCon
 532 isValueUnfolding (CoreUnfolding { uf_is_value = is_evald }) = is_evald
 533 isValueUnfolding _                                          = False
 534
 535 -- | Determines if it possibly the case that the unfolding will
 536 -- yield a value. Unlike 'isValueUnfolding' it returns @True@
 537 -- for 'OtherCon'
 538 isEvaldUnfolding :: Unfolding -> Bool
 539         -- Returns True for OtherCon
 540 isEvaldUnfolding (OtherCon _)                               = True
 541 isEvaldUnfolding (CoreUnfolding { uf_is_value = is_evald }) = is_evald
 542 isEvaldUnfolding _                                          = False
 543
 544 -- | Is the thing we will unfold into certainly cheap?
 545 isCheapUnfolding :: Unfolding -> Bool
 546 isCheapUnfolding (CoreUnfolding { uf_is_cheap = is_cheap }) = is_cheap
 547 isCheapUnfolding _                                          = False
 548
 549 isExpandableUnfolding :: Unfolding -> Bool
 550 isExpandableUnfolding (CoreUnfolding { uf_expandable = is_expable }) = is_expable
 551 isExpandableUnfolding _                                              = False
 552
 553 isInlineRule :: Unfolding -> Bool
 554 isInlineRule (CoreUnfolding { uf_guidance = InlineRule {}}) = True
 555 isInlineRule _                                              = False
 556
 557 isInlineRule_maybe :: Unfolding -> Maybe InlineRuleInfo
 558 isInlineRule_maybe (CoreUnfolding {
 559                        uf_guidance = InlineRule { ug_ir_info = inl } }) = Just inl
 560 isInlineRule_maybe _                                                    = Nothing
 561
 562 isStableUnfolding :: Unfolding -> Bool
 563 -- True of unfoldings that should not be overwritten
 564 -- by a CoreUnfolding for the RHS of a let-binding
 565 isStableUnfolding (CoreUnfolding { uf_guidance = InlineRule {} }) = True
 566 isStableUnfolding (DFunUnfolding {})                              = True
 567 isStableUnfolding _                                               = False
 568
 569 unfoldingArity :: Unfolding -> Arity
 570 unfoldingArity (CoreUnfolding { uf_arity = arity }) = arity
 571 unfoldingArity _                                    = panic "unfoldingArity"
 572
 573 isClosedUnfolding :: Unfolding -> Bool          -- No free variables
 574 isClosedUnfolding (CoreUnfolding {}) = False
 575 isClosedUnfolding _                  = True
 576
 577 -- | Only returns False if there is no unfolding information available at all
 578 hasSomeUnfolding :: Unfolding -> Bool
 579 hasSomeUnfolding NoUnfolding = False
 580 hasSomeUnfolding _           = True
 581
 582 neverUnfoldGuidance :: UnfoldingGuidance -> Bool
 583 neverUnfoldGuidance UnfoldNever = True
 584 neverUnfoldGuidance _           = False
 585
 586 canUnfold :: Unfolding -> Bool
 587 canUnfold (CoreUnfolding { uf_guidance = g }) = not (neverUnfoldGuidance g)
 588 canUnfold _                                   = False
 589 \end{code}
 590
 591 Note [InlineRule]
 592 ~~~~~~~~~~~~~~~~~
 593 When you say
 594       {-# INLINE f #-}
 595       f x = <rhs>
 596 you intend that calls (f e) are replaced by <rhs>[e/x] So we
 597 should capture (\x.<rhs>) in the Unfolding of 'f', and never meddle
 598 with it.  Meanwhile, we can optimise <rhs> to our heart's content,
 599 leaving the original unfolding intact in Unfolding of 'f'.
 600
 601 So the representation of an Unfolding has changed quite a bit
 602 (see CoreSyn).  An INLINE pragma gives rise to an InlineRule
 603 unfolding.
 604
 605 Moreover, it's only used when 'f' is applied to the
 606 specified number of arguments; that is, the number of argument on
 607 the LHS of the '=' sign in the original source definition.
 608 For example, (.) is now defined in the libraries like this
 609    {-# INLINE (.) #-}
 610    (.) f g = \x -> f (g x)
 611 so that it'll inline when applied to two arguments. If 'x' appeared
 612 on the left, thus
 613    (.) f g x = f (g x)
 614 it'd only inline when applied to three arguments.  This slightly-experimental
 615 change was requested by Roman, but it seems to make sense.
 616
 617 See also Note [Inlining an InlineRule] in CoreUnfold.
 618
 619
 620 Note [OccInfo in unfoldings and rules]
 621 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 622 In unfoldings and rules, we guarantee that the template is occ-analysed,
 623 so that the occurence info on the binders is correct.  This is important,
 624 because the Simplifier does not re-analyse the template when using it. If
 625 the occurrence info is wrong
 626   - We may get more simpifier iterations than necessary, because
 627     once-occ info isn't there
 628   - More seriously, we may get an infinite loop if there's a Rec
 629     without a loop breaker marked
 630
 631
 632 %************************************************************************
 633 %*                                                                      *
 634 \subsection{The main data type}
 635 %*                                                                      *
 636 %************************************************************************
 637
 638 \begin{code}
 639 -- The Ord is needed for the FiniteMap used in the lookForConstructor
 640 -- in SimplEnv.  If you declared that lookForConstructor *ignores*
 641 -- constructor-applications with LitArg args, then you could get
 642 -- rid of this Ord.
 643
 644 instance Outputable AltCon where
 645   ppr (DataAlt dc) = ppr dc
 646   ppr (LitAlt lit) = ppr lit
 647   ppr DEFAULT      = ptext (sLit "__DEFAULT")
 648
 649 instance Show AltCon where
 650   showsPrec p con = showsPrecSDoc p (ppr con)
 651
 652 cmpAlt :: Alt b -> Alt b -> Ordering
 653 cmpAlt (con1, _, _) (con2, _, _) = con1 `cmpAltCon` con2
 654
 655 ltAlt :: Alt b -> Alt b -> Bool
 656 ltAlt a1 a2 = (a1 `cmpAlt` a2) == LT
 657
 658 cmpAltCon :: AltCon -> AltCon -> Ordering
 659 -- ^ Compares 'AltCon's within a single list of alternatives
 660 cmpAltCon DEFAULT      DEFAULT     = EQ
 661 cmpAltCon DEFAULT      _           = LT
 662
 663 cmpAltCon (DataAlt d1) (DataAlt d2) = dataConTag d1 `compare` dataConTag d2
 664 cmpAltCon (DataAlt _)  DEFAULT      = GT
 665 cmpAltCon (LitAlt  l1) (LitAlt  l2) = l1 `compare` l2
 666 cmpAltCon (LitAlt _)   DEFAULT      = GT
 667
 668 cmpAltCon con1 con2 = WARN( True, text "Comparing incomparable AltCons" <+>
 669                                   ppr con1 <+> ppr con2 )
 670                       LT
 671 \end{code}
 672
 673 %************************************************************************
 674 %*                                                                      *
 675 \subsection{Useful synonyms}
 676 %*                                                                      *
 677 %************************************************************************
 678
 679 \begin{code}
 680 -- | The common case for the type of binders and variables when
 681 -- we are manipulating the Core language within GHC
 682 type CoreBndr = Var
 683 -- | Expressions where binders are 'CoreBndr's
 684 type CoreExpr = Expr CoreBndr
 685 -- | Argument expressions where binders are 'CoreBndr's
 686 type CoreArg  = Arg  CoreBndr
 687 -- | Binding groups where binders are 'CoreBndr's
 688 type CoreBind = Bind CoreBndr
 689 -- | Case alternatives where binders are 'CoreBndr's
 690 type CoreAlt  = Alt  CoreBndr
 691 \end{code}
 692
 693 %************************************************************************
 694 %*                                                                      *
 695 \subsection{Tagging}
 696 %*                                                                      *
 697 %************************************************************************
 698
 699 \begin{code}
 700 -- | Binders are /tagged/ with a t
 701 data TaggedBndr t = TB CoreBndr t       -- TB for "tagged binder"
 702
 703 type TaggedBind t = Bind (TaggedBndr t)
 704 type TaggedExpr t = Expr (TaggedBndr t)
 705 type TaggedArg  t = Arg  (TaggedBndr t)
 706 type TaggedAlt  t = Alt  (TaggedBndr t)
 707
 708 instance Outputable b => Outputable (TaggedBndr b) where
 709   ppr (TB b l) = char '<' <> ppr b <> comma <> ppr l <> char '>'
 710
 711 instance Outputable b => OutputableBndr (TaggedBndr b) where
 712   pprBndr _ b = ppr b   -- Simple
 713 \end{code}
 714
 715
 716 %************************************************************************
 717 %*                                                                      *
 718 \subsection{Core-constructing functions with checking}
 719 %*                                                                      *
 720 %************************************************************************
 721
 722 \begin{code}
 723 -- | Apply a list of argument expressions to a function expression in a nested fashion. Prefer to
 724 -- use 'CoreUtils.mkCoreApps' if possible
 725 mkApps    :: Expr b -> [Arg b]  -> Expr b
 726 -- | Apply a list of type argument expressions to a function expression in a nested fashion
 727 mkTyApps  :: Expr b -> [Type]   -> Expr b
 728 -- | Apply a list of type or value variables to a function expression in a nested fashion
 729 mkVarApps :: Expr b -> [Var] -> Expr b
 730 -- | Apply a list of argument expressions to a data constructor in a nested fashion. Prefer to
 731 -- use 'MkCore.mkCoreConApps' if possible
 732 mkConApp      :: DataCon -> [Arg b] -> Expr b
 733
 734 mkApps    f args = foldl App                       f args
 735 mkTyApps  f args = foldl (\ e a -> App e (Type a)) f args
 736 mkVarApps f vars = foldl (\ e a -> App e (varToCoreExpr a)) f vars
 737 mkConApp con args = mkApps (Var (dataConWorkId con)) args
 738
 739
 740 -- | Create a machine integer literal expression of type @Int#@ from an @Integer@.
 741 -- If you want an expression of type @Int@ use 'MkCore.mkIntExpr'
 742 mkIntLit      :: Integer -> Expr b
 743 -- | Create a machine integer literal expression of type @Int#@ from an @Int@.
 744 -- If you want an expression of type @Int@ use 'MkCore.mkIntExpr'
 745 mkIntLitInt   :: Int     -> Expr b
 746
 747 mkIntLit    n = Lit (mkMachInt n)
 748 mkIntLitInt n = Lit (mkMachInt (toInteger n))
 749
 750 -- | Create a machine word literal expression of type  @Word#@ from an @Integer@.
 751 -- If you want an expression of type @Word@ use 'MkCore.mkWordExpr'
 752 mkWordLit     :: Integer -> Expr b
 753 -- | Create a machine word literal expression of type  @Word#@ from a @Word@.
 754 -- If you want an expression of type @Word@ use 'MkCore.mkWordExpr'
 755 mkWordLitWord :: Word -> Expr b
 756
 757 mkWordLit     w = Lit (mkMachWord w)
 758 mkWordLitWord w = Lit (mkMachWord (toInteger w))
 759
 760 -- | Create a machine character literal expression of type @Char#@.
 761 -- If you want an expression of type @Char@ use 'MkCore.mkCharExpr'
 762 mkCharLit :: Char -> Expr b
 763 -- | Create a machine string literal expression of type @Addr#@.
 764 -- If you want an expression of type @String@ use 'MkCore.mkStringExpr'
 765 mkStringLit :: String -> Expr b
 766
 767 mkCharLit   c = Lit (mkMachChar c)
 768 mkStringLit s = Lit (mkMachString s)
 769
 770 -- | Create a machine single precision literal expression of type @Float#@ from a @Rational@.
 771 -- If you want an expression of type @Float@ use 'MkCore.mkFloatExpr'
 772 mkFloatLit :: Rational -> Expr b
 773 -- | Create a machine single precision literal expression of type @Float#@ from a @Float@.
 774 -- If you want an expression of type @Float@ use 'MkCore.mkFloatExpr'
 775 mkFloatLitFloat :: Float -> Expr b
 776
 777 mkFloatLit      f = Lit (mkMachFloat f)
 778 mkFloatLitFloat f = Lit (mkMachFloat (toRational f))
 779
 780 -- | Create a machine double precision literal expression of type @Double#@ from a @Rational@.
 781 -- If you want an expression of type @Double@ use 'MkCore.mkDoubleExpr'
 782 mkDoubleLit :: Rational -> Expr b
 783 -- | Create a machine double precision literal expression of type @Double#@ from a @Double@.
 784 -- If you want an expression of type @Double@ use 'MkCore.mkDoubleExpr'
 785 mkDoubleLitDouble :: Double -> Expr b
 786
 787 mkDoubleLit       d = Lit (mkMachDouble d)
 788 mkDoubleLitDouble d = Lit (mkMachDouble (toRational d))
 789
 790 -- | Bind all supplied binding groups over an expression in a nested let expression. Prefer to
 791 -- use 'CoreUtils.mkCoreLets' if possible
 792 mkLets        :: [Bind b] -> Expr b -> Expr b
 793 -- | Bind all supplied binders over an expression in a nested lambda expression. Prefer to
 794 -- use 'CoreUtils.mkCoreLams' if possible
 795 mkLams        :: [b] -> Expr b -> Expr b
 796
 797 mkLams binders body = foldr Lam body binders
 798 mkLets binds body   = foldr Let body binds
 799
 800
 801 -- | Create a binding group where a type variable is bound to a type. Per "CoreSyn#type_let",
 802 -- this can only be used to bind something in a non-recursive @let@ expression
 803 mkTyBind :: TyVar -> Type -> CoreBind
 804 mkTyBind tv ty      = NonRec tv (Type ty)
 805
 806 -- | Convert a binder into either a 'Var' or 'Type' 'Expr' appropriately
 807 varToCoreExpr :: CoreBndr -> Expr b
 808 varToCoreExpr v | isId v = Var v
 809                 | otherwise = Type (mkTyVarTy v)
 810
 811 varsToCoreExprs :: [CoreBndr] -> [Expr b]
 812 varsToCoreExprs vs = map varToCoreExpr vs
 813 \end{code}
 814
 815
 816 %************************************************************************
 817 %*                                                                      *
 818 \subsection{Simple access functions}
 819 %*                                                                      *
 820 %************************************************************************
 821
 822 \begin{code}
 823 -- | Extract every variable by this group
 824 bindersOf  :: Bind b -> [b]
 825 bindersOf (NonRec binder _) = [binder]
 826 bindersOf (Rec pairs)       = [binder | (binder, _) <- pairs]
 827
 828 -- | 'bindersOf' applied to a list of binding groups
 829 bindersOfBinds :: [Bind b] -> [b]
 830 bindersOfBinds binds = foldr ((++) . bindersOf) [] binds
 831
 832 rhssOfBind :: Bind b -> [Expr b]
 833 rhssOfBind (NonRec _ rhs) = [rhs]
 834 rhssOfBind (Rec pairs)    = [rhs | (_,rhs) <- pairs]
 835
 836 rhssOfAlts :: [Alt b] -> [Expr b]
 837 rhssOfAlts alts = [e | (_,_,e) <- alts]
 838
 839 -- | Collapse all the bindings in the supplied groups into a single
 840 -- list of lhs\/rhs pairs suitable for binding in a 'Rec' binding group
 841 flattenBinds :: [Bind b] -> [(b, Expr b)]
 842 flattenBinds (NonRec b r : binds) = (b,r) : flattenBinds binds
 843 flattenBinds (Rec prs1   : binds) = prs1 ++ flattenBinds binds
 844 flattenBinds []                   = []
 845 \end{code}
 846
 847 \begin{code}
 848 -- | We often want to strip off leading lambdas before getting down to
 849 -- business. This function is your friend.
 850 collectBinders               :: Expr b -> ([b],         Expr b)
 851 -- | Collect as many type bindings as possible from the front of a nested lambda
 852 collectTyBinders             :: CoreExpr -> ([TyVar],     CoreExpr)
 853 -- | Collect as many value bindings as possible from the front of a nested lambda
 854 collectValBinders            :: CoreExpr -> ([Id],        CoreExpr)
 855 -- | Collect type binders from the front of the lambda first,
 856 -- then follow up by collecting as many value bindings as possible
 857 -- from the resulting stripped expression
 858 collectTyAndValBinders       :: CoreExpr -> ([TyVar], [Id], CoreExpr)
 859
 860 collectBinders expr
 861   = go [] expr
 862   where
 863     go bs (Lam b e) = go (b:bs) e
 864     go bs e          = (reverse bs, e)
 865
 866 collectTyAndValBinders expr
 867   = (tvs, ids, body)
 868   where
 869     (tvs, body1) = collectTyBinders expr
 870     (ids, body)  = collectValBinders body1
 871
 872 collectTyBinders expr
 873   = go [] expr
 874   where
 875     go tvs (Lam b e) | isTyVar b = go (b:tvs) e
 876     go tvs e                     = (reverse tvs, e)
 877
 878 collectValBinders expr
 879   = go [] expr
 880   where
 881     go ids (Lam b e) | isId b = go (b:ids) e
 882     go ids body               = (reverse ids, body)
 883 \end{code}
 884
 885 \begin{code}
 886 -- | Takes a nested application expression and returns the the function
 887 -- being applied and the arguments to which it is applied
 888 collectArgs :: Expr b -> (Expr b, [Arg b])
 889 collectArgs expr
 890   = go expr []
 891   where
 892     go (App f a) as = go f (a:as)
 893     go e         as = (e, as)
 894 \end{code}
 895
 896 \begin{code}
 897 -- | Gets the cost centre enclosing an expression, if any.
 898 -- It looks inside lambdas because @(scc \"foo\" \\x.e) = \\x. scc \"foo\" e@
 899 coreExprCc :: Expr b -> CostCentre
 900 coreExprCc (Note (SCC cc) _)   = cc
 901 coreExprCc (Note _ e)          = coreExprCc e
 902 coreExprCc (Lam _ e)           = coreExprCc e
 903 coreExprCc _                   = noCostCentre
 904 \end{code}
 905
 906 %************************************************************************
 907 %*                                                                      *
 908 \subsection{Predicates}
 909 %*                                                                      *
 910 %************************************************************************
 911
 912 At one time we optionally carried type arguments through to runtime.
 913 @isRuntimeVar v@ returns if (Lam v _) really becomes a lambda at runtime,
 914 i.e. if type applications are actual lambdas because types are kept around
 915 at runtime.  Similarly isRuntimeArg.
 916
 917 \begin{code}
 918 -- | Will this variable exist at runtime?
 919 isRuntimeVar :: Var -> Bool
 920 isRuntimeVar = isId
 921
 922 -- | Will this argument expression exist at runtime?
 923 isRuntimeArg :: CoreExpr -> Bool
 924 isRuntimeArg = isValArg
 925
 926 -- | Returns @False@ iff the expression is a 'Type' expression at its top level
 927 isValArg :: Expr b -> Bool
 928 isValArg (Type _) = False
 929 isValArg _        = True
 930
 931 -- | Returns @True@ iff the expression is a 'Type' expression at its top level
 932 isTypeArg :: Expr b -> Bool
 933 isTypeArg (Type _) = True
 934 isTypeArg _        = False
 935
 936 -- | The number of binders that bind values rather than types
 937 valBndrCount :: [CoreBndr] -> Int
 938 valBndrCount = count isId
 939
 940 -- | The number of argument expressions that are values rather than types at their top level
 941 valArgCount :: [Arg b] -> Int
 942 valArgCount = count isValArg
 943 \end{code}
 944
 945
 946 %************************************************************************
 947 %*                                                                      *
 948 \subsection{Seq stuff}
 949 %*                                                                      *
 950 %************************************************************************
 951
 952 \begin{code}
 953 seqExpr :: CoreExpr -> ()
 954 seqExpr (Var v)         = v `seq` ()
 955 seqExpr (Lit lit)       = lit `seq` ()
 956 seqExpr (App f a)       = seqExpr f `seq` seqExpr a
 957 seqExpr (Lam b e)       = seqBndr b `seq` seqExpr e
 958 seqExpr (Let b e)       = seqBind b `seq` seqExpr e
 959 seqExpr (Case e b t as) = seqExpr e `seq` seqBndr b `seq` seqType t `seq` seqAlts as
 960 seqExpr (Cast e co)     = seqExpr e `seq` seqType co
 961 seqExpr (Note n e)      = seqNote n `seq` seqExpr e
 962 seqExpr (Type t)        = seqType t
 963
 964 seqExprs :: [CoreExpr] -> ()
 965 seqExprs [] = ()
 966 seqExprs (e:es) = seqExpr e `seq` seqExprs es
 967
 968 seqNote :: Note -> ()
 969 seqNote (CoreNote s)   = s `seq` ()
 970 seqNote _              = ()
 971
 972 seqBndr :: CoreBndr -> ()
 973 seqBndr b = b `seq` ()
 974
 975 seqBndrs :: [CoreBndr] -> ()
 976 seqBndrs [] = ()
 977 seqBndrs (b:bs) = seqBndr b `seq` seqBndrs bs
 978
 979 seqBind :: Bind CoreBndr -> ()
 980 seqBind (NonRec b e) = seqBndr b `seq` seqExpr e
 981 seqBind (Rec prs)    = seqPairs prs
 982
 983 seqPairs :: [(CoreBndr, CoreExpr)] -> ()
 984 seqPairs [] = ()
 985 seqPairs ((b,e):prs) = seqBndr b `seq` seqExpr e `seq` seqPairs prs
 986
 987 seqAlts :: [CoreAlt] -> ()
 988 seqAlts [] = ()
 989 seqAlts ((c,bs,e):alts) = c `seq` seqBndrs bs `seq` seqExpr e `seq` seqAlts alts
 990
 991 seqRules :: [CoreRule] -> ()
 992 seqRules [] = ()
 993 seqRules (Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs } : rules)
 994   = seqBndrs bndrs `seq` seqExprs (rhs:args) `seq` seqRules rules
 995 seqRules (BuiltinRule {} : rules) = seqRules rules
 996 \end{code}
 997
 998 %************************************************************************
 999 %*                                                                      *
1000 \subsection{Annotated core}
1001 %*                                                                      *
1002 %************************************************************************
1003
1004 \begin{code}
1005 -- | Annotated core: allows annotation at every node in the tree
1006 type AnnExpr bndr annot = (annot, AnnExpr' bndr annot)
1007
1008 -- | A clone of the 'Expr' type but allowing annotation at every tree node
1009 data AnnExpr' bndr annot
1010   = AnnVar      Id
1011   | AnnLit      Literal
1012   | AnnLam      bndr (AnnExpr bndr annot)
1013   | AnnApp      (AnnExpr bndr annot) (AnnExpr bndr annot)
1014   | AnnCase     (AnnExpr bndr annot) bndr Type [AnnAlt bndr annot]
1015   | AnnLet      (AnnBind bndr annot) (AnnExpr bndr annot)
1016   | AnnCast     (AnnExpr bndr annot) Coercion
1017   | AnnNote     Note (AnnExpr bndr annot)
1018   | AnnType     Type
1019
1020 -- | A clone of the 'Alt' type but allowing annotation at every tree node
1021 type AnnAlt bndr annot = (AltCon, [bndr], AnnExpr bndr annot)
1022
1023 -- | A clone of the 'Bind' type but allowing annotation at every tree node
1024 data AnnBind bndr annot
1025   = AnnNonRec bndr (AnnExpr bndr annot)
1026   | AnnRec    [(bndr, AnnExpr bndr annot)]
1027 \end{code}
1028
1029 \begin{code}
1030 deAnnotate :: AnnExpr bndr annot -> Expr bndr
1031 deAnnotate (_, e) = deAnnotate' e
1032
1033 deAnnotate' :: AnnExpr' bndr annot -> Expr bndr
1034 deAnnotate' (AnnType t)           = Type t
1035 deAnnotate' (AnnVar  v)           = Var v
1036 deAnnotate' (AnnLit  lit)         = Lit lit
1037 deAnnotate' (AnnLam  binder body) = Lam binder (deAnnotate body)
1038 deAnnotate' (AnnApp  fun arg)     = App (deAnnotate fun) (deAnnotate arg)
1039 deAnnotate' (AnnCast e co)        = Cast (deAnnotate e) co
1040 deAnnotate' (AnnNote note body)   = Note note (deAnnotate body)
1041
1042 deAnnotate' (AnnLet bind body)
1043   = Let (deAnnBind bind) (deAnnotate body)
1044   where
1045     deAnnBind (AnnNonRec var rhs) = NonRec var (deAnnotate rhs)
1046     deAnnBind (AnnRec pairs) = Rec [(v,deAnnotate rhs) | (v,rhs) <- pairs]
1047
1048 deAnnotate' (AnnCase scrut v t alts)
1049   = Case (deAnnotate scrut) v t (map deAnnAlt alts)
1050
1051 deAnnAlt :: AnnAlt bndr annot -> Alt bndr
1052 deAnnAlt (con,args,rhs) = (con,args,deAnnotate rhs)
1053 \end{code}
1054
1055 \begin{code}
1056 -- | As 'collectBinders' but for 'AnnExpr' rather than 'Expr'
1057 collectAnnBndrs :: AnnExpr bndr annot -> ([bndr], AnnExpr bndr annot)
1058 collectAnnBndrs e
1059   = collect [] e
1060   where
1061     collect bs (_, AnnLam b body) = collect (b:bs) body
1062     collect bs body               = (reverse bs, body)
1063 \end{code}