CoreSyn.lhs 53.1 KB
 partain committed Jan 08, 1996 1 %  Simon Marlow committed Oct 11, 2006 2 % (c) The University of Glasgow 2006  simonm committed Dec 02, 1998 3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998  partain committed Jan 08, 1996 4 %  Simon Marlow committed Oct 11, 2006 5   partain committed Jan 08, 1996 6 \begin{code}  simonpj@microsoft.com committed Dec 13, 2010 7 {-# LANGUAGE DeriveDataTypeable, DeriveFunctor #-}  batterseapower committed Jul 31, 2008 8   Ian Lynagh committed Nov 04, 2011 9 10 11 12 13 14 15 {-# OPTIONS -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces -- for details  batterseapower committed Jul 31, 2008 16 -- | CoreSyn holds all the main data types for use by for the Glasgow Haskell Compiler midsection  partain committed Jan 08, 1996 17 module CoreSyn (  batterseapower committed Jul 31, 2008 18  -- * Main data types  Simon Marlow committed Nov 02, 2011 19 20 21  Expr(..), Alt, Bind(..), AltCon(..), Arg, Tickish(..), CoreProgram, CoreExpr, CoreAlt, CoreBind, CoreArg, CoreBndr, TaggedExpr, TaggedAlt, TaggedBind, TaggedArg, TaggedBndr(..),  simonm committed Dec 02, 1998 22   batterseapower committed Jul 31, 2008 23 24  -- ** 'Expr' construction mkLets, mkLams,  25  mkApps, mkTyApps, mkCoApps, mkVarApps,  batterseapower committed Jul 31, 2008 26 27 28  mkIntLit, mkIntLitInt, mkWordLit, mkWordLitWord,  Ian Lynagh committed Jan 11, 2012 29  mkWord64LitWord64, mkInt64LitInt64,  batterseapower committed Jul 31, 2008 30 31 32 33  mkCharLit, mkStringLit, mkFloatLit, mkFloatLitFloat, mkDoubleLit, mkDoubleLitDouble,  34  mkConApp, mkTyBind, mkCoBind,  chak@cse.unsw.edu.au. committed Aug 04, 2006 35  varToCoreExpr, varsToCoreExprs,  simonm committed Dec 02, 1998 36   37  isId, cmpAltCon, cmpAlt, ltAlt,  batterseapower committed Jul 31, 2008 38 39  -- ** Simple 'Expr' access functions and predicates  simonpj committed Nov 14, 2000 40  bindersOf, bindersOfBinds, rhssOfBind, rhssOfAlts,  simonm committed Dec 02, 1998 41  collectBinders, collectTyBinders, collectValBinders, collectTyAndValBinders,  Simon Marlow committed Dec 02, 2011 42  collectArgs, flattenBinds,  simonm committed Dec 02, 1998 43   44 45  isValArg, isTypeArg, isTyCoArg, valArgCount, valBndrCount, isRuntimeArg, isRuntimeVar,  simonm committed Dec 02, 1998 46   Simon Marlow committed Nov 02, 2011 47 48 49 50  tickishCounts, tickishScoped, tickishIsCode, mkNoTick, mkNoScope, tickishCanSplit, -- * Unfolding data types  simonpj@microsoft.com committed Dec 13, 2010 51  Unfolding(..), UnfoldingGuidance(..), UnfoldingSource(..),  Simon Peyton Jones committed Jun 27, 2012 52  DFunArg(..), dfunArgExprs,  simonpj@microsoft.com committed Dec 13, 2010 53   batterseapower committed Jul 31, 2008 54  -- ** Constructing 'Unfolding's  simonpj committed Jan 31, 2005 55  noUnfolding, evaldUnfolding, mkOtherCon,  simonpj@microsoft.com committed Dec 02, 2009 56  unSaturatedOk, needSaturated, boringCxtOk, boringCxtNotOk,  batterseapower committed Jul 31, 2008 57 58  -- ** Predicates and deconstruction on 'Unfolding'  simonpj@microsoft.com committed Dec 16, 2009 59  unfoldingTemplate, setUnfoldingTemplate, expandUnfolding_maybe,  simonpj@microsoft.com committed Oct 29, 2009 60  maybeUnfoldingTemplate, otherCons, unfoldingArity,  simonpj@microsoft.com committed Mar 18, 2009 61  isValueUnfolding, isEvaldUnfolding, isCheapUnfolding,  simonpj@microsoft.com committed Dec 02, 2009 62  isExpandableUnfolding, isConLikeUnfolding, isCompulsoryUnfolding,  simonpj@microsoft.com committed Nov 16, 2010 63  isStableUnfolding, isStableCoreUnfolding_maybe,  simonpj@microsoft.com committed Sep 15, 2010 64 65  isClosedUnfolding, hasSomeUnfolding, canUnfold, neverUnfoldGuidance, isStableSource,  simonpj committed Jul 14, 1999 66   batterseapower committed Jul 31, 2008 67  -- * Strictness  simonpj committed Apr 28, 2005 68  seqExpr, seqExprs, seqUnfolding,  simonpj committed Jul 14, 1999 69   batterseapower committed Jul 31, 2008 70 71 72  -- * Annotated expression data types AnnExpr, AnnExpr'(..), AnnBind(..), AnnAlt,  Simon Marlow committed Oct 08, 2010 73 74 75  -- ** Operations on annotated expressions collectAnnArgs,  batterseapower committed Jul 31, 2008 76  -- ** Operations on annotations  simonpj committed Dec 14, 2001 77  deAnnotate, deAnnotate', deAnnAlt, collectAnnBndrs,  simonpj committed May 18, 1999 78   batterseapower committed Jul 31, 2008 79  -- * Core rule data types  simonpj committed May 18, 1999 80  CoreRule(..), -- CoreSubst, CoreTidy, CoreFVs, PprCore only  simonpj@microsoft.com committed Dec 02, 2009 81  RuleName, IdUnfoldingFun,  batterseapower committed Jul 31, 2008 82 83  -- ** Operations on 'CoreRule's  simonpj@microsoft.com committed Nov 16, 2010 84  seqRules, ruleArity, ruleName, ruleIdName, ruleActivation,  batterseapower committed Jul 31, 2008 85  setRuleIdName,  chak@cse.unsw.edu.au. committed Feb 20, 2011 86 87 88 89  isBuiltinRule, isLocalRule, -- * Core vectorisation declarations data type CoreVect(..)  partain committed Jan 08, 1996 90 91  ) where  simonm committed Jan 08, 1998 92 #include "HsVersions.h"  partain committed Mar 19, 1996 93   Simon Marlow committed Oct 11, 2006 94 95 96 97 98 99 100 import CostCentre import Var import Type import Coercion import Name import Literal import DataCon  Simon Marlow committed Nov 02, 2011 101 import Module  chak@cse.unsw.edu.au. committed Aug 19, 2011 102 import TyCon  Simon Marlow committed Oct 11, 2006 103 import BasicTypes  simonmar committed Apr 29, 2002 104 import FastString  simonm committed Dec 02, 1998 105 import Outputable  twanvl committed Jan 18, 2008 106 import Util  simonpj@microsoft.com committed Jul 26, 2006 107   chak@cse.unsw.edu.au. committed Aug 19, 2011 108 import Data.Data hiding (TyCon)  Ian Lynagh committed Jan 11, 2012 109 import Data.Int  batterseapower committed Jul 31, 2008 110 111 import Data.Word  112 infixl 4 mkApps, mkTyApps, mkVarApps, App, mkCoApps  simonpj@microsoft.com committed Jul 26, 2006 113 -- Left associative, so that we can say (f mkTyApps xs mkVarApps ys)  partain committed Jan 08, 1996 114 115 116 117 \end{code} %************************************************************************ %* *  simonm committed Dec 02, 1998 118 \subsection{The main data types}  partain committed Jan 08, 1996 119 120 121 %* * %************************************************************************  simonm committed Dec 02, 1998 122 These data types are the heart of the compiler  partain committed Jan 08, 1996 123   partain committed Mar 19, 1996 124 \begin{code}  batterseapower committed Jul 31, 2008 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 -- | This is the data type that represents GHCs core intermediate language. Currently -- GHC uses System FC for this purpose, -- which is closely related to the simpler and better known System F . -- -- We get from Haskell source to this Core language in a number of stages: -- -- 1. The source code is parsed into an abstract syntax tree, which is represented -- by the data type 'HsExpr.HsExpr' with the names being 'RdrName.RdrNames' -- -- 2. This syntax tree is /renamed/, which attaches a 'Unique.Unique' to every 'RdrName.RdrName' -- (yielding a 'Name.Name') to disambiguate identifiers which are lexically identical. -- For example, this program: -- -- @ -- f x = let f x = x + 1 -- in f (x - 2) -- @ -- -- Would be renamed by having 'Unique's attached so it looked something like this: -- -- @ -- f_1 x_2 = let f_3 x_4 = x_4 + 1 -- in f_3 (x_2 - 2) -- @ -- -- 3. The resulting syntax tree undergoes type checking (which also deals with instantiating -- type class arguments) to yield a 'HsExpr.HsExpr' type that has 'Id.Id' as it's names. -- -- 4. Finally the syntax tree is /desugared/ from the expressive 'HsExpr.HsExpr' type into -- this 'Expr' type, which has far fewer constructors and hence is easier to perform -- optimization, analysis and code generation on. -- -- The type parameter @b@ is for the type of binders in the expression tree.  batterseapower committed Jul 26, 2011 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 -- -- The language consists of the following elements: -- -- * Variables -- -- * Primitive literals -- -- * Applications: note that the argument may be a 'Type'. -- -- See "CoreSyn#let_app_invariant" for another invariant -- -- * Lambda abstraction -- -- * Recursive and non recursive @let@s. Operationally -- this corresponds to allocating a thunk for the things -- bound and then executing the sub-expression. -- -- #top_level_invariant# -- #letrec_invariant# -- -- The right hand sides of all top-level and recursive @let@s -- /must/ be of lifted type (see "Type#type_classification" for -- the meaning of /lifted/ vs. /unlifted/). -- -- #let_app_invariant# -- The right hand side of of a non-recursive 'Let' -- _and_ the argument of an 'App', -- /may/ be of unlifted type, but only if the expression -- is ok-for-speculation. This means that the let can be floated -- around without difficulty. For example, this is OK: -- -- > y::Int# = x +# 1# -- -- But this is not, as it may affect termination if the -- expression is floated out: -- -- > y::Int# = fac 4# -- -- In this situation you should use @case@ rather than a @let@. The function -- 'CoreUtils.needsCaseBinding' can help you determine which to generate, or -- alternatively use 'MkCore.mkCoreLet' rather than this constructor directly, -- which will generate a @case@ if necessary -- -- #type_let# -- We allow a /non-recursive/ let to bind a type variable, thus: -- -- > Let (NonRec tv (Type ty)) body -- -- This can be very convenient for postponing type substitutions until -- the next run of the simplifier. -- -- At the moment, the rest of the compiler only deals with type-let -- in a Let expression, rather than at top level. We may want to revist -- this choice. -- -- * Case split. Operationally this corresponds to evaluating -- the scrutinee (expression examined) to weak head normal form -- and then examining at most one level of resulting constructor (i.e. you -- cannot do nested pattern matching directly with this). -- -- The binder gets bound to the value of the scrutinee, -- and the 'Type' must be that of all the case alternatives -- -- #case_invariants# -- This is one of the more complicated elements of the Core language, -- and comes with a number of restrictions: --  Simon Peyton Jones committed May 02, 2012 225 226 -- 1. The list of alternatives may be empty; -- See Note [Empty case alternatives]  Simon Peyton Jones committed Sep 05, 2011 227 228 229 -- -- 2. The 'DEFAULT' case alternative must be first in the list, -- if it occurs at all.  batterseapower committed Jul 26, 2011 230 --  Simon Peyton Jones committed Sep 05, 2011 231 -- 3. The remaining cases are in order of increasing  batterseapower committed Jul 26, 2011 232 233 -- tag (for 'DataAlts') or -- lit (for 'LitAlts').  Simon Peyton Jones committed Sep 05, 2011 234 235 -- This makes finding the relevant constructor easy, -- and makes comparison easier too.  batterseapower committed Jul 26, 2011 236 --  Simon Peyton Jones committed Sep 05, 2011 237 238 -- 4. The list of alternatives must be exhaustive. An /exhaustive/ case -- does not necessarily mention all constructors:  batterseapower committed Jul 26, 2011 239 --  Simon Peyton Jones committed Sep 05, 2011 240 241 242 243 244 245 246 247 -- @ -- data Foo = Red | Green | Blue -- ... case x of -- Red -> True -- other -> f (case x of -- Green -> ... -- Blue -> ... ) ... -- @  batterseapower committed Jul 26, 2011 248 --  Simon Peyton Jones committed Sep 05, 2011 249 250 -- The inner case does not need a @Red@ alternative, because @x@ -- can't be @Red@ at that program point.  batterseapower committed Jul 26, 2011 251 252 253 254 255 256 257 258 259 260 261 -- -- * Cast an expression to a particular type. -- This is used to implement @newtype@s (a @newtype@ constructor or -- destructor just becomes a 'Cast' in Core) and GADTs. -- -- * Notes. These allow general information to be added to expressions -- in the syntax tree -- -- * A type: this should only show up at the top level of an Arg -- -- * A coercion  batterseapower committed Jul 31, 2008 262 data Expr b  batterseapower committed Jul 26, 2011 263 264 265 266 267  = Var Id | Lit Literal | App (Expr b) (Arg b) | Lam b (Expr b) | Let (Bind b) (Expr b)  Simon Peyton Jones committed Sep 05, 2011 268  | Case (Expr b) b Type [Alt b] -- See #case_invariant#  batterseapower committed Jul 26, 2011 269  | Cast (Expr b) Coercion  Simon Marlow committed Nov 02, 2011 270  | Tick (Tickish Id) (Expr b)  batterseapower committed Jul 26, 2011 271 272  | Type Type | Coercion Coercion  waern committed Mar 30, 2010 273  deriving (Data, Typeable)  batterseapower committed Jul 31, 2008 274 275 276 277 278 279 280 281 282 283 284  -- | Type synonym for expressions that occur in function argument positions. -- Only 'Arg' should contain a 'Type' at top level, general 'Expr' should not type Arg b = Expr b -- | A case split alternative. Consists of the constructor leading to the alternative, -- the variables bound from the constructor, and the expression to be executed given that binding. -- The default alternative is @(DEFAULT, [], rhs)@ type Alt b = (AltCon, [b], Expr b) -- | A case alternative constructor (i.e. pattern match)  Simon Peyton Jones committed Nov 09, 2011 285 286 287 288 289 290 291 292 293 294 data AltCon = DataAlt DataCon -- ^ A plain data constructor: @case e of { Foo x -> ... }@. -- Invariant: the 'DataCon' is always from a @data@ type, and never from a @newtype@ | LitAlt Literal -- ^ A literal: @case e of { 1 -> ... }@ -- Invariant: always an *unlifted* literal -- See Note [Literal alternatives] | DEFAULT -- ^ Trivial alternative: @case e of { _ -> ... }@ deriving (Eq, Ord, Data, Typeable)  simonm committed Dec 02, 1998 295   batterseapower committed Jul 31, 2008 296 -- | Binding, used for top level bindings in a module and local bindings in a @let@.  simonpj committed Dec 18, 1998 297 data Bind b = NonRec b (Expr b)  batterseapower committed Jul 31, 2008 298  | Rec [(b, (Expr b))]  waern committed Mar 30, 2010 299  deriving (Data, Typeable)  simonpj@microsoft.com committed Feb 05, 2007 300 301 \end{code}  Simon Peyton Jones committed Nov 09, 2011 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 Note [Literal alternatives] ~~~~~~~~~~~~~~~~~~~~~~~~~~~ Literal alternatives (LitAlt lit) are always for *un-lifted* literals. We have one literal, a literal Integer, that is lifted, and we don't allow in a LitAlt, because LitAlt cases don't do any evaluation. Also (see Trac #5603) if you say case 3 of S# x -> ... J# _ _ -> ... (where S#, J# are the constructors for Integer) we don't want the simplifier calling findAlt with argument (LitAlt 3). No no. Integer literals are an opaque encoding of an algebraic data type, not of an unlifted literal, like all the others.  simonpj@microsoft.com committed Feb 05, 2007 317 318 319 320 -------------------------- CoreSyn INVARIANTS --------------------------- Note [CoreSyn top-level invariant] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~  batterseapower committed Jul 31, 2008 321 See #toplevel_invariant#  simonpj@microsoft.com committed Feb 05, 2007 322 323 324  Note [CoreSyn letrec invariant] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~  batterseapower committed Jul 31, 2008 325 See #letrec_invariant#  simonpj@microsoft.com committed Feb 05, 2007 326 327 328  Note [CoreSyn let/app invariant] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~  batterseapower committed Jul 31, 2008 329 330 331 See #let_app_invariant# This is intially enforced by DsUtils.mkCoreLet and mkCoreApp  simonpj@microsoft.com committed Feb 05, 2007 332 333 334  Note [CoreSyn case invariants] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~  batterseapower committed Jul 31, 2008 335 See #case_invariants#  simonpj@microsoft.com committed Feb 05, 2007 336 337  Note [CoreSyn let goal]  simonpj@microsoft.com committed Jun 05, 2008 338 ~~~~~~~~~~~~~~~~~~~~~~~  simonpj@microsoft.com committed Feb 05, 2007 339 340 341 342 * The simplifier tries to ensure that if the RHS of a let is a constructor application, its arguments are trivial, so that the constructor can be inlined vigorously.  simonpj@microsoft.com committed Jun 05, 2008 343 344 Note [Type let] ~~~~~~~~~~~~~~~  batterseapower committed Jul 31, 2008 345 See #type_let#  simonpj@microsoft.com committed Jun 05, 2008 346   Simon Peyton Jones committed May 02, 2012 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 Note [Empty case alternatives] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The alternatives of a case expression should be exhaustive. A case expression can have empty alternatives if (and only if) the scrutinee is bound to raise an exception or diverge. So: Case (error Int "Hello") b Bool [] is fine, and has type Bool. This is one reason we need a type on the case expression: if the alternatives are empty we can't get the type from the alternatives! I'll write this case (error Int "Hello") of Bool {} with the return type just before the alterantives. Here's another example: data T f :: T -> Bool f = \(x:t). case x of Bool {} Since T has no data constructors, the case alterantives are of course empty. However note that 'x' is not bound to a visbily-bottom value; it's the *type* that tells us it's going to diverge. Its a bit of a degnerate situation but we do NOT want to replace case x of Bool {} --> error Bool "Inaccessible case" because x might raise an exception, and *that*'s what we want to see! (Trac #6067 is an example.) To preserve semantics we'd have to say x seq error Bool "Inaccessible case" but the 'seq' is just a case, so we are back to square 1. Or I suppose we could say x |> UnsafeCoerce T Bool but that loses all trace of the fact that this originated with an empty set of alternatives. We can use the empty-alternative construct to coerce error values from one type to another. For example f :: Int -> Int f n = error "urk" g :: Int -> (# Char, Bool #) g x = case f x of { 0 -> ..., n -> ... } Then if we inline f in g's RHS we get case (error Int "urk") of (# Char, Bool #) { ... } and we can discard the alternatives since the scrutinee is bottom to give case (error Int "urk") of (# Char, Bool #) {} This is nicer than using an unsafe coerce between Int ~ (# Char,Bool #), if for no other reason that we don't need to instantiate the (~) at an unboxed type.  Simon Peyton Jones committed Jan 12, 2012 396 397 398 399 400 401 %************************************************************************ %* * Ticks %* * %************************************************************************  simonpj@microsoft.com committed Feb 05, 2007 402 \begin{code}  Simon Marlow committed Nov 02, 2011 403 404 405 406 407 408 409 410 411 412 413 -- | Allows attaching extra information to points in expressions data Tickish id = -- | An @{-# SCC #-}@ profiling annotation, either automatically -- added by the desugarer as a result of -auto-all, or added by -- the user. ProfNote { profNoteCC :: CostCentre, -- ^ the cost centre profNoteCount :: !Bool, -- ^ bump the entry count? profNoteScope :: !Bool -- ^ scopes over the enclosed expression -- (i.e. not just a tick) }  batterseapower committed Jul 31, 2008 414   Simon Marlow committed Nov 02, 2011 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481  -- | A "tick" used by HPC to track the execution of each -- subexpression in the original source code. | HpcTick { tickModule :: Module, tickId :: !Int } -- | A breakpoint for the GHCi debugger. This behaves like an HPC -- tick, but has a list of free variables which will be available -- for inspection in GHCi when the program stops at the breakpoint. -- -- NB. we must take account of these Ids when (a) counting free variables, -- and (b) substituting (don't substitute for them) | Breakpoint { breakpointId :: !Int , breakpointFVs :: [id] -- ^ the order of this list is important: -- it matches the order of the lists in the -- appropriate entry in HscTypes.ModBreaks. -- -- Careful about substitution! See -- Note [substTickish] in CoreSubst. } deriving (Eq, Ord, Data, Typeable) -- | A "tick" note is one that counts evaluations in some way. We -- cannot discard a tick, and the compiler should preserve the number -- of ticks as far as possible. -- -- Hwever, we stil allow the simplifier to increase or decrease -- sharing, so in practice the actual number of ticks may vary, except -- that we never change the value from zero to non-zero or vice versa. -- tickishCounts :: Tickish id -> Bool tickishCounts n@ProfNote{} = profNoteCount n tickishCounts HpcTick{} = True tickishCounts Breakpoint{} = True tickishScoped :: Tickish id -> Bool tickishScoped n@ProfNote{} = profNoteScope n tickishScoped HpcTick{} = False tickishScoped Breakpoint{} = True -- Breakpoints are scoped: eventually we're going to do call -- stacks, but also this helps prevent the simplifier from moving -- breakpoints around and changing their result type (see #1531). mkNoTick :: Tickish id -> Tickish id mkNoTick n@ProfNote{} = n {profNoteCount = False} mkNoTick Breakpoint{} = panic "mkNoTick: Breakpoint" -- cannot split a BP mkNoTick t = t mkNoScope :: Tickish id -> Tickish id mkNoScope n@ProfNote{} = n {profNoteScope = False} mkNoScope Breakpoint{} = panic "mkNoScope: Breakpoint" -- cannot split a BP mkNoScope t = t -- | Return True if this source annotation compiles to some code, or will -- disappear before the backend. tickishIsCode :: Tickish id -> Bool tickishIsCode _tickish = True -- all of them for now -- | Return True if this Tick can be split into (tick,scope) parts with -- 'mkNoScope' and 'mkNoTick' respectively. tickishCanSplit :: Tickish Id -> Bool tickishCanSplit Breakpoint{} = False tickishCanSplit _ = True  partain committed Mar 19, 1996 482 \end{code}  partain committed Jan 08, 1996 483   simonm committed Dec 02, 1998 484   simonpj committed May 18, 1999 485 486 487 488 489 490 491 492 493 %************************************************************************ %* * \subsection{Transformation rules} %* * %************************************************************************ The CoreRule type and its friends are dealt with mainly in CoreRules, but CoreFVs, Subst, PprCore, CoreTidy also inspect the representation.  simonpj committed May 25, 2000 494 \begin{code}  batterseapower committed Jul 31, 2008 495 496 497 498 499 500 501 -- | A 'CoreRule' is: -- -- * \"Local\" if the function it is a rule for is defined in the -- same module as the rule itself. -- -- * \"Orphan\" if nothing on the LHS is defined in the same module -- as the rule itself  simonpj committed May 18, 1999 502 data CoreRule  simonpj committed Apr 28, 2005 503  = Rule {  batterseapower committed Jul 31, 2008 504 505  ru_name :: RuleName, -- ^ Name of the rule, for communication with the user ru_act :: Activation, -- ^ When the rule is active  simonpj@microsoft.com committed Oct 07, 2010 506   simonpj committed Apr 28, 2005 507  -- Rough-matching stuff  Simon Peyton Jones committed Jan 03, 2012 508  -- see comments with InstEnv.ClsInst( is_cls, is_rough )  batterseapower committed Jul 31, 2008 509 510  ru_fn :: Name, -- ^ Name of the 'Id.Id' at the head of this rule ru_rough :: [Maybe Name], -- ^ Name at the head of each argument to the left hand side  simonpj committed Apr 28, 2005 511 512  -- Proper-matching stuff  Simon Peyton Jones committed Jan 03, 2012 513  -- see comments with InstEnv.ClsInst( is_tvs, is_tys )  batterseapower committed Jul 31, 2008 514 515  ru_bndrs :: [CoreBndr], -- ^ Variables quantified over ru_args :: [CoreExpr], -- ^ Left hand side arguments  simonpj committed Apr 28, 2005 516 517  -- And the right-hand side  batterseapower committed Jul 31, 2008 518  ru_rhs :: CoreExpr, -- ^ Right hand side of the rule  simonpj@microsoft.com committed Oct 29, 2009 519 520  -- Occurrence info is guaranteed correct -- See Note [OccInfo in unfoldings and rules]  simonpj committed Apr 28, 2005 521 522  -- Locality  simonpj@microsoft.com committed Oct 07, 2010 523 524 525 526  ru_auto :: Bool, -- ^ @True@ <=> this rule is auto-generated -- @False@ <=> generated at the users behest -- Main effect: reporting of orphan-hood  batterseapower committed Jul 31, 2008 527  ru_local :: Bool -- ^ @True@ iff the fn at the head of the rule is  simonpj committed Apr 28, 2005 528  -- defined in the same module as the rule  batterseapower committed Jul 31, 2008 529 530 531  -- and is not an implicit 'Id' (like a record selector, -- class operation, or data constructor)  simonpj@microsoft.com committed Mar 30, 2007 532 533  -- NB: ru_local is *not* used to decide orphan-hood -- c.g. MkIface.coreRuleToIfaceRule  simonpj@microsoft.com committed Feb 21, 2007 534  }  simonpj committed Apr 28, 2005 535   batterseapower committed Jul 31, 2008 536 537 538  -- | Built-in rules are used for constant folding -- and suchlike. They have no free variables. | BuiltinRule {  simonpj@microsoft.com committed Oct 29, 2009 539 540 541 542  ru_name :: RuleName, -- ^ As above ru_fn :: Name, -- ^ As above ru_nargs :: Int, -- ^ Number of arguments that 'ru_try' consumes, -- if it fires, including type arguments  Ian Lynagh committed Jun 06, 2012 543  ru_try :: Id -> IdUnfoldingFun -> [CoreExpr] -> Maybe CoreExpr  batterseapower committed Jul 31, 2008 544 545 546 547  -- ^ This function does the rewrite. It given too many -- arguments, it simply discards them; the returned 'CoreExpr' -- is just the rewrite of 'ru_fn' applied to the first 'ru_nargs' args }  simonpj@microsoft.com committed Apr 22, 2007 548  -- See Note [Extra args in rule matching] in Rules.lhs  simonpj committed Apr 28, 2005 549   simonpj@microsoft.com committed Dec 02, 2009 550 551 552 553 554 type IdUnfoldingFun = Id -> Unfolding -- A function that embodies how to unfold an Id if you need -- to do that in the Rule. The reason we need to pass this info in -- is that whether an Id is unfoldable depends on the simplifier phase  twanvl committed Jan 18, 2008 555 isBuiltinRule :: CoreRule -> Bool  simonpj committed Apr 28, 2005 556 557 isBuiltinRule (BuiltinRule {}) = True isBuiltinRule _ = False  simonpj committed May 18, 1999 558   batterseapower committed Jul 31, 2008 559 560 -- | The number of arguments the 'ru_fn' must be applied -- to before the rule can match on it  simonpj@microsoft.com committed Nov 01, 2006 561 562 563 564 ruleArity :: CoreRule -> Int ruleArity (BuiltinRule {ru_nargs = n}) = n ruleArity (Rule {ru_args = args}) = length args  simonpj committed Apr 28, 2005 565 566 ruleName :: CoreRule -> RuleName ruleName = ru_name  simonpj committed Jan 04, 2000 567   simonpj@microsoft.com committed Nov 16, 2010 568 569 570 ruleActivation :: CoreRule -> Activation ruleActivation (BuiltinRule { }) = AlwaysActive ruleActivation (Rule { ru_act = act }) = act  batterseapower committed Jul 31, 2008 571 572  -- | The 'Name' of the 'Id.Id' at the head of the rule left hand side  simonpj committed Apr 28, 2005 573 574 ruleIdName :: CoreRule -> Name ruleIdName = ru_fn  simonpj committed Sep 14, 2001 575   simonpj committed Apr 28, 2005 576 577 isLocalRule :: CoreRule -> Bool isLocalRule = ru_local  578   batterseapower committed Jul 31, 2008 579 -- | Set the 'Name' of the 'Id.Id' at the head of the rule left hand side  580 581 setRuleIdName :: Name -> CoreRule -> CoreRule setRuleIdName nm ru = ru { ru_fn = nm }  simonpj committed May 18, 1999 582 583 584 \end{code}  chak@cse.unsw.edu.au. committed Feb 20, 2011 585 586 587 588 589 590 591 592 593 594 %************************************************************************ %* * \subsection{Vectorisation declarations} %* * %************************************************************************ Representation of desugared vectorisation declarations that are fed to the vectoriser (via 'ModGuts'). \begin{code}  chak@cse.unsw.edu.au. committed Dec 05, 2012 595 data CoreVect = Vect Id CoreExpr  chak@cse.unsw.edu.au. committed Oct 31, 2011 596 597 598  | NoVect Id | VectType Bool TyCon (Maybe TyCon) | VectClass TyCon -- class tycon  chak@cse.unsw.edu.au. committed Dec 05, 2012 599  | VectInst Id -- instance dfun (always SCALAR) !!!FIXME: should be superfluous now  chak@cse.unsw.edu.au. committed Feb 20, 2011 600 601 602 \end{code}  simonpj committed Mar 27, 2000 603 %************************************************************************  604 605 606 %* * Unfoldings %* *  simonpj committed Mar 27, 2000 607 608 %************************************************************************  batterseapower committed Jul 31, 2008 609 The @Unfolding@ type is declared here to avoid numerous loops  simonpj committed Mar 27, 2000 610 611  \begin{code}  batterseapower committed Jul 31, 2008 612 613 614 -- | Records the /unfolding/ of an identifier, which is approximately the form the -- identifier would have if we substituted its definition in for the identifier. -- This type should be treated as abstract everywhere except in "CoreUnfold"  simonpj committed Mar 27, 2000 615 data Unfolding  simonpj@microsoft.com committed Oct 29, 2009 616 617 618 619 620 621 622 623 624 625 626 627 628  = NoUnfolding -- ^ We have no information about the unfolding | OtherCon [AltCon] -- ^ It ain't one of these constructors. -- @OtherCon xs@ also indicates that something has been evaluated -- and hence there's no point in re-evaluating it. -- @OtherCon []@ is used even for non-data-type values -- to indicated evaluated-ness. Notably: -- -- > data C = C !(Int -> Int) -- > case x of { C f -> ... } -- -- Here, @f@ gets an @OtherCon []@ unfolding.  simonpj@microsoft.com committed May 31, 2010 629 630  | DFunUnfolding -- The Unfolding of a DFunId -- See Note [DFun unfoldings]  simonpj@microsoft.com committed Oct 29, 2009 631 632  -- df = /\a1..am. \d1..dn. MkD (op1 a1..am d1..dn) -- (op2 a1..am d1..dn)  simonpj@microsoft.com committed May 31, 2010 633 634 635 636 637 638  Arity -- Arity = m+n, the *total* number of args -- (unusually, both type and value) to the dfun DataCon -- The dictionary data constructor (possibly a newtype datacon)  Simon Peyton Jones committed Jun 27, 2012 639  [DFunArg CoreExpr] -- Specification of superclasses and methods, in positional order  simonpj@microsoft.com committed Oct 29, 2009 640   simonpj@microsoft.com committed Sep 15, 2010 641 642 643 644  | CoreUnfolding { -- An unfolding for an Id with no pragma, -- or perhaps a NOINLINE pragma -- (For NOINLINE, the phase, if any, is in the -- InlinePragInfo for this Id.)  simonpj@microsoft.com committed Dec 02, 2009 645 646  uf_tmpl :: CoreExpr, -- Template; occurrence info is correct uf_src :: UnfoldingSource, -- Where the unfolding came from  simonpj@microsoft.com committed Oct 29, 2009 647  uf_is_top :: Bool, -- True <=> top level binding  simonpj@microsoft.com committed Dec 02, 2009 648  uf_arity :: Arity, -- Number of value arguments expected  simonpj@microsoft.com committed Sep 15, 2010 649 650 651  uf_is_value :: Bool, -- exprIsHNF template (cached); it is ok to discard -- a seq on this variable uf_is_conlike :: Bool, -- True <=> applicn of constructor or CONLIKE function  rl@cse.unsw.edu.au committed Nov 04, 2009 652  -- Cached version of exprIsConLike  Simon Peyton Jones committed May 09, 2012 653  uf_is_work_free :: Bool, -- True <=> doesn't waste (much) work to expand  simonpj@microsoft.com committed Sep 15, 2010 654  -- inside an inlining  simonpj@microsoft.com committed Oct 29, 2009 655 656 657 658 659  -- Cached version of exprIsCheap uf_expandable :: Bool, -- True <=> can expand in RULE matching -- Cached version of exprIsExpandable uf_guidance :: UnfoldingGuidance -- Tells about the *size* of the template. }  batterseapower committed Jul 31, 2008 660 661  -- ^ An unfolding with redundant cached information. Parameters: --  simonpj@microsoft.com committed Oct 29, 2009 662 663 664  -- uf_tmpl: Template used to perform unfolding; -- NB: Occurrence info is guaranteed correct: -- see Note [OccInfo in unfoldings and rules]  batterseapower committed Jul 31, 2008 665  --  simonpj@microsoft.com committed Oct 29, 2009 666  -- uf_is_top: Is this a top level binding?  batterseapower committed Jul 31, 2008 667  --  simonpj@microsoft.com committed Oct 29, 2009 668  -- uf_is_value: 'exprIsHNF' template (cached); it is ok to discard a 'seq' on  batterseapower committed Jul 31, 2008 669 670  -- this variable --  Simon Peyton Jones committed May 09, 2012 671 672  -- uf_is_work_free: Does this waste only a little work if we expand it inside an inlining? -- Basically this is a cached version of 'exprIsWorkFree'  batterseapower committed Jul 31, 2008 673  --  simonpj@microsoft.com committed Oct 29, 2009 674  -- uf_guidance: Tells us about the /size/ of the unfolding template  batterseapower committed Jul 31, 2008 675   Simon Peyton Jones committed Jun 27, 2012 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 ------------------------------------------------ data DFunArg e -- Given (df a b d1 d2 d3) = DFunPolyArg e -- Arg is (e a b d1 d2 d3) | DFunLamArg Int -- Arg is one of [a,b,d1,d2,d3], zero indexed deriving( Functor ) -- 'e' is often CoreExpr, which are usually variables, but can -- be trivial expressions instead (e.g. a type application). dfunArgExprs :: [DFunArg e] -> [e] dfunArgExprs [] = [] dfunArgExprs (DFunPolyArg e : as) = e : dfunArgExprs as dfunArgExprs (DFunLamArg {} : as) = dfunArgExprs as  simonpj@microsoft.com committed Dec 13, 2010 691 692 ------------------------------------------------ data UnfoldingSource  simonpj@microsoft.com committed Sep 15, 2010 693 694 695 696  = InlineRhs -- The current rhs of the function -- Replace uf_tmpl each time around | InlineStable -- From an INLINE or INLINABLE pragma  Simon Marlow committed Oct 15, 2010 697  -- INLINE if guidance is UnfWhen  simonpj@microsoft.com committed Dec 21, 2010 698  -- INLINABLE if guidance is UnfIfGoodArgs/UnfoldNever  Simon Marlow committed Oct 15, 2010 699 700 701 702 703 704 705 706 707 708 709 710  -- (well, technically an INLINABLE might be made -- UnfWhen if it was small enough, and then -- it will behave like INLINE outside the current -- module, but that is the way automatic unfoldings -- work so it is consistent with the intended -- meaning of INLINABLE). -- -- uf_tmpl may change, but only as a result of -- gentle simplification, it doesn't get updated -- to the current RHS during compilation as with -- InlineRhs. --  simonpj@microsoft.com committed Sep 15, 2010 711 712 713  -- See Note [InlineRules] | InlineCompulsory -- Something that *has* no binding, so you *must* inline it  simonpj@microsoft.com committed Dec 02, 2009 714 715 716 717 718 719 720 721 722 723 724 725 726  -- Only a few primop-like things have this property -- (see MkId.lhs, calls to mkCompulsoryUnfolding). -- Inline absolutely always, however boring the context. | InlineWrapper Id -- This unfolding is a the wrapper in a -- worker/wrapper split from the strictness analyser -- The Id is the worker-id -- Used to abbreviate the uf_tmpl in interface files -- which don't need to contain the RHS; -- it can be derived from the strictness info  simonpj@microsoft.com committed Oct 29, 2009 727 -- | 'UnfoldingGuidance' says when unfolding should take place  simonpj committed Mar 27, 2000 728 data UnfoldingGuidance  simonpj@microsoft.com committed Dec 02, 2009 729 730 731 732 733 734  = UnfWhen { -- Inline without thinking about the *size* of the uf_tmpl -- Used (a) for small *and* cheap unfoldings -- (b) for INLINE functions -- See Note [INLINE for small functions] in CoreUnfold ug_unsat_ok :: Bool, -- True <=> ok to inline even if unsaturated ug_boring_ok :: Bool -- True <=> ok to inline even if the context is boring  simonpj@microsoft.com committed Jan 06, 2010 735  -- So True,True means "always"  simonpj@microsoft.com committed Nov 05, 2009 736  }  simonpj@microsoft.com committed Oct 29, 2009 737   simonpj@microsoft.com committed Dec 02, 2009 738  | UnfIfGoodArgs { -- Arose from a normal Id; the info here is the  simonpj@microsoft.com committed Oct 29, 2009 739 740 741 742 743 744 745 746 747 748 749 750  -- result of a simple analysis of the RHS ug_args :: [Int], -- Discount if the argument is evaluated. -- (i.e., a simplification will definitely -- be possible). One elt of the list per *value* arg. ug_size :: Int, -- The "size" of the unfolding. ug_res :: Int -- Scrutinee discount: the discount to substract if the thing is in } -- a context (case (thing args) of ...), -- (where there are the right number of arguments.)  simonpj@microsoft.com committed Dec 02, 2009 751  | UnfNever -- The RHS is big, so don't inline it  simonpj@microsoft.com committed May 31, 2010 752 753 754 755 756 757 758 759 760 \end{code} Note [DFun unfoldings] ~~~~~~~~~~~~~~~~~~~~~~ The Arity in a DFunUnfolding is total number of args (type and value) that the DFun needs to produce a dictionary. That's not necessarily related to the ordinary arity of the dfun Id, esp if the class has one method, so the dictionary is represented by a newtype. Example  simonpj@microsoft.com committed Nov 05, 2009 761   simonpj@microsoft.com committed May 31, 2010 762 763 764 765 766 767 768 769 770 771 772 773 774 775  class C a where { op :: a -> Int } instance C a -> C [a] where op xs = op (head xs) The instance translates to $dfCList :: forall a. C a => C [a] -- Arity 2!$dfCList = /\a.\d. $copList {a} d |> co$copList :: forall a. C a => [a] -> Int -- Arity 2! $copList = /\a.\d.\xs. op {a} d (head xs) Now we might encounter (op (dfCList {ty} d) a1 a2) and we want the (op (dfList {ty} d)) rule to fire, because$dfCList has all its arguments, even though its (value) arity is 2. That's  simonpj@microsoft.com committed Sep 14, 2010 776 why we record the number of expected arguments in the DFunUnfolding.  simonpj@microsoft.com committed May 31, 2010 777   simonpj@microsoft.com committed Sep 14, 2010 778 779 780 Note that although it's an Arity, it's most convenient for it to give the *total* number of arguments, both type and value. See the use site in exprIsConApp_maybe.  simonpj@microsoft.com committed May 31, 2010 781 782  \begin{code}  simonpj@microsoft.com committed Dec 02, 2009 783 784 785 786 -- Constants for the UnfWhen constructor needSaturated, unSaturatedOk :: Bool needSaturated = False unSaturatedOk = True  simonpj@microsoft.com committed Nov 05, 2009 787   simonpj@microsoft.com committed Dec 02, 2009 788 789 790 boringCxtNotOk, boringCxtOk :: Bool boringCxtOk = True boringCxtNotOk = False  simonpj@microsoft.com committed Oct 29, 2009 791 792  ------------------------------------------------  batterseapower committed Jul 31, 2008 793 794 795 796 797 noUnfolding :: Unfolding -- ^ There is no known 'Unfolding' evaldUnfolding :: Unfolding -- ^ This unfolding marks the associated thing as being evaluated  simonpj committed Jan 31, 2005 798 799 800 noUnfolding = NoUnfolding evaldUnfolding = OtherCon []  twanvl committed Jan 18, 2008 801 mkOtherCon :: [AltCon] -> Unfolding  simonpj committed Jan 31, 2005 802 mkOtherCon = OtherCon  simonpj committed Mar 27, 2000 803 804  seqUnfolding :: Unfolding -> ()  simonpj@microsoft.com committed Oct 29, 2009 805 seqUnfolding (CoreUnfolding { uf_tmpl = e, uf_is_top = top,  Simon Peyton Jones committed May 09, 2012 806  uf_is_value = b1, uf_is_work_free = b2,  rl@cse.unsw.edu.au committed Nov 04, 2009 807 808 809  uf_expandable = b3, uf_is_conlike = b4, uf_arity = a, uf_guidance = g}) = seqExpr e seq top seq b1 seq a seq b2 seq b3 seq b4 seq seqGuidance g  simonpj@microsoft.com committed Oct 29, 2009 810   twanvl committed Jan 18, 2008 811 seqUnfolding _ = ()  simonpj committed Mar 27, 2000 812   twanvl committed Jan 18, 2008 813 seqGuidance :: UnfoldingGuidance -> ()  simonpj@microsoft.com committed Dec 02, 2009 814 815 seqGuidance (UnfIfGoodArgs ns n b) = n seq sum ns seq b seq () seqGuidance _ = ()  simonpj committed Mar 27, 2000 816 817 818 \end{code} \begin{code}  simonpj@microsoft.com committed Sep 15, 2010 819 820 821 822 823 824 isStableSource :: UnfoldingSource -> Bool -- Keep the unfolding template isStableSource InlineCompulsory = True isStableSource InlineStable = True isStableSource (InlineWrapper {}) = True isStableSource InlineRhs = False  simonpj@microsoft.com committed Dec 02, 2009 825   batterseapower committed Jul 31, 2008 826 -- | Retrieves the template of an unfolding: panics if none is known  simonpj committed Mar 27, 2000 827 unfoldingTemplate :: Unfolding -> CoreExpr  simonpj@microsoft.com committed Oct 29, 2009 828 829 830 831 unfoldingTemplate = uf_tmpl setUnfoldingTemplate :: Unfolding -> CoreExpr -> Unfolding setUnfoldingTemplate unf rhs = unf { uf_tmpl = rhs }  simonpj committed Mar 27, 2000 832   batterseapower committed Jul 31, 2008 833 -- | Retrieves the template of an unfolding if possible  simonpj committed Mar 27, 2000 834 maybeUnfoldingTemplate :: Unfolding -> Maybe CoreExpr  simonpj@microsoft.com committed Oct 29, 2009 835 836 maybeUnfoldingTemplate (CoreUnfolding { uf_tmpl = expr }) = Just expr maybeUnfoldingTemplate _ = Nothing  simonpj committed Mar 27, 2000 837   batterseapower committed Jul 31, 2008 838 839 -- | The constructors that the unfolding could never be: -- returns @[]@ if no information is available  simonpj committed Mar 27, 2000 840 841 otherCons :: Unfolding -> [AltCon] otherCons (OtherCon cons) = cons  twanvl committed Jan 18, 2008 842 otherCons _ = []  simonpj committed Mar 27, 2000 843   batterseapower committed Jul 31, 2008 844 845 -- | Determines if it is certainly the case that the unfolding will -- yield a value (something in HNF): returns @False@ if unsure  simonpj committed Mar 27, 2000 846 isValueUnfolding :: Unfolding -> Bool  simonpj@microsoft.com committed Oct 29, 2009 847 848 849  -- Returns False for OtherCon isValueUnfolding (CoreUnfolding { uf_is_value = is_evald }) = is_evald isValueUnfolding _ = False  simonpj committed Mar 27, 2000 850   batterseapower committed Jul 31, 2008 851 852 853 -- | Determines if it possibly the case that the unfolding will -- yield a value. Unlike 'isValueUnfolding' it returns @True@ -- for 'OtherCon'  simonpj committed Mar 27, 2000 854 isEvaldUnfolding :: Unfolding -> Bool  simonpj@microsoft.com committed Oct 29, 2009 855 856 857 858  -- Returns True for OtherCon isEvaldUnfolding (OtherCon _) = True isEvaldUnfolding (CoreUnfolding { uf_is_value = is_evald }) = is_evald isEvaldUnfolding _ = False  simonpj committed Mar 27, 2000 859   rl@cse.unsw.edu.au committed Nov 04, 2009 860 861 862 863 864 865 866 -- | @True@ if the unfolding is a constructor application, the application -- of a CONLIKE function or 'OtherCon' isConLikeUnfolding :: Unfolding -> Bool isConLikeUnfolding (OtherCon _) = True isConLikeUnfolding (CoreUnfolding { uf_is_conlike = con }) = con isConLikeUnfolding _ = False  batterseapower committed Jul 31, 2008 867 -- | Is the thing we will unfold into certainly cheap?  simonpj committed Mar 27, 2000 868 isCheapUnfolding :: Unfolding -> Bool  Simon Peyton Jones committed May 09, 2012 869 870 isCheapUnfolding (CoreUnfolding { uf_is_work_free = is_wf }) = is_wf isCheapUnfolding _ = False  simonpj@microsoft.com committed Mar 18, 2009 871 872  isExpandableUnfolding :: Unfolding -> Bool  simonpj@microsoft.com committed Oct 29, 2009 873 874 875 isExpandableUnfolding (CoreUnfolding { uf_expandable = is_expable }) = is_expable isExpandableUnfolding _ = False  simonpj@microsoft.com committed Dec 16, 2009 876 877 878 879 880 881 882 expandUnfolding_maybe :: Unfolding -> Maybe CoreExpr -- Expand an expandable unfolding; this is used in rule matching -- See Note [Expanding variables] in Rules.lhs -- The key point here is that CONLIKE things can be expanded expandUnfolding_maybe (CoreUnfolding { uf_expandable = True, uf_tmpl = rhs }) = Just rhs expandUnfolding_maybe _ = Nothing  simonpj@microsoft.com committed Nov 16, 2010 883 884 885 886 isStableCoreUnfolding_maybe :: Unfolding -> Maybe UnfoldingSource isStableCoreUnfolding_maybe (CoreUnfolding { uf_src = src }) | isStableSource src = Just src isStableCoreUnfolding_maybe _ = Nothing  simonpj@microsoft.com committed Dec 02, 2009 887 888 889 890  isCompulsoryUnfolding :: Unfolding -> Bool isCompulsoryUnfolding (CoreUnfolding { uf_src = InlineCompulsory }) = True isCompulsoryUnfolding _ = False  simonpj committed Mar 27, 2000 891   simonpj@microsoft.com committed Oct 29, 2009 892 893 894 isStableUnfolding :: Unfolding -> Bool -- True of unfoldings that should not be overwritten -- by a CoreUnfolding for the RHS of a let-binding  simonpj@microsoft.com committed Sep 15, 2010 895 isStableUnfolding (CoreUnfolding { uf_src = src }) = isStableSource src  simonpj@microsoft.com committed Dec 02, 2009 896 897 isStableUnfolding (DFunUnfolding {}) = True isStableUnfolding _ = False  simonpj committed Mar 27, 2000 898   simonpj@microsoft.com committed Oct 29, 2009 899 900 901 902 903 904 unfoldingArity :: Unfolding -> Arity unfoldingArity (CoreUnfolding { uf_arity = arity }) = arity unfoldingArity _ = panic "unfoldingArity" isClosedUnfolding :: Unfolding -> Bool -- No free variables isClosedUnfolding (CoreUnfolding {}) = False  simonpj@microsoft.com committed Mar 09, 2010 905 isClosedUnfolding (DFunUnfolding {}) = False  simonpj@microsoft.com committed Oct 29, 2009 906 isClosedUnfolding _ = True  simonpj committed Mar 27, 2000 907   batterseapower committed Jul 31, 2008 908 -- | Only returns False if there is no unfolding information available at all  simonpj committed Mar 27, 2000 909 910 hasSomeUnfolding :: Unfolding -> Bool hasSomeUnfolding NoUnfolding = False  twanvl committed Jan 18, 2008 911 hasSomeUnfolding _ = True  simonpj committed Oct 25, 2000 912   simonpj@microsoft.com committed Oct 29, 2009 913 neverUnfoldGuidance :: UnfoldingGuidance -> Bool  simonpj@microsoft.com committed Dec 02, 2009 914 915 neverUnfoldGuidance UnfNever = True neverUnfoldGuidance _ = False  simonpj@microsoft.com committed Oct 29, 2009 916 917 918 919  canUnfold :: Unfolding -> Bool canUnfold (CoreUnfolding { uf_guidance = g }) = not (neverUnfoldGuidance g) canUnfold _ = False  simonpj committed Mar 27, 2000 920 921 \end{code}  simonpj@microsoft.com committed Dec 02, 2009 922 Note [InlineRules]  simonpj@microsoft.com committed Oct 29, 2009 923 924 925 926 927 928 929 ~~~~~~~~~~~~~~~~~ When you say {-# INLINE f #-} f x = you intend that calls (f e) are replaced by [e/x] So we should capture (\x.) in the Unfolding of 'f', and never meddle with it. Meanwhile, we can optimise to our heart's content,  simonpj@microsoft.com committed Dec 16, 2009 930 931 932 933 934 leaving the original unfolding intact in Unfolding of 'f'. For example all xs = foldr (&&) True xs any p = all . map p {-# INLINE any #-} We optimise any's RHS fully, but leave the InlineRule saying "all . map p", which deforests well at the call site.  simonpj@microsoft.com committed Oct 29, 2009 935   simonpj@microsoft.com committed Dec 16, 2009 936 So INLINE pragma gives rise to an InlineRule, which captures the original RHS.  simonpj@microsoft.com committed Oct 29, 2009 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963  Moreover, it's only used when 'f' is applied to the specified number of arguments; that is, the number of argument on the LHS of the '=' sign in the original source definition. For example, (.) is now defined in the libraries like this {-# INLINE (.) #-} (.) f g = \x -> f (g x) so that it'll inline when applied to two arguments. If 'x' appeared on the left, thus (.) f g x = f (g x) it'd only inline when applied to three arguments. This slightly-experimental change was requested by Roman, but it seems to make sense. See also Note [Inlining an InlineRule] in CoreUnfold. Note [OccInfo in unfoldings and rules] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In unfoldings and rules, we guarantee that the template is occ-analysed, so that the occurence info on the binders is correct. This is important, because the Simplifier does not re-analyse the template when using it. If the occurrence info is wrong - We may get more simpifier iterations than necessary, because once-occ info isn't there - More seriously, we may get an infinite loop if there's a Rec without a loop breaker marked  simonpj committed Mar 27, 2000 964   simonpj committed Mar 23, 2000 965 966 %************************************************************************ %* *  Simon Peyton Jones committed Jan 12, 2012 967  AltCon  simonpj committed Mar 23, 2000 968 969 970 971 972 973 974 975 976 977 978 979 %* * %************************************************************************ \begin{code} -- The Ord is needed for the FiniteMap used in the lookForConstructor -- in SimplEnv. If you declared that lookForConstructor *ignores* -- constructor-applications with LitArg args, then you could get -- rid of this Ord. instance Outputable AltCon where ppr (DataAlt dc) = ppr dc ppr (LitAlt lit) = ppr lit  Ian Lynagh committed Apr 12, 2008 980  ppr DEFAULT = ptext (sLit "__DEFAULT")  simonpj committed Mar 23, 2000 981   batterseapower committed Mar 21, 2012 982 cmpAlt :: (AltCon, a, b) -> (AltCon, a, b) -> Ordering  simonpj committed Dec 22, 2004 983 984 cmpAlt (con1, _, _) (con2, _, _) = con1 cmpAltCon con2  batterseapower committed Mar 21, 2012 985 ltAlt :: (AltCon, a, b) -> (AltCon, a, b) -> Bool  twanvl committed Jan 18, 2008 986 ltAlt a1 a2 = (a1 cmpAlt a2) == LT  simonpj committed Dec 22, 2004 987 988  cmpAltCon :: AltCon -> AltCon -> Ordering  batterseapower committed Jul 31, 2008 989 -- ^ Compares 'AltCon's within a single list of alternatives  simonpj committed Dec 22, 2004 990 cmpAltCon DEFAULT DEFAULT = EQ  twanvl committed Jan 18, 2008 991 cmpAltCon DEFAULT _ = LT  simonpj committed Dec 22, 2004 992 993 994 995 996 997 998 999 1000  cmpAltCon (DataAlt d1) (DataAlt d2) = dataConTag d1 compare dataConTag d2 cmpAltCon (DataAlt _) DEFAULT = GT cmpAltCon (LitAlt l1) (LitAlt l2) = l1 compare l2 cmpAltCon (LitAlt _) DEFAULT = GT cmpAltCon con1 con2 = WARN( True, text "Comparing incomparable AltCons" <+> ppr con1 <+> ppr con2 ) LT  simonpj committed Mar 23, 2000 1001 1002 \end{code}  partain committed Jan 08, 1996 1003 1004 %************************************************************************ %* *  simonm committed Dec 02, 1998 1005 \subsection{Useful synonyms}  partain committed Jan 08, 1996 1006 1007 1008 %* * %************************************************************************  Simon Peyton Jones committed Sep 23, 2011 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 Note [CoreProgram] ~~~~~~~~~~~~~~~~~~ The top level bindings of a program, a CoreProgram, are represented as a list of CoreBind * Later bindings in the list can refer to earlier ones, but not vice versa. So this is OK NonRec { x = 4 } Rec { p = ...q...x... ; q = ...p...x } Rec { f = ...p..x..f.. } NonRec { g = ..f..q...x.. } But it would NOT be ok for 'f' to refer to 'g'. * The occurrence analyser does strongly-connected component analysis on each Rec binding, and splits it into a sequence of smaller bindings where possible. So the program typically starts life as a single giant Rec, which is then dependency-analysed into smaller chunks.  partain committed Jan 08, 1996 1029 \begin{code}  Simon Peyton Jones committed Sep 23, 2011 1030 1031 type CoreProgram = [CoreBind] -- See Note [CoreProgram]  batterseapower committed Jul 31, 2008 1032 1033 -- | The common case for the type of binders and variables when -- we are manipulating the Core language within GHC  simonpj committed Mar 23, 2000 1034 type CoreBndr = Var  batterseapower committed Jul 31, 2008 1035 -- | Expressions where binders are 'CoreBndr's  simonpj committed Dec 18, 1998 1036 type CoreExpr = Expr CoreBndr  batterseapower committed Jul 31, 2008 1037 -- | Argument expressions where binders are 'CoreBndr's  simonpj committed Dec 18, 1998 1038 type CoreArg = Arg CoreBndr  batterseapower committed Jul 31, 2008 1039 -- | Binding groups where binders are 'CoreBndr's  simonpj committed Dec 18, 1998 1040 type CoreBind = Bind CoreBndr  batterseapower committed Jul 31, 2008 1041 -- | Case alternatives where binders are 'CoreBndr's  simonpj committed Dec 18, 1998 1042 type CoreAlt = Alt CoreBndr  partain committed Jan 08, 1996 1043 1044 \end{code}  batterseapower committed Jul 31, 2008 1045 1046 1047 1048 1049 %************************************************************************ %* * \subsection{Tagging} %* * %************************************************************************  partain committed Jan 08, 1996 1050 1051  \begin{code}  batterseapower committed Jul 31, 2008 1052 -- | Binders are /tagged/ with a t  simonpj committed Sep 13, 2002 1053 data TaggedBndr t = TB CoreBndr t -- TB for "tagged binder"  partain committed Jan 08, 1996 1054   simonpj committed Sep 13, 2002 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 type TaggedBind t = Bind (TaggedBndr t) type TaggedExpr t = Expr (TaggedBndr t) type TaggedArg t = Arg (TaggedBndr t) type TaggedAlt t = Alt (TaggedBndr t) instance Outputable b => Outputable (TaggedBndr b) where ppr (TB b l) = char '<' <> ppr b <> comma <> ppr l <> char '>' instance Outputable b => OutputableBndr (TaggedBndr b) where pprBndr _ b = ppr b -- Simple  Simon Peyton Jones committed Dec 19, 2011 1065 1066  pprInfixOcc b = ppr b pprPrefixOcc b = ppr b  partain committed Jan 08, 1996 1067 1068 \end{code}  partain committed Apr 30, 1996 1069   simonpj committed Mar 19, 1998 1070 1071 %************************************************************************ %* *  simonm committed Dec 02, 1998 1072 \subsection{Core-constructing functions with checking}  simonpj committed Mar 19, 1998 1073 1074 %* * %************************************************************************  partain committed Apr 30, 1996 1075 1076  \begin{code}  batterseapower committed Jul 31, 2008 1077 -- | Apply a list of argument expressions to a function expression in a nested fashion. Prefer to  Michal Terepeta committed Nov 22, 2011 1078 -- use 'MkCore.mkCoreApps' if possible  simonpj committed Dec 18, 1998 1079 mkApps :: Expr b -> [Arg b] -> Expr b  batterseapower committed Jul 31, 2008 1080 -- | Apply a list of type argument expressions to a function expression in a nested fashion  simonpj committed Dec 18, 1998 1081 mkTyApps :: Expr b -> [Type] -> Expr b  1082 1083 -- | Apply a list of coercion argument expressions to a function expression in a nested fashion mkCoApps :: Expr b -> [Coercion] -> Expr b  batterseapower committed Jul 31, 2008 1084 -- | Apply a list of type or value variables to a function expression in a nested fashion  simonpj committed Mar 23, 2000 1085 mkVarApps :: Expr b -> [Var] -> Expr b  batterseapower committed Jul 31, 2008 1086 1087 1088 -- | Apply a list of argument expressions to a data constructor in a nested fashion. Prefer to -- use 'MkCore.mkCoreConApps' if possible mkConApp :: DataCon -> [Arg b] -> Expr b  simonm committed Dec 02, 1998 1089 1090 1091  mkApps f args = foldl App f args mkTyApps f args = foldl (\ e a -> App e (Type a)) f args  1092 mkCoApps f args = foldl (\ e a -> App e (Coercion a)) f args  simonpj committed Jul 06, 1999 1093 mkVarApps f vars = foldl (\ e a -> App e (varToCoreExpr a)) f vars  batterseapower committed Jul 31, 2008 1094 1095 mkConApp con args = mkApps (Var (dataConWorkId con)) args  simonm committed Dec 02, 1998 1096   batterseapower committed Jul 31, 2008 1097 1098 -- | Create a machine integer literal expression of type @Int#@ from an @Integer@. -- If you want an expression of type @Int@ use 'MkCore.mkIntExpr'  simonpj committed Mar 23, 2000 1099 mkIntLit :: Integer -> Expr b  batterseapower committed Jul 31, 2008 1100 1101 -- | Create a machine integer literal expression of type @Int#@ from an @Int@. -- If you want an expression of type @Int@ use 'MkCore.mkIntExpr'  simonpj committed Mar 23, 2000 1102 mkIntLitInt :: Int -> Expr b  batterseapower committed Jul 31, 2008 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116  mkIntLit n = Lit (mkMachInt n) mkIntLitInt n = Lit (mkMachInt (toInteger n)) -- | Create a machine word literal expression of type @Word#@ from an @Integer@. -- If you want an expression of type @Word@ use 'MkCore.mkWordExpr' mkWordLit :: Integer -> Expr b -- | Create a machine word literal expression of type @Word#@ from a @Word@. -- If you want an expression of type @Word@ use 'MkCore.mkWordExpr' mkWordLitWord :: Word -> Expr b mkWordLit w = Lit (mkMachWord w) mkWordLitWord w = Lit (mkMachWord (toInteger w))  Ian Lynagh committed Jan 11, 2012 1117 1118 1119 1120 1121 1122 mkWord64LitWord64 :: Word64 -> Expr b mkWord64LitWord64 w = Lit (mkMachWord64 (toInteger w)) mkInt64LitInt64 :: Int64 -> Expr b mkInt64LitInt64 w = Lit (mkMachInt64 (toInteger w))  batterseapower committed Jul 31, 2008 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 -- | Create a machine character literal expression of type @Char#@. -- If you want an expression of type @Char@ use 'MkCore.mkCharExpr' mkCharLit :: Char -> Expr b -- | Create a machine string literal expression of type @Addr#@. -- If you want an expression of type @String@ use 'MkCore.mkStringExpr' mkStringLit :: String -> Expr b mkCharLit c = Lit (mkMachChar c) mkStringLit s = Lit (mkMachString s) -- | Create a machine single precision literal expression of type @Float#@ from a @Rational@. -- If you want an expression of type @Float@ use 'MkCore.mkFloatExpr' mkFloatLit :: Rational -> Expr b -- | Create a machine single precision literal expression of type @Float#@ from a @Float@. -- If you want an expression of type @Float@ use 'MkCore.mkFloatExpr' mkFloatLitFloat :: Float -> Expr b mkFloatLit f = Lit (mkMachFloat f) mkFloatLitFloat f = Lit (mkMachFloat (toRational f)) -- | Create a machine double precision literal expression of type @Double#@ from a @Rational@. -- If you want an expression of type @Double@ use 'MkCore.mkDoubleExpr' mkDoubleLit :: Rational -> Expr b -- | Create a machine double precision literal expression of type @Double#@ from a @Double@. -- If you want an expression of type @Double@ use 'MkCore.mkDoubleExpr' mkDoubleLitDouble :: Double -> Expr b mkDoubleLit d = Lit (mkMachDouble d) mkDoubleLitDouble d = Lit (mkMachDouble (toRational d)) -- | Bind all supplied binding groups over an expression in a nested let expression. Prefer to  Michal Terepeta committed Nov 22, 2011 1154 -- use 'MkCore.mkCoreLets' if possible  simonpj committed Mar 27, 2000 1155 mkLets :: [Bind b] -> Expr b -> Expr b  batterseapower committed Jul 31, 2008 1156 -- | Bind all supplied binders over an expression in a nested lambda expression. Prefer to  Michal Terepeta committed Nov 22, 2011 1157 -- use 'MkCore.mkCoreLams' if possible  simonpj committed Mar 27, 2000 1158 mkLams :: [b] -> Expr b -> Expr b  simonm committed Dec 02, 1998 1159   simonpj committed Mar 27, 2000 1160 1161 1162 mkLams binders body = foldr Lam body binders mkLets binds body = foldr Let body binds  simonm committed Dec 02, 1998 1163   batterseapower committed Jul 31, 2008 1164 1165 1166 1167 1168 -- | Create a binding group where a type variable is bound to a type. Per "CoreSyn#type_let", -- this can only be used to bind something in a non-recursive @let@ expression mkTyBind :: TyVar -> Type -> CoreBind mkTyBind tv ty = NonRec tv (Type ty)  1169 1170 1171 1172 1173 -- | Create a binding group where a type variable is bound to a type. Per "CoreSyn#type_let", -- this can only be used to bind something in a non-recursive @let@ expression mkCoBind :: CoVar -> Coercion -> CoreBind mkCoBind cv co = NonRec cv (Coercion co)  batterseapower committed Jul 31, 2008 1174 -- | Convert a binder into either a 'Var' or 'Type' 'Expr' appropriately  simonpj committed Mar 23, 2000 1175 varToCoreExpr :: CoreBndr -> Expr b  1176 1177 1178 varToCoreExpr v | isTyVar v = Type (mkTyVarTy v) | isCoVar v = Coercion (mkCoVarCo v) | otherwise = ASSERT( isId v ) Var v  chak@cse.unsw.edu.au. committed Aug 04, 2006 1179 1180 1181  varsToCoreExprs :: [CoreBndr] -> [Expr b] varsToCoreExprs vs = map varToCoreExpr vs  partain committed Apr 30, 1996 1182 1183 \end{code}  simonpj committed Mar 23, 2000 1184   partain committed Jan 08, 1996 1185 1186 %************************************************************************ %* *  simonm committed Dec 02, 1998 1187 \subsection{Simple access functions}  partain committed Jan 08, 1996 1188 1189 1190 1191 %* * %************************************************************************ \begin{code}  batterseapower committed Jul 31, 2008 1192 -- | Extract every variable by this group  simonpj committed Dec 18, 1998 1193 bindersOf :: Bind b -> [b]  simonm committed Dec 02, 1998 1194 1195 bindersOf (NonRec binder _) = [binder] bindersOf (Rec pairs) = [binder | (binder, _) <- pairs]  partain committed Apr 05, 1996 1196   batterseapower committed Jul 31, 2008 1197 -- | 'bindersOf' applied to a list of binding groups