IdInfo.lhs 23.8 KB
Newer Older
1
%
2
% (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
3
4
5
6
7
8
9
10
%
\section[IdInfo]{@IdInfos@: Non-essential information about @Ids@}

(And a pretty good illustration of quite a few things wrong with
Haskell. [WDP 94/11])

\begin{code}
module IdInfo (
11
	GlobalIdDetails(..), notGlobalId, 	-- Not abstract
12

13
	IdInfo,		-- Abstract
14
	vanillaIdInfo, noCafIdInfo, hasCafIdInfo,
15
	seqIdInfo, megaSeqIdInfo,
16

17
	-- Zapping
18
	zapLamInfo, zapDemandInfo,
19
	shortableIdInfo, copyIdInfo,
20

21
	-- Arity
22
	ArityInfo,
23
24
	unknownArity, 
	arityInfo, setArityInfo, ppArityInfo, 
25

26
	-- New demand and strictness info
27
 	newStrictnessInfo, setNewStrictnessInfo, 
28
  	newDemandInfo, setNewDemandInfo, pprNewStrictness,
29

30
31
32
	-- Strictness; imported from Demand
	StrictnessInfo(..),
	mkStrictnessInfo, noStrictnessInfo,
33
	ppStrictnessInfo,isBottomingStrictness, 
34
	setAllStrictnessInfo,
35

36
        -- Worker
37
        WorkerInfo(..), workerExists, wrapperArity, workerId,
38
        workerInfo, setWorkerInfo, ppWorkerInfo,
39

40
41
	-- Unfolding
	unfoldingInfo, setUnfoldingInfo, 
42

43
#ifdef OLD_STRICTNESS
44
	-- Old DemandInfo and StrictnessInfo
45
	demandInfo, setDemandInfo, 
46
47
48
49
50
51
52
53
	strictnessInfo, setStrictnessInfo,
        cprInfoFromNewStrictness,
	oldStrictnessFromNew, newStrictnessFromOld,
	oldDemand, newDemand,

        -- Constructed Product Result Info
        CprInfo(..), cprInfo, setCprInfo, ppCprInfo, noCprInfo,
#endif
54

55
	-- Inline prags
56
	InlinePragInfo, 
57
	inlinePragInfo, setInlinePragInfo, 
58
59

	-- Occurrence info
60
	OccInfo(..), isFragileOcc, isDeadOcc, isLoopBreaker,
61
62
	InsideLam, OneBranch, insideLam, notInsideLam, oneBranch, notOneBranch,
	occInfo, setOccInfo, 
63

64
	-- Specialisation
65
	specInfo, setSpecInfo,
66

67
	-- CG info
68
	CgInfo(..), cgInfo, setCgInfo,  pprCgInfo,
69
 	cgCafInfo, vanillaCgInfo,
70
71
	CgInfoEnv, lookupCgInfo,

72
	-- CAF info
73
	CafInfo(..), ppCafInfo, setCafInfo, mayHaveCafRefs,
74

75
        -- Lambda-bound variable info
76
        LBVarInfo(..), lbvarInfo, setLBVarInfo, noLBVarInfo, hasNoLBVarInfo
77
78
    ) where

79
#include "HsVersions.h"
80
81


82
import CoreSyn
83
import Type		( Type, usOnce, eqUsage )
84
import PrimOp	 	( PrimOp )
85
86
import NameEnv		( NameEnv, lookupNameEnv )
import Name		( Name )
sof's avatar
sof committed
87
import Var              ( Id )
88
import BasicTypes	( OccInfo(..), isFragileOcc, isDeadOcc, seqOccInfo, isLoopBreaker,
89
90
			  InsideLam, insideLam, notInsideLam, 
			  OneBranch, oneBranch, notOneBranch,
91
92
			  Arity,
			  Activation(..)
93
94
			)
import DataCon		( DataCon )
95
import ForeignCall	( ForeignCall )
96
import FieldLabel	( FieldLabel )
97
import Type		( usOnce )
98
import Demand		hiding( Demand, seqDemand )
99
import qualified Demand
100
import NewDemand
101
import Outputable	
102
import Util		( listLengthCmp )
103
import Maybe		( isJust )
104
import List		( replicate )
105

106
-- infixl so you can say (id `set` a `set` b)
107
infixl 	1 `setSpecInfo`,
108
109
110
111
	  `setArityInfo`,
	  `setInlinePragInfo`,
	  `setUnfoldingInfo`,
	  `setWorkerInfo`,
112
	  `setLBVarInfo`,
113
114
	  `setOccInfo`,
	  `setCgInfo`,
115
	  `setCafInfo`,
116
	  `setNewStrictnessInfo`,
117
	  `setAllStrictnessInfo`,
118
	  `setNewDemandInfo`
119
#ifdef OLD_STRICTNESS
120
121
122
	  , `setCprInfo`
	  , `setDemandInfo`
	  , `setStrictnessInfo`
123
#endif
124
125
\end{code}

126
127
128
129
130
131
132
133
134
%************************************************************************
%*									*
\subsection{New strictness info}
%*									*
%************************************************************************

To be removed later

\begin{code}
135
-- setAllStrictnessInfo :: IdInfo -> Maybe StrictSig -> IdInfo
136
137
-- Set old and new strictness info
setAllStrictnessInfo info Nothing
138
  = info { newStrictnessInfo = Nothing
139
#ifdef OLD_STRICTNESS
140
141
         , strictnessInfo = NoStrictnessInfo
         , cprInfo = NoCPRInfo
142
#endif
143
144
         }

145
setAllStrictnessInfo info (Just sig)
146
  = info { newStrictnessInfo = Just sig
147
#ifdef OLD_STRICTNESS
148
149
         , strictnessInfo = oldStrictnessFromNew sig
         , cprInfo = cprInfoFromNewStrictness sig
150
#endif
151
         }
152
153
154

seqNewStrictnessInfo Nothing = ()
seqNewStrictnessInfo (Just ty) = seqStrictSig ty
155

156
157
158
pprNewStrictness Nothing = empty
pprNewStrictness (Just sig) = ftext FSLIT("Str:") <+> ppr sig

159
#ifdef OLD_STRICTNESS
160
161
162
163
164
165
166
167
168
169
170
171
oldStrictnessFromNew :: StrictSig -> Demand.StrictnessInfo
oldStrictnessFromNew sig = mkStrictnessInfo (map oldDemand dmds, isBotRes res_info)
			 where
			   (dmds, res_info) = splitStrictSig sig

cprInfoFromNewStrictness :: StrictSig -> CprInfo
cprInfoFromNewStrictness sig = case strictSigResInfo sig of
				  RetCPR -> ReturnsCPR
				  other  -> NoCPRInfo

newStrictnessFromOld :: Name -> Arity -> Demand.StrictnessInfo -> CprInfo -> StrictSig
newStrictnessFromOld name arity (Demand.StrictnessInfo ds res) cpr
sof's avatar
sof committed
172
  | listLengthCmp ds arity /= GT -- length ds <= arity
173
174
	-- Sometimes the old strictness analyser has more
	-- demands than the arity justifies
175
  = mk_strict_sig name arity $
176
177
    mkTopDmdType (map newDemand ds) (newRes res cpr)

178
newStrictnessFromOld name arity other cpr
179
180
  =	-- Either no strictness info, or arity is too small
	-- In either case we can't say anything useful
181
    mk_strict_sig name arity $
182
    mkTopDmdType (replicate arity lazyDmd) (newRes False cpr)
183

184
185
mk_strict_sig name arity dmd_ty
  = WARN( arity /= dmdTypeDepth dmd_ty, ppr name <+> (ppr arity $$ ppr dmd_ty) )
186
187
    mkStrictSig dmd_ty

188
newRes True  _ 	        = BotRes
189
newRes False ReturnsCPR = retCPR
190
191
192
193
newRes False NoCPRInfo  = TopRes

newDemand :: Demand.Demand -> NewDemand.Demand
newDemand (WwLazy True)      = Abs
194
195
196
197
198
newDemand (WwLazy False)     = lazyDmd
newDemand WwStrict	     = evalDmd
newDemand (WwUnpack unpk ds) = Eval (Prod (map newDemand ds))
newDemand WwPrim	     = lazyDmd
newDemand WwEnum	     = evalDmd
199
200

oldDemand :: NewDemand.Demand -> Demand.Demand
201
202
203
204
205
206
207
208
209
210
oldDemand Abs	     	   = WwLazy True
oldDemand Top	     	   = WwLazy False
oldDemand Bot	     	   = WwStrict
oldDemand (Box Bot)	   = WwStrict
oldDemand (Box Abs)	   = WwLazy False
oldDemand (Box (Eval _))   = WwStrict	-- Pass box only
oldDemand (Defer d)        = WwLazy False
oldDemand (Eval (Prod ds)) = WwUnpack True (map oldDemand ds)
oldDemand (Eval (Poly _))  = WwStrict
oldDemand (Call _)         = WwStrict
211

212
#endif /* OLD_STRICTNESS */
213
214
215
\end{code}


216
217
218
219
220
221
\begin{code}
seqNewDemandInfo Nothing    = ()
seqNewDemandInfo (Just dmd) = seqDemand dmd
\end{code}


222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
%************************************************************************
%*									*
\subsection{GlobalIdDetails
%*									*
%************************************************************************

This type is here (rather than in Id.lhs) mainly because there's 
an IdInfo.hi-boot, but no Id.hi-boot, and GlobalIdDetails is imported
(recursively) by Var.lhs.

\begin{code}
data GlobalIdDetails
  = VanillaGlobal		-- Imported from elsewhere, a default method Id.

  | RecordSelId FieldLabel	-- The Id for a record selector
  | DataConId DataCon		-- The Id for a data constructor *worker*
  | DataConWrapId DataCon	-- The Id for a data constructor *wrapper*
				-- [the only reasons we need to know is so that
				--  a) we can  suppress printing a definition in the interface file
				--  b) when typechecking a pattern we can get from the
				--     Id back to the data con]

  | PrimOpId PrimOp		-- The Id for a primitive operator
245
  | FCallId ForeignCall		-- The Id for a foreign call
246
247
248
249
250
251
252
253
254
255
256

  | NotGlobalId			-- Used as a convenient extra return value from globalIdDetails
    
notGlobalId = NotGlobalId

instance Outputable GlobalIdDetails where
    ppr NotGlobalId       = ptext SLIT("[***NotGlobalId***]")
    ppr VanillaGlobal     = ptext SLIT("[GlobalId]")
    ppr (DataConId _)     = ptext SLIT("[DataCon]")
    ppr (DataConWrapId _) = ptext SLIT("[DataConWrapper]")
    ppr (PrimOpId _)      = ptext SLIT("[PrimOp]")
257
    ppr (FCallId _)       = ptext SLIT("[ForeignCall]")
258
259
260
261
262
263
264
265
266
267
    ppr (RecordSelId _)   = ptext SLIT("[RecSel]")
\end{code}


%************************************************************************
%*									*
\subsection{The main IdInfo type}
%*									*
%************************************************************************

268
269
270
271
272
273
274
275
276
277
An @IdInfo@ gives {\em optional} information about an @Id@.  If
present it never lies, but it may not be present, in which case there
is always a conservative assumption which can be made.

Two @Id@s may have different info even though they have the same
@Unique@ (and are hence the same @Id@); for example, one might lack
the properties attached to the other.

The @IdInfo@ gives information about the value, or definition, of the
@Id@.  It does {\em not} contain information about the @Id@'s usage
278
279
(except for @DemandInfo@? ToDo). (@lbvarInfo@ is also a marginal
case.  KSW 1999-04).
280
281
282

\begin{code}
data IdInfo
283
  = IdInfo {
284
	arityInfo 	:: !ArityInfo,		-- Its arity
285
	specInfo 	:: CoreRules,		-- Specialisations of this function which exist
286
#ifdef OLD_STRICTNESS
287
288
	cprInfo 	:: CprInfo,             -- Function always constructs a product result
	demandInfo 	:: Demand.Demand,	-- Whether or not it is definitely demanded
289
	strictnessInfo	:: StrictnessInfo,	-- Strictness properties
290
#endif
291
292
        workerInfo      :: WorkerInfo,          -- Pointer to Worker Function
	unfoldingInfo	:: Unfolding,		-- Its unfolding
293
	cgInfo		:: CgInfo,		-- Code generator info (arity, CAF info)
294
        lbvarInfo	:: LBVarInfo,		-- Info about a lambda-bound variable
295
	inlinePragInfo	:: InlinePragInfo,	-- Inline pragma
296
297
	occInfo		:: OccInfo,		-- How it occurs

298
299
300
301
	newStrictnessInfo :: Maybe StrictSig,	-- Reason for Maybe: the DmdAnal phase needs to
						-- know whether whether this is the first visit,
						-- so it can assign botSig.  Other customers want
						-- topSig.  So Nothing is good.
302
303
304
305

	newDemandInfo	  :: Maybe Demand	-- Similarly we want to know if there's no
						-- known demand yet, for when we are looking for
						-- CPR info
306
    }
307
308
309
310
311
312

seqIdInfo :: IdInfo -> ()
seqIdInfo (IdInfo {}) = ()

megaSeqIdInfo :: IdInfo -> ()
megaSeqIdInfo info
313
  = seqRules (specInfo info)			`seq`
314
    seqWorker (workerInfo info)			`seq`
315
316
317

-- Omitting this improves runtimes a little, presumably because
-- some unfoldings are not calculated at all
318
319
--    seqUnfolding (unfoldingInfo info)		`seq`

320
    seqNewDemandInfo (newDemandInfo info)	`seq`
321
322
    seqNewStrictnessInfo (newStrictnessInfo info) `seq`

323
#ifdef OLD_STRICTNESS
324
325
326
327
    Demand.seqDemand (demandInfo info)		`seq`
    seqStrictnessInfo (strictnessInfo info)	`seq`
    seqCpr (cprInfo info)			`seq`
#endif
328

329
330
331
-- CgInfo is involved in a loop, so we have to be careful not to seq it
-- too early.
--    seqCg (cgInfo info)			`seq`
332
    seqLBVar (lbvarInfo info)		`seq`
333
    seqOccInfo (occInfo info) 
334
\end{code}
335

336
Setters
337

338
\begin{code}
339
setWorkerInfo     info wk = wk `seq` info { workerInfo = wk }
sof's avatar
sof committed
340
setSpecInfo 	  info sp = sp `seq` info { specInfo = sp }
341
setInlinePragInfo info pr = pr `seq` info { inlinePragInfo = pr }
342
setOccInfo	  info oc = oc `seq` info { occInfo = oc }
343
#ifdef OLD_STRICTNESS
344
setStrictnessInfo info st = st `seq` info { strictnessInfo = st }
345
#endif
346
347
	-- Try to avoid spack leaks by seq'ing

348
setUnfoldingInfo  info uf 
349
  | isEvaldUnfolding uf
350
351
352
353
354
355
356
357
358
	-- If the unfolding is a value, the demand info may
	-- go pear-shaped, so we nuke it.  Example:
	--	let x = (a,b) in
	--	case x of (p,q) -> h p q x
	-- Here x is certainly demanded. But after we've nuked
	-- the case, we'll get just
	--	let x = (a,b) in h a b x
	-- and now x is not demanded (I'm assuming h is lazy)
	-- This really happens.  The solution here is a bit ad hoc...
359
  = info { unfoldingInfo = uf, newDemandInfo = Nothing }
360
361

  | otherwise
362
363
	-- We do *not* seq on the unfolding info, For some reason, doing so 
	-- actually increases residency significantly. 
364
  = info { unfoldingInfo = uf }
365

366
#ifdef OLD_STRICTNESS
367
setDemandInfo	  info dd = info { demandInfo = dd }
368
369
370
setCprInfo        info cp = info { cprInfo = cp }
#endif

371
setArityInfo	  info ar = info { arityInfo = ar  }
372
setCgInfo         info cg = info { cgInfo = cg }
373

374
375
376
377
setLBVarInfo      info lb = {-lb `seq`-} info { lbvarInfo = lb }

setNewDemandInfo     info dd = dd `seq` info { newDemandInfo = dd }
setNewStrictnessInfo info dd = dd `seq` info { newStrictnessInfo = dd }
378
379
\end{code}

380

381
\begin{code}
382
vanillaIdInfo :: IdInfo
383
vanillaIdInfo 
384
  = IdInfo {
385
	    cgInfo		= noCgInfo,
386
	    arityInfo		= unknownArity,
387
#ifdef OLD_STRICTNESS
388
	    cprInfo		= NoCPRInfo,
389
	    demandInfo		= wwLazy,
390
391
	    strictnessInfo	= NoStrictnessInfo,
#endif
392
393
394
395
	    specInfo		= emptyCoreRules,
	    workerInfo		= NoWorker,
	    unfoldingInfo	= noUnfolding,
	    lbvarInfo		= NoLBVarInfo,
396
	    inlinePragInfo 	= AlwaysActive,
397
	    occInfo		= NoOccInfo,
398
	    newDemandInfo	= Nothing,
399
	    newStrictnessInfo   = Nothing
400
	   }
401

402
403
hasCafIdInfo = vanillaIdInfo `setCgInfo`    CgInfo MayHaveCafRefs
noCafIdInfo  = vanillaIdInfo `setCgInfo`    CgInfo NoCafRefs
404
	-- Used for built-in type Ids in MkId.
405
406
	-- These must have a valid CgInfo set, so you can't
	-- 	use vanillaIdInfo!
407
408
409
\end{code}


410
411
412
413
414
415
%************************************************************************
%*									*
\subsection[arity-IdInfo]{Arity info about an @Id@}
%*									*
%************************************************************************

416
417
418
419
For locally-defined Ids, the code generator maintains its own notion
of their arities; so it should not be asking...	 (but other things
besides the code-generator need arity info!)

420
\begin{code}
421
type ArityInfo = Arity
422
423
424
425
  	-- A partial application of this Id to up to n-1 value arguments
	-- does essentially no work.  That is not necessarily the
	-- same as saying that it has n leading lambdas, because coerces
	-- may get in the way.
426

427
428
	-- The arity might increase later in the compilation process, if
	-- an extra lambda floats up to the binding site.
429

430
unknownArity = 0 :: Arity
431

432
433
ppArityInfo 0 = empty
ppArityInfo n = hsep [ptext SLIT("Arity"), int n]
434
435
436
437
\end{code}

%************************************************************************
%*									*
438
\subsection{Inline-pragma information}
439
440
441
442
%*									*
%************************************************************************

\begin{code}
443
444
445
446
447
448
449
type InlinePragInfo = Activation
	-- Tells when the inlining is active
	-- When it is active the thing may be inlined, depending on how
	-- big it is.
	--
	-- If there was an INLINE pragma, then as a separate matter, the
	-- RHS will have been made to look small with a CoreSyn Inline Note
450
\end{code}
451
452


453
454
455
456
457
458
459
460
%************************************************************************
%*									*
\subsection[worker-IdInfo]{Worker info about an @Id@}
%*									*
%************************************************************************

If this Id has a worker then we store a reference to it. Worker
functions are generated by the worker/wrapper pass.  This uses
461
information from strictness analysis.
462
463
464
465
466

There might not be a worker, even for a strict function, because:
(a) the function might be small enough to inline, so no need 
    for w/w split
(b) the strictness info might be "SSS" or something, so no w/w split.
467

468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
Sometimes the arity of a wrapper changes from the original arity from
which it was generated, so we always emit the "original" arity into
the interface file, as part of the worker info.

How can this happen?  Sometimes we get
	f = coerce t (\x y -> $wf x y)
at the moment of w/w split; but the eta reducer turns it into
	f = coerce t $wf
which is perfectly fine except that the exposed arity so far as
the code generator is concerned (zero) differs from the arity
when we did the split (2).  

All this arises because we use 'arity' to mean "exactly how many
top level lambdas are there" in interface files; but during the
compilation of this module it means "how many things can I apply
this to".

485
\begin{code}
486

487
488
489
data WorkerInfo = NoWorker
		| HasWorker Id Arity
	-- The Arity is the arity of the *wrapper* at the moment of the
490
	-- w/w split. See comments in MkIface.ifaceId, with the 'Worker' code.
491

492
seqWorker :: WorkerInfo -> ()
493
seqWorker (HasWorker id a) = id `seq` a `seq` ()
494
seqWorker NoWorker	   = ()
495

496
497
ppWorkerInfo NoWorker            = empty
ppWorkerInfo (HasWorker wk_id _) = ptext SLIT("__P") <+> ppr wk_id
sof's avatar
sof committed
498

499
workerExists :: WorkerInfo -> Bool
500
501
502
503
504
505
506
507
workerExists NoWorker        = False
workerExists (HasWorker _ _) = True

workerId :: WorkerInfo -> Id
workerId (HasWorker id _) = id

wrapperArity :: WorkerInfo -> Arity
wrapperArity (HasWorker _ a) = a
508
509
510
511
512
\end{code}


%************************************************************************
%*									*
513
\subsection[CG-IdInfo]{Code generator-related information}
514
515
516
%*									*
%************************************************************************

517
518
519
520
CgInfo encapsulates calling-convention information produced by the code 
generator.  It is pasted into the IdInfo of each emitted Id by CoreTidy,
but only as a thunk --- the information is only actually produced further
downstream, by the code generator.
521
522

\begin{code}
523
#ifndef OLD_STRICTNESS
524
525
526
527
newtype CgInfo = CgInfo CafInfo	-- We are back to only having CafRefs in CgInfo
noCgInfo = panic "NoCgInfo!"
#else
data CgInfo = CgInfo CafInfo
528
529
530
531
532
	    | NoCgInfo		-- In debug mode we don't want a black hole here
				-- See Id.idCgInfo
	-- noCgInfo is used for local Ids, which shouldn't need any CgInfo
noCgInfo = NoCgInfo
#endif
533

534
cgCafInfo (CgInfo caf_info) = caf_info
535

536
setCafInfo info caf_info = info `setCgInfo` CgInfo caf_info 
537
538
539

seqCg c = c `seq` ()  -- fields are strict anyhow

540
vanillaCgInfo = CgInfo MayHaveCafRefs		-- Definitely safe
541
542
543

-- CafInfo is used to build Static Reference Tables (see simplStg/SRT.lhs).

544
545
546
547
548
data CafInfo 
	= MayHaveCafRefs		-- either:
					-- (1) A function or static constructor
					--     that refers to one or more CAFs,
					-- (2) A real live CAF
549

550
551
	| NoCafRefs			-- A function or static constructor
				        -- that refers to no CAFs.
552

553
554
mayHaveCafRefs  MayHaveCafRefs = True
mayHaveCafRefs _	       = False
555

556
seqCaf c = c `seq` ()
557

558
pprCgInfo (CgInfo caf_info) = ppCafInfo caf_info
559

560
561
ppArity 0 = empty
ppArity n = hsep [ptext SLIT("__A"), int n]
562

563
564
ppCafInfo NoCafRefs = ptext SLIT("__C")
ppCafInfo MayHaveCafRefs = empty
565
\end{code}
566

567
568
569
570
571
572
573
574
575
\begin{code}
type CgInfoEnv = NameEnv CgInfo

lookupCgInfo :: NameEnv CgInfo -> Name -> CgInfo
lookupCgInfo env n = case lookupNameEnv env n of
			Just info -> info
			Nothing   -> pprTrace "Urk! Not in CgInfo env" (ppr n) vanillaCgInfo
\end{code}

576

577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
%************************************************************************
%*									*
\subsection[cpr-IdInfo]{Constructed Product Result info about an @Id@}
%*									*
%************************************************************************

If the @Id@ is a function then it may have CPR info. A CPR analysis
phase detects whether:

\begin{enumerate}
\item
The function's return value has a product type, i.e. an algebraic  type 
with a single constructor. Examples of such types are tuples and boxed
primitive values.
\item
The function always 'constructs' the value that it is returning.  It
must do this on every path through,  and it's OK if it calls another
function which constructs the result.
\end{enumerate}

If this is the case then we store a template which tells us the
function has the CPR property and which components of the result are
also CPRs.   

\begin{code}
602
#ifdef OLD_STRICTNESS
603
604
data CprInfo
  = NoCPRInfo
605
606
607
608
609
610
611
612
  | ReturnsCPR	-- Yes, this function returns a constructed product
		-- Implicitly, this means "after the function has been applied
		-- to all its arguments", so the worker/wrapper builder in 
		-- WwLib.mkWWcpr checks that that it is indeed saturated before
		-- making use of the CPR info

	-- We used to keep nested info about sub-components, but
	-- we never used it so I threw it away
613

614
seqCpr :: CprInfo -> ()
615
616
seqCpr ReturnsCPR = ()
seqCpr NoCPRInfo  = ()
617
618
619

noCprInfo       = NoCPRInfo

620
621
ppCprInfo NoCPRInfo  = empty
ppCprInfo ReturnsCPR = ptext SLIT("__M")
622
623
624
625
626
627

instance Outputable CprInfo where
    ppr = ppCprInfo

instance Show CprInfo where
    showsPrec p c = showsPrecSDoc p (ppr c)
628
#endif
629
630
631
\end{code}


632
633
634
635
636
%************************************************************************
%*									*
\subsection[lbvar-IdInfo]{Lambda-bound var info about an @Id@}
%*									*
%************************************************************************
637

638
639
640
641
642
643
644
645
646
647
648
649
650
If the @Id@ is a lambda-bound variable then it may have lambda-bound
var info.  The usage analysis (UsageSP) detects whether the lambda
binding this var is a ``one-shot'' lambda; that is, whether it is
applied at most once.

This information may be useful in optimisation, as computations may
safely be floated inside such a lambda without risk of duplicating
work.

\begin{code}
data LBVarInfo
  = NoLBVarInfo

651
652
653
654
  | LBVarInfo Type		-- The lambda that binds this Id has this usage
				--   annotation (i.e., if ==usOnce, then the
				--   lambda is applied at most once).
				-- The annotation's kind must be `$'
655
656
657
				-- HACK ALERT! placing this info here is a short-term hack,
				--   but it minimises changes to the rest of the compiler.
				--   Hack agreed by SLPJ/KSW 1999-04.
658
659

seqLBVar l = l `seq` ()
660
661
662
\end{code}

\begin{code}
663
664
665
hasNoLBVarInfo NoLBVarInfo = True
hasNoLBVarInfo other       = False

666
667
668
669
noLBVarInfo = NoLBVarInfo

-- not safe to print or parse LBVarInfo because it is not really a
-- property of the definition, but a property of the context.
670
pprLBVarInfo NoLBVarInfo     = empty
671
pprLBVarInfo (LBVarInfo u)   | u `eqUsage` usOnce
672
                             = ptext SLIT("OneShot")
673
674
                             | otherwise
                             = empty
675
676

instance Outputable LBVarInfo where
677
    ppr = pprLBVarInfo
678
679
680
681

instance Show LBVarInfo where
    showsPrec p c = showsPrecSDoc p (ppr c)
\end{code}
682
683
684
685
686
687
688
689
690
691
692
693
694


%************************************************************************
%*									*
\subsection{Bulk operations on IdInfo}
%*									*
%************************************************************************

@zapLamInfo@ is used for lambda binders that turn out to to be
part of an unsaturated lambda

\begin{code}
zapLamInfo :: IdInfo -> Maybe IdInfo
695
zapLamInfo info@(IdInfo {occInfo = occ, newDemandInfo = demand})
696
  | is_safe_occ occ && is_safe_dmd demand
697
698
  = Nothing
  | otherwise
699
  = Just (info {occInfo = safe_occ, newDemandInfo = Nothing})
700
701
702
  where
	-- The "unsafe" occ info is the ones that say I'm not in a lambda
	-- because that might not be true for an unsaturated lambda
703
704
    is_safe_occ (OneOcc in_lam once) = in_lam
    is_safe_occ other		     = True
705
706
707
708

    safe_occ = case occ of
		 OneOcc _ once -> OneOcc insideLam once
		 other	       -> occ
709
710
711

    is_safe_dmd Nothing    = True
    is_safe_dmd (Just dmd) = not (isStrictDmd dmd)
712
713
\end{code}

714
715
\begin{code}
zapDemandInfo :: IdInfo -> Maybe IdInfo
716
717
718
zapDemandInfo info@(IdInfo {newDemandInfo = dmd})
  | isJust dmd = Just (info {newDemandInfo = Nothing})
  | otherwise  = Nothing
719
720
\end{code}

721
722
723
724
725
726
727
728

copyIdInfo is used when shorting out a top-level binding
	f_local = BIG
	f = f_local
where f is exported.  We are going to swizzle it around to
	f = BIG
	f_local = f

729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
BUT (a) we must be careful about messing up rules
    (b) we must ensure f's IdInfo ends up right

(a) Messing up the rules
~~~~~~~~~~~~~~~~~~~~
The example that went bad on me was this one:
	
    iterate :: (a -> a) -> a -> [a]
    iterate = iterateList
    
    iterateFB c f x = x `c` iterateFB c f (f x)
    iterateList f x =  x : iterateList f (f x)
    
    {-# RULES
    "iterate"	forall f x.	iterate f x = build (\c _n -> iterateFB c f x)
    "iterateFB" 		iterateFB (:) = iterateList
     #-}

This got shorted out to:

    iterateList :: (a -> a) -> a -> [a]
    iterateList = iterate
    
    iterateFB c f x = x `c` iterateFB c f (f x)
    iterate f x =  x : iterate f (f x)
    
    {-# RULES
    "iterate"	forall f x.	iterate f x = build (\c _n -> iterateFB c f x)
    "iterateFB" 		iterateFB (:) = iterate
     #-}

And now we get an infinite loop in the rule system 
761
	iterate f x -> build (\cn -> iterateFB c f x)
762
763
764
765
766
767
768
769
770
771
		    -> iterateFB (:) f x
		    -> iterate f x

Tiresome solution: don't do shorting out if f has rewrite rules.
Hence shortableIdInfo.

(b) Keeping the IdInfo right
~~~~~~~~~~~~~~~~~~~~~~~~
We want to move strictness/worker info from f_local to f, but keep the rest.
Hence copyIdInfo.
772
773

\begin{code}
774
775
776
777
778
779
shortableIdInfo :: IdInfo -> Bool
shortableIdInfo info = isEmptyCoreRules (specInfo info)

copyIdInfo :: IdInfo	-- f_local
  	   -> IdInfo	-- f (the exported one)
	   -> IdInfo	-- New info for f
780
copyIdInfo f_local f = f { newStrictnessInfo = newStrictnessInfo f_local,
781
#ifdef OLD_STRICTNESS
782
			   strictnessInfo = strictnessInfo f_local,
783
			   cprInfo        = cprInfo        f_local,
784
#endif
785
			   workerInfo     = workerInfo     f_local
786
787
			  }
\end{code}