CoreSyn.lhs 50.5 KB
Newer Older
1
%
Simon Marlow's avatar
Simon Marlow committed
2
% (c) The University of Glasgow 2006
3
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4
%
Simon Marlow's avatar
Simon Marlow committed
5

6
\begin{code}
7
{-# LANGUAGE DeriveDataTypeable, DeriveFunctor #-}
8

Ian Lynagh's avatar
Ian Lynagh committed
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

16
-- | CoreSyn holds all the main data types for use by for the Glasgow Haskell Compiler midsection
17
module CoreSyn (
18
	-- * Main data types
19
20
21
        Expr(..), Alt, Bind(..), AltCon(..), Arg, Tickish(..),
        CoreProgram, CoreExpr, CoreAlt, CoreBind, CoreArg, CoreBndr,
        TaggedExpr, TaggedAlt, TaggedBind, TaggedArg, TaggedBndr(..),
22

23
24
        -- ** 'Expr' construction
	mkLets, mkLams,
25
	mkApps, mkTyApps, mkCoApps, mkVarApps,
26
27
28
	
	mkIntLit, mkIntLitInt,
	mkWordLit, mkWordLitWord,
29
	mkWord64LitWord64, mkInt64LitInt64,
30
31
32
33
	mkCharLit, mkStringLit,
	mkFloatLit, mkFloatLitFloat,
	mkDoubleLit, mkDoubleLitDouble,
	
34
	mkConApp, mkTyBind, mkCoBind,
35
	varToCoreExpr, varsToCoreExprs,
36

37
        isId, cmpAltCon, cmpAlt, ltAlt,
38
39
	
	-- ** Simple 'Expr' access functions and predicates
40
	bindersOf, bindersOfBinds, rhssOfBind, rhssOfAlts, 
41
	collectBinders, collectTyBinders, collectValBinders, collectTyAndValBinders,
Simon Marlow's avatar
Simon Marlow committed
42
        collectArgs, flattenBinds,
43

44
45
        isValArg, isTypeArg, isTyCoArg, valArgCount, valBndrCount,
        isRuntimeArg, isRuntimeVar,
46

47
48
49
50
        tickishCounts, tickishScoped, tickishIsCode, mkNoTick, mkNoScope,
        tickishCanSplit,

        -- * Unfolding data types
51
52
        Unfolding(..),  UnfoldingGuidance(..), UnfoldingSource(..),

53
	-- ** Constructing 'Unfolding's
54
	noUnfolding, evaldUnfolding, mkOtherCon,
55
        unSaturatedOk, needSaturated, boringCxtOk, boringCxtNotOk,
56
57
	
	-- ** Predicates and deconstruction on 'Unfolding'
58
	unfoldingTemplate, setUnfoldingTemplate, expandUnfolding_maybe,
59
	maybeUnfoldingTemplate, otherCons, unfoldingArity,
60
	isValueUnfolding, isEvaldUnfolding, isCheapUnfolding,
61
        isExpandableUnfolding, isConLikeUnfolding, isCompulsoryUnfolding,
62
        isStableUnfolding, isStableCoreUnfolding_maybe,
63
64
        isClosedUnfolding, hasSomeUnfolding, 
	canUnfold, neverUnfoldGuidance, isStableSource,
65

66
	-- * Strictness
67
	seqExpr, seqExprs, seqUnfolding, 
68

69
70
71
	-- * Annotated expression data types
	AnnExpr, AnnExpr'(..), AnnBind(..), AnnAlt,
	
Simon Marlow's avatar
Simon Marlow committed
72
73
74
        -- ** Operations on annotated expressions
        collectAnnArgs,

75
	-- ** Operations on annotations
76
	deAnnotate, deAnnotate', deAnnAlt, collectAnnBndrs,
77

78
	-- * Core rule data types
79
	CoreRule(..),	-- CoreSubst, CoreTidy, CoreFVs, PprCore only
80
	RuleName, IdUnfoldingFun,
81
82
	
	-- ** Operations on 'CoreRule's 
83
	seqRules, ruleArity, ruleName, ruleIdName, ruleActivation,
84
	setRuleIdName,
85
86
87
88
	isBuiltinRule, isLocalRule,

	-- * Core vectorisation declarations data type
	CoreVect(..)
89
90
    ) where

91
#include "HsVersions.h"
92

Simon Marlow's avatar
Simon Marlow committed
93
94
95
96
97
98
99
import CostCentre
import Var
import Type
import Coercion
import Name
import Literal
import DataCon
100
import Module
101
import TyCon
Simon Marlow's avatar
Simon Marlow committed
102
import BasicTypes
103
import FastString
104
import Outputable
twanvl's avatar
twanvl committed
105
import Util
106

107
import Data.Data hiding (TyCon)
108
import Data.Int
109
110
import Data.Word

111
infixl 4 `mkApps`, `mkTyApps`, `mkVarApps`, `App`, `mkCoApps`
112
-- Left associative, so that we can say (f `mkTyApps` xs `mkVarApps` ys)
113
114
115
116
\end{code}

%************************************************************************
%*									*
117
\subsection{The main data types}
118
119
120
%*									*
%************************************************************************

121
These data types are the heart of the compiler
122

123
\begin{code}
124
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
-- | This is the data type that represents GHCs core intermediate language. Currently
-- GHC uses System FC <http://research.microsoft.com/~simonpj/papers/ext-f/> for this purpose,
-- which is closely related to the simpler and better known System F <http://en.wikipedia.org/wiki/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's avatar
batterseapower committed
157
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
--
-- 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's avatar
Simon Peyton Jones committed
224
225
226
227
--    1. The list of alternatives is non-empty
--
--    2. The 'DEFAULT' case alternative must be first in the list, 
--       if it occurs at all.
batterseapower's avatar
batterseapower committed
228
--    
Simon Peyton Jones's avatar
Simon Peyton Jones committed
229
--    3. The remaining cases are in order of increasing 
batterseapower's avatar
batterseapower committed
230
231
--         tag	(for 'DataAlts') or
--         lit	(for 'LitAlts').
Simon Peyton Jones's avatar
Simon Peyton Jones committed
232
233
--       This makes finding the relevant constructor easy, 
--       and makes comparison easier too.
batterseapower's avatar
batterseapower committed
234
--    
Simon Peyton Jones's avatar
Simon Peyton Jones committed
235
236
--    4. The list of alternatives must be exhaustive. An /exhaustive/ case 
--       does not necessarily mention all constructors:
batterseapower's avatar
batterseapower committed
237
--    
Simon Peyton Jones's avatar
Simon Peyton Jones committed
238
239
240
241
242
243
244
245
--    	 @
--    	      data Foo = Red | Green | Blue
--    	 ... case x of 
--    	      Red   -> True
--    	      other -> f (case x of 
--    	                      Green -> ...
--    	                      Blue  -> ... ) ...
--    	 @
batterseapower's avatar
batterseapower committed
246
--    
Simon Peyton Jones's avatar
Simon Peyton Jones committed
247
248
--    	 The inner case does not need a @Red@ alternative, because @x@ 
--    	 can't be @Red@ at that program point.
batterseapower's avatar
batterseapower committed
249
250
251
252
253
254
255
256
257
258
259
--
-- *  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
260
data Expr b
batterseapower's avatar
batterseapower committed
261
262
263
264
265
  = Var	  Id
  | Lit   Literal
  | App   (Expr b) (Arg b)
  | Lam   b (Expr b)
  | Let   (Bind b) (Expr b)
Simon Peyton Jones's avatar
Simon Peyton Jones committed
266
  | Case  (Expr b) b Type [Alt b]	-- See #case_invariant#
batterseapower's avatar
batterseapower committed
267
  | Cast  (Expr b) Coercion
268
  | Tick  (Tickish Id) (Expr b)
batterseapower's avatar
batterseapower committed
269
270
  | Type  Type
  | Coercion Coercion
271
  deriving (Data, Typeable)
272
273
274
275
276
277
278
279
280
281
282

-- | 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)
283
284
285
286
287
288
289
290
291
292
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)
293

294
-- | Binding, used for top level bindings in a module and local bindings in a @let@.
295
data Bind b = NonRec b (Expr b)
296
	    | Rec [(b, (Expr b))]
297
  deriving (Data, Typeable)
298
299
\end{code}

300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
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.


315
316
317
318
-------------------------- CoreSyn INVARIANTS ---------------------------

Note [CoreSyn top-level invariant]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
319
See #toplevel_invariant#
320
321
322

Note [CoreSyn letrec invariant]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
323
See #letrec_invariant#
324
325
326

Note [CoreSyn let/app invariant]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
327
328
329
See #let_app_invariant#

This is intially enforced by DsUtils.mkCoreLet and mkCoreApp
330
331
332

Note [CoreSyn case invariants]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
333
See #case_invariants#
334
335

Note [CoreSyn let goal]
336
~~~~~~~~~~~~~~~~~~~~~~~
337
338
339
340
341
* 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.


342
343
Note [Type let]
~~~~~~~~~~~~~~~
344
See #type_let#
345

Simon Peyton Jones's avatar
Simon Peyton Jones committed
346
347
348
349
350
351
%************************************************************************
%*									*
              Ticks
%*									*
%************************************************************************

352
\begin{code}
353
354
355
356
357
358
359
360
361
362
363
-- | 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)
    }
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
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
  -- | 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
432
\end{code}
433

434

435
436
437
438
439
440
441
442
443
%************************************************************************
%*									*
\subsection{Transformation rules}
%*									*
%************************************************************************

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

444
\begin{code}
445
446
447
448
449
450
451
-- | 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
452
data CoreRule
453
  = Rule { 
454
455
	ru_name :: RuleName,            -- ^ Name of the rule, for communication with the user
	ru_act  :: Activation,          -- ^ When the rule is active
456

457
	-- Rough-matching stuff
458
	-- see comments with InstEnv.ClsInst( is_cls, is_rough )
459
460
	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
461
462
	
	-- Proper-matching stuff
463
	-- see comments with InstEnv.ClsInst( is_tvs, is_tys )
464
465
	ru_bndrs :: [CoreBndr],         -- ^ Variables quantified over
	ru_args  :: [CoreExpr],         -- ^ Left hand side arguments
466
467
	
	-- And the right-hand side
468
	ru_rhs   :: CoreExpr,           -- ^ Right hand side of the rule
469
470
		    			-- Occurrence info is guaranteed correct
					-- See Note [OccInfo in unfoldings and rules]
471
472

	-- Locality
473
474
475
476
        ru_auto :: Bool,	-- ^ @True@  <=> this rule is auto-generated
		   		--   @False@ <=> generated at the users behest
				--   Main effect: reporting of orphan-hood

477
	ru_local :: Bool	-- ^ @True@ iff the fn at the head of the rule is
478
				-- defined in the same module as the rule
479
480
481
				-- and is not an implicit 'Id' (like a record selector,
				-- class operation, or data constructor)

482
483
		-- NB: ru_local is *not* used to decide orphan-hood
		--	c.g. MkIface.coreRuleToIfaceRule
484
    }
485

486
487
488
  -- | Built-in rules are used for constant folding
  -- and suchlike.  They have no free variables.
  | BuiltinRule {               
489
490
491
492
	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
493
	ru_try  :: IdUnfoldingFun -> [CoreExpr] -> Maybe CoreExpr
494
495
496
497
		-- ^ 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
    }
498
		-- See Note [Extra args in rule matching] in Rules.lhs
499

500
501
502
503
504
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's avatar
twanvl committed
505
isBuiltinRule :: CoreRule -> Bool
506
507
isBuiltinRule (BuiltinRule {}) = True
isBuiltinRule _		       = False
508

509
510
-- | The number of arguments the 'ru_fn' must be applied 
-- to before the rule can match on it
511
512
513
514
ruleArity :: CoreRule -> Int
ruleArity (BuiltinRule {ru_nargs = n}) = n
ruleArity (Rule {ru_args = args})      = length args

515
516
ruleName :: CoreRule -> RuleName
ruleName = ru_name
517

518
519
520
ruleActivation :: CoreRule -> Activation
ruleActivation (BuiltinRule { })       = AlwaysActive
ruleActivation (Rule { ru_act = act }) = act
521
522

-- | The 'Name' of the 'Id.Id' at the head of the rule left hand side
523
524
ruleIdName :: CoreRule -> Name
ruleIdName = ru_fn
525

526
527
isLocalRule :: CoreRule -> Bool
isLocalRule = ru_local
528

529
-- | Set the 'Name' of the 'Id.Id' at the head of the rule left hand side
530
531
setRuleIdName :: Name -> CoreRule -> CoreRule
setRuleIdName nm ru = ru { ru_fn = nm }
532
533
534
\end{code}


535
536
537
538
539
540
541
542
543
544
%************************************************************************
%*                                                                      *
\subsection{Vectorisation declarations}
%*                                                                      *
%************************************************************************

Representation of desugared vectorisation declarations that are fed to the vectoriser (via
'ModGuts').

\begin{code}
545
546
547
548
data CoreVect = Vect      Id   (Maybe CoreExpr)
              | NoVect    Id
              | VectType  Bool TyCon (Maybe TyCon)
              | VectClass TyCon                     -- class tycon
549
              | VectInst  Id                        -- instance dfun (always SCALAR)
550
551
552
\end{code}


553
%************************************************************************
554
555
556
%*                                                                      *
                Unfoldings
%*                                                                      *
557
558
%************************************************************************

559
The @Unfolding@ type is declared here to avoid numerous loops
560
561

\begin{code}
562
563
564
-- | 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"
565
data Unfolding
566
567
568
569
570
571
572
573
574
575
576
577
578
  = 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.

579
580
  | DFunUnfolding       -- The Unfolding of a DFunId  
    			-- See Note [DFun unfoldings]
581
582
      		  	--     df = /\a1..am. \d1..dn. MkD (op1 a1..am d1..dn)
     		      	--     	    	      	       	   (op2 a1..am d1..dn)
583
584
585
586
587
588

        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)

589
        [CoreExpr]      -- Specification of superclasses and methods, in positional order
590

591
592
593
594
  | 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.)
595
596
	uf_tmpl       :: CoreExpr,	  -- Template; occurrence info is correct
	uf_src        :: UnfoldingSource, -- Where the unfolding came from
597
	uf_is_top     :: Bool,		-- True <=> top level binding
598
	uf_arity      :: Arity,		-- Number of value arguments expected
599
600
601
	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
602
                                        --      Cached version of exprIsConLike
603
604
	uf_is_cheap   :: Bool,		-- True <=> doesn't waste (much) work to expand 
                                        --          inside an inlining
605
606
607
608
609
					-- 	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.
    }
610
611
  -- ^ An unfolding with redundant cached information. Parameters:
  --
612
613
614
  --  uf_tmpl: Template used to perform unfolding; 
  --           NB: Occurrence info is guaranteed correct: 
  --	           see Note [OccInfo in unfoldings and rules]
615
  --
616
  --  uf_is_top: Is this a top level binding?
617
  --
618
  --  uf_is_value: 'exprIsHNF' template (cached); it is ok to discard a 'seq' on
619
620
  --     this variable
  --
621
  --  uf_is_cheap:  Does this waste only a little work if we expand it inside an inlining?
622
623
  --     Basically this is a cached version of 'exprIsCheap'
  --
624
  --  uf_guidance:  Tells us about the /size/ of the unfolding template
625

626
627
------------------------------------------------
data UnfoldingSource
628
629
630
631
  = InlineRhs          -- The current rhs of the function
    		       -- Replace uf_tmpl each time around

  | InlineStable       -- From an INLINE or INLINABLE pragma 
632
                       --   INLINE     if guidance is UnfWhen
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
633
                       --   INLINABLE  if guidance is UnfIfGoodArgs/UnfoldNever
634
635
636
637
638
639
640
641
642
643
644
645
                       -- (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.
                       --
646
647
648
    		       -- See Note [InlineRules]

  | InlineCompulsory   -- Something that *has* no binding, so you *must* inline it
649
650
651
652
653
654
655
656
657
658
659
660
661
    		       -- 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



662
-- | 'UnfoldingGuidance' says when unfolding should take place
663
data UnfoldingGuidance
664
665
666
667
668
669
  = 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
670
      		-- So True,True means "always"
671
    }
672

673
  | UnfIfGoodArgs {	-- Arose from a normal Id; the info here is the
674
675
676
677
678
679
680
681
682
683
684
685
    		     	-- 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.)

686
  | UnfNever	    -- The RHS is big, so don't inline it
687
688
689
690
691
692
693
694
695
\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
696

697
698
699
700
701
702
703
704
705
706
707
708
709
710
     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's avatar
simonpj@microsoft.com committed
711
why we record the number of expected arguments in the DFunUnfolding.
712

simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
713
714
715
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.
716
717

\begin{code}
718
719
720
721
-- Constants for the UnfWhen constructor
needSaturated, unSaturatedOk :: Bool
needSaturated = False
unSaturatedOk = True
722

723
724
725
boringCxtNotOk, boringCxtOk :: Bool
boringCxtOk    = True
boringCxtNotOk = False
726
727

------------------------------------------------
728
729
730
731
732
noUnfolding :: Unfolding
-- ^ There is no known 'Unfolding'
evaldUnfolding :: Unfolding
-- ^ This unfolding marks the associated thing as being evaluated

733
734
735
noUnfolding    = NoUnfolding
evaldUnfolding = OtherCon []

twanvl's avatar
twanvl committed
736
mkOtherCon :: [AltCon] -> Unfolding
737
mkOtherCon = OtherCon
738
739

seqUnfolding :: Unfolding -> ()
740
741
seqUnfolding (CoreUnfolding { uf_tmpl = e, uf_is_top = top, 
		uf_is_value = b1, uf_is_cheap = b2, 
742
743
744
	   	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
745

twanvl's avatar
twanvl committed
746
seqUnfolding _ = ()
747

twanvl's avatar
twanvl committed
748
seqGuidance :: UnfoldingGuidance -> ()
749
750
seqGuidance (UnfIfGoodArgs ns n b) = n `seq` sum ns `seq` b `seq` ()
seqGuidance _                      = ()
751
752
753
\end{code}

\begin{code}
754
755
756
757
758
759
isStableSource :: UnfoldingSource -> Bool
-- Keep the unfolding template
isStableSource InlineCompulsory   = True
isStableSource InlineStable       = True
isStableSource (InlineWrapper {}) = True
isStableSource InlineRhs          = False
760
 
761
-- | Retrieves the template of an unfolding: panics if none is known
762
unfoldingTemplate :: Unfolding -> CoreExpr
763
764
765
766
unfoldingTemplate = uf_tmpl

setUnfoldingTemplate :: Unfolding -> CoreExpr -> Unfolding
setUnfoldingTemplate unf rhs = unf { uf_tmpl = rhs }
767

768
-- | Retrieves the template of an unfolding if possible
769
maybeUnfoldingTemplate :: Unfolding -> Maybe CoreExpr
770
771
maybeUnfoldingTemplate (CoreUnfolding { uf_tmpl = expr })       = Just expr
maybeUnfoldingTemplate _                            		= Nothing
772

773
774
-- | The constructors that the unfolding could never be: 
-- returns @[]@ if no information is available
775
776
otherCons :: Unfolding -> [AltCon]
otherCons (OtherCon cons) = cons
twanvl's avatar
twanvl committed
777
otherCons _               = []
778

779
780
-- | Determines if it is certainly the case that the unfolding will
-- yield a value (something in HNF): returns @False@ if unsure
781
isValueUnfolding :: Unfolding -> Bool
782
783
784
	-- Returns False for OtherCon
isValueUnfolding (CoreUnfolding { uf_is_value = is_evald }) = is_evald
isValueUnfolding _                                          = False
785

786
787
788
-- | Determines if it possibly the case that the unfolding will
-- yield a value. Unlike 'isValueUnfolding' it returns @True@
-- for 'OtherCon'
789
isEvaldUnfolding :: Unfolding -> Bool
790
791
792
793
	-- Returns True for OtherCon
isEvaldUnfolding (OtherCon _)		                    = True
isEvaldUnfolding (CoreUnfolding { uf_is_value = is_evald }) = is_evald
isEvaldUnfolding _                                          = False
794

795
796
797
798
799
800
801
-- | @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

802
-- | Is the thing we will unfold into certainly cheap?
803
isCheapUnfolding :: Unfolding -> Bool
804
805
isCheapUnfolding (CoreUnfolding { uf_is_cheap = is_cheap }) = is_cheap
isCheapUnfolding _                                          = False
806
807

isExpandableUnfolding :: Unfolding -> Bool
808
809
810
isExpandableUnfolding (CoreUnfolding { uf_expandable = is_expable }) = is_expable
isExpandableUnfolding _                                              = False

811
812
813
814
815
816
817
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

818
819
820
821
isStableCoreUnfolding_maybe :: Unfolding -> Maybe UnfoldingSource
isStableCoreUnfolding_maybe (CoreUnfolding { uf_src = src })
   | isStableSource src   = Just src
isStableCoreUnfolding_maybe _ = Nothing
822
823
824
825

isCompulsoryUnfolding :: Unfolding -> Bool
isCompulsoryUnfolding (CoreUnfolding { uf_src = InlineCompulsory }) = True
isCompulsoryUnfolding _                                             = False
826

827
828
829
isStableUnfolding :: Unfolding -> Bool
-- True of unfoldings that should not be overwritten 
-- by a CoreUnfolding for the RHS of a let-binding
830
isStableUnfolding (CoreUnfolding { uf_src = src }) = isStableSource src
831
832
isStableUnfolding (DFunUnfolding {})		   = True
isStableUnfolding _                                = False
833

834
835
836
837
838
839
unfoldingArity :: Unfolding -> Arity
unfoldingArity (CoreUnfolding { uf_arity = arity }) = arity
unfoldingArity _	      		   	    = panic "unfoldingArity"

isClosedUnfolding :: Unfolding -> Bool		-- No free variables
isClosedUnfolding (CoreUnfolding {}) = False
840
isClosedUnfolding (DFunUnfolding {}) = False
841
isClosedUnfolding _                  = True
842

843
-- | Only returns False if there is no unfolding information available at all
844
845
hasSomeUnfolding :: Unfolding -> Bool
hasSomeUnfolding NoUnfolding = False
twanvl's avatar
twanvl committed
846
hasSomeUnfolding _           = True
847

848
neverUnfoldGuidance :: UnfoldingGuidance -> Bool
849
850
neverUnfoldGuidance UnfNever = True
neverUnfoldGuidance _        = False
851
852
853
854

canUnfold :: Unfolding -> Bool
canUnfold (CoreUnfolding { uf_guidance = g }) = not (neverUnfoldGuidance g)
canUnfold _  				      = False
855
856
\end{code}

857
Note [InlineRules]
858
859
860
861
862
863
864
~~~~~~~~~~~~~~~~~
When you say 
      {-# INLINE f #-}
      f x = <rhs>
you intend that calls (f e) are replaced by <rhs>[e/x] So we
should capture (\x.<rhs>) in the Unfolding of 'f', and never meddle
with it.  Meanwhile, we can optimise <rhs> to our heart's content,
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
865
866
867
868
869
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.
870

simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
871
So INLINE pragma gives rise to an InlineRule, which captures the original RHS.
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898

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

899

900
901
%************************************************************************
%*									*
Simon Peyton Jones's avatar
Simon Peyton Jones committed
902
                  AltCon
903
904
905
906
907
908
909
910
911
912
913
914
%*									*
%************************************************************************

\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's avatar
Ian Lynagh committed
915
  ppr DEFAULT      = ptext (sLit "__DEFAULT")
916
917
918

instance Show AltCon where
  showsPrec p con = showsPrecSDoc p (ppr con)
919
920
921
922
923

cmpAlt :: Alt b -> Alt b -> Ordering
cmpAlt (con1, _, _) (con2, _, _) = con1 `cmpAltCon` con2

ltAlt :: Alt b -> Alt b -> Bool
twanvl's avatar
twanvl committed
924
ltAlt a1 a2 = (a1 `cmpAlt` a2) == LT
925
926

cmpAltCon :: AltCon -> AltCon -> Ordering
927
-- ^ Compares 'AltCon's within a single list of alternatives
928
cmpAltCon DEFAULT      DEFAULT	   = EQ
twanvl's avatar
twanvl committed
929
cmpAltCon DEFAULT      _           = LT
930
931
932
933
934
935
936
937
938

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
939
940
\end{code}

941
942
%************************************************************************
%*									*
943
\subsection{Useful synonyms}
944
945
946
%*									*
%************************************************************************

947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
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.  

967
\begin{code}
968
969
type CoreProgram = [CoreBind]	-- See Note [CoreProgram]

970
971
-- | The common case for the type of binders and variables when
-- we are manipulating the Core language within GHC
972
type CoreBndr = Var
973
-- | Expressions where binders are 'CoreBndr's
974
type CoreExpr = Expr CoreBndr
975
-- | Argument expressions where binders are 'CoreBndr's
976
type CoreArg  = Arg  CoreBndr
977
-- | Binding groups where binders are 'CoreBndr's
978
type CoreBind = Bind CoreBndr
979
-- | Case alternatives where binders are 'CoreBndr's
980
type CoreAlt  = Alt  CoreBndr
981
982
\end{code}

983
984
985
986
987
%************************************************************************
%*									*
\subsection{Tagging}
%*									*
%************************************************************************
988
989

\begin{code}
990
-- | Binders are /tagged/ with a t
991
data TaggedBndr t = TB CoreBndr t	-- TB for "tagged binder"
992

993
994
995
996
997
998
999
1000
1001
1002
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
1003
1004
  pprInfixOcc  b = ppr b
  pprPrefixOcc b = ppr b
1005
1006
\end{code}

1007

1008
1009
%************************************************************************
%*									*
1010
\subsection{Core-constructing functions with checking}
1011
1012
%*									*
%************************************************************************
1013
1014

\begin{code}
1015
-- | Apply a list of argument expressions to a function expression in a nested fashion. Prefer to
Michal Terepeta's avatar
Michal Terepeta committed
1016
-- use 'MkCore.mkCoreApps' if possible
1017
mkApps    :: Expr b -> [Arg b]  -> Expr b
1018
-- | Apply a list of type argument expressions to a function expression in a nested fashion
1019
mkTyApps  :: Expr b -> [Type]   -> Expr b
1020
1021
-- | Apply a list of coercion argument expressions to a function expression in a nested fashion
mkCoApps  :: Expr b -> [Coercion] -> Expr b
1022
-- | Apply a list of type or value variables to a function expression in a nested fashion
1023
mkVarApps :: Expr b -> [Var] -> Expr b
1024
1025
1026
-- | 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
1027
1028
1029

mkApps    f args = foldl App		  	   f args
mkTyApps  f args = foldl (\ e a -> App e (Type a)) f args
1030
mkCoApps  f args = foldl (\ e a -> App e (Coercion a)) f args
1031
mkVarApps f vars = foldl (\ e a -> App e (varToCoreExpr a)) f vars
1032
1033
mkConApp con args = mkApps (Var (dataConWorkId con)) args

1034

1035
1036
-- | Create a machine integer literal expression of type @Int#@ from an @Integer@.
-- If you want an expression of type @Int@ use 'MkCore.mkIntExpr'
1037
mkIntLit      :: Integer -> Expr b
1038
1039
-- | Create a machine integer literal expression of type @Int#@ from an @Int@.
-- If you want an expression of type @Int@ use 'MkCore.mkIntExpr'
1040
mkIntLitInt   :: Int     -> Expr b
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054

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))

1055
1056
1057
1058
1059
1060
mkWord64LitWord64 :: Word64 -> Expr b
mkWord64LitWord64 w = Lit (mkMachWord64 (toInteger w))

mkInt64LitInt64 :: Int64 -> Expr b
mkInt64LitInt64 w = Lit (mkMachInt64 (toInteger w))

1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
-- | 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's avatar
Michal Terepeta committed
1092
-- use 'MkCore.mkCoreLets' if possible
1093
mkLets	      :: [Bind b] -> Expr b -> Expr b
1094
-- | Bind all supplied binders over an expression in a nested lambda expression. Prefer to
Michal Terepeta's avatar
Michal Terepeta committed
1095
-- use 'MkCore.mkCoreLams' if possible
1096
mkLams	      :: [b] -> Expr b -> Expr b
1097

1098
1099
1100
mkLams binders body = foldr Lam body binders
mkLets binds body   = foldr Let body binds

1101

1102
1103
1104
1105
1106
-- | 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)

1107
1108
1109
1110
1111
-- | 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)

1112
-- | Convert a binder into either a 'Var' or 'Type' 'Expr' appropriately
1113
varToCoreExpr :: CoreBndr -> Expr b
1114
1115
1116
varToCoreExpr v | isTyVar v = Type (mkTyVarTy v)
                | isCoVar v = Coercion (mkCoVarCo v)
                | otherwise = ASSERT( isId v ) Var v
1117
1118
1119

varsToCoreExprs :: [CoreBndr] -> [Expr b]
varsToCoreExprs vs = map varToCoreExpr vs
1120
1121
\end{code}

1122

1123
1124
%************************************************************************
%*									*
1125
\subsection{Simple access functions}
1126
1127
1128
1129
%*									*
%************************************************************************

\begin{code}
1130
-- | Extract every variable by this group
1131
bindersOf  :: Bind b -> [b]
1132
1133
bindersOf (NonRec binder _) = [binder]
bindersOf (Rec pairs)       = [binder | (binder, _) <- pairs]
1134

1135
-- | 'bindersOf' applied to a list of binding groups
1136
1137
1138
bindersOfBinds :: [Bind b] -> [b]
bindersOfBinds binds = foldr ((++) . bindersOf) [] binds

1139
rhssOfBind :: Bind b -> [Expr b]
1140
1141
rhssOfBind (NonRec _ rhs) = [rhs]
rhssOfBind (Rec pairs)    = [rhs | (_,rhs) <- pairs]
1142

1143
rhssOfAlts :: [Alt b] -> [Expr b]
1144
rhssOfAlts alts = [e | (_,_,e) <- alts]
1145

1146
-- | Collapse all the bindings in the supplied groups into a single
Ian Lynagh's avatar
Ian Lynagh committed
1147
-- list of lhs\/rhs pairs suitable for binding in a 'Rec' binding group
1148
flattenBinds :: [Bind b] -> [(b, Expr b)]
1149
1150
1151
flattenBinds (NonRec b r : binds) = (b,r) : flattenBinds binds
flattenBinds (Rec prs1   : binds) = prs1 ++ flattenBinds binds
flattenBinds []			  = []
1152
1153
1154
\end{code}

\begin{code}
1155
1156
-- | We often want to strip off leading lambdas before getting down to
-- business. This function is your friend.
1157
collectBinders	             :: Expr b -> ([b],         Expr b)
1158
-- | Collect as many type bindings as possible from the front of a nested lambda
1159
collectTyBinders       	     :: CoreExpr -> ([TyVar],     CoreExpr)
1160
-- | Collect as many value bindings as possible from the front of a nested lambda
1161
collectValBinders      	     :: CoreExpr -> ([Id],        CoreExpr)
1162
1163
1164
-- | Collect type binders from the front of the lambda first, 
-- then follow up by collecting as many value bindings as possible
-- from the resulting stripped expression
1165
1166
1167
1168
1169
1170
1171
1172
collectTyAndValBinders 	     :: CoreExpr -> ([TyVar], [Id], CoreExpr)

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

1173
1174
1175
1176
1177
collectTyAndValBinders expr
  = (tvs, ids, body)
  where
    (tvs, body1) = collectTyBinders expr
    (ids, body)  = collectValBinders body1
1178

1179
collectTyBinders expr
1180
  = go [] expr
1181
  where
1182
    go tvs (Lam b e) | isTyVar b = go (b:tvs) e
1183
    go tvs e			 = (reverse tvs, e)
1184

1185
collectValBinders expr
1186
  = go [] expr
1187
  where
1188
1189
    go ids (Lam b e) | isId b = go (b:ids) e
    go ids body		      = (reverse ids, body)
1190
1191
1192
\end{code}

\begin{code}
1193
1194
-- | Takes a nested application expression and returns the the function
-- being applied and the arguments to which it is applied
1195
collectArgs :: Expr b -> (Expr b, [Arg b])
1196
collectArgs expr
1197
  = go expr []
1198
  where
1199
1200
    go (App f a) as = go f (a:as)
    go e 	 as = (e, as)
1201
1202
1203
1204
\end{code}

%************************************************************************
%*									*
1205
\subsection{Predicates}
1206
1207
1208
%*									*
%************************************************************************

1209
At one time we optionally carried type arguments through to runtime.
1210
1211
@isRuntimeVar v@ returns if (Lam v _) really becomes a lambda at runtime,
i.e. if type applications are actual lambdas because types are kept around
1212
at runtime.  Similarly isRuntimeArg.  
1213
1214

\begin{code}
1215
-- | Will this variable exist at runtime?
1216
isRuntimeVar :: Var -> Bool
1217
isRuntimeVar = isId 
1218

1219
-- | Will this argument expression exist at runtime?
1220
isRuntimeArg :: CoreExpr -> Bool
1221
isRuntimeArg = isValArg
1222

1223
1224
-- | Returns @False@ iff the expression is a 'Type' or 'Coercion'
-- expression at its top level
twanvl's avatar
twanvl committed
1225
isValArg :: Expr b -> Bool
1226
1227
1228
1229
1230
1231
1232
1233
isValArg e = not (isTypeArg e)

-- | Returns @True@ iff the expression is a 'Type' or 'Coercion'
-- expression at its top level
isTyCoArg :: Expr b -> Bool
isTyCoArg (Type {})     = True
isTyCoArg (Coercion {}) = True
isTyCoArg _             = False
1234

1235
1236
-- | Returns @True@ iff the expression is a 'Type' expression at its
-- top level.  Note this does NOT include 'Coercion's.
twanvl's avatar
twanvl committed
1237
isTypeArg :: Expr b -> Bool
1238
1239
isTypeArg (Type {}) = True
isTypeArg _         = False
1240

1241
-- | The number of binders that bind values rather than types
1242
valBndrCount :: [CoreBndr] -> Int
1243
valBndrCount = count isId
1244

1245
-- | The number of argument expressions that are values rather than types at their top level
1246
valArgCount :: [Arg b] -> Int
twanvl's avatar
twanvl committed
1247
valArgCount = count isValArg