IdInfo.lhs 21 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,
15
	seqIdInfo, megaSeqIdInfo,
16

17
	-- Zapping
18
	zapLamInfo, zapDemandInfo,
19

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

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

30
#ifdef OLD_STRICTNESS
31 32 33
	-- Strictness; imported from Demand
	StrictnessInfo(..),
	mkStrictnessInfo, noStrictnessInfo,
34
	ppStrictnessInfo,isBottomingStrictness, 
35
#endif
36

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

41
	-- Unfolding
42
	unfoldingInfo, setUnfoldingInfo, setUnfoldingInfoLazily,
43

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

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

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

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

65
	-- Specialisation
66 67
	SpecInfo(..), specInfo, setSpecInfo, isEmptySpecInfo, 
	specInfoFreeVars, specInfoRules, seqSpecInfo,
68

69
	-- CAF info
70
	CafInfo(..), cafInfo, ppCafInfo, setCafInfo, mayHaveCafRefs,
71

72
        -- Lambda-bound variable info
73
        LBVarInfo(..), lbvarInfo, setLBVarInfo, noLBVarInfo, hasNoLBVarInfo
74 75
    ) where

76
#include "HsVersions.h"
77 78


79
import CoreSyn
80
import Class		( Class )
81
import PrimOp	 	( PrimOp )
sof's avatar
sof committed
82
import Var              ( Id )
83
import VarSet		( VarSet, emptyVarSet, seqVarSet )
84
import BasicTypes	( OccInfo(..), isFragileOcc, isDeadOcc, seqOccInfo, isLoopBreaker,
85 86
			  InsideLam, insideLam, notInsideLam, 
			  OneBranch, oneBranch, notOneBranch,
87 88
			  Arity,
			  Activation(..)
89 90
			)
import DataCon		( DataCon )
91
import TyCon		( TyCon, FieldLabel )
92
import ForeignCall	( ForeignCall )
93
import NewDemand
94
import Outputable	
95
import Maybe		( isJust )
96

97
#ifdef OLD_STRICTNESS
98 99 100
import Name		( Name )
import Demand		hiding( Demand, seqDemand )
import qualified Demand
101
import Util		( listLengthCmp )
102
import List		( replicate )
103
#endif
104

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

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

To be removed later

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

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

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

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

157
#ifdef OLD_STRICTNESS
158 159 160 161 162 163 164 165 166 167 168 169
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
170
  | listLengthCmp ds arity /= GT -- length ds <= arity
171 172
	-- Sometimes the old strictness analyser has more
	-- demands than the arity justifies
173
  = mk_strict_sig name arity $
174 175
    mkTopDmdType (map newDemand ds) (newRes res cpr)

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

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

186
newRes True  _ 	        = BotRes
187
newRes False ReturnsCPR = retCPR
188 189 190 191
newRes False NoCPRInfo  = TopRes

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

oldDemand :: NewDemand.Demand -> Demand.Demand
199 200 201 202 203 204 205 206 207 208
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
209

210
#endif /* OLD_STRICTNESS */
211 212 213
\end{code}


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


220 221 222 223 224 225 226 227 228 229 230 231 232 233
%************************************************************************
%*									*
\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.

234 235
  | RecordSelId TyCon FieldLabel  -- The Id for a record selector

236
  | DataConWorkId DataCon	-- The Id for a data constructor *worker*
237 238 239 240 241 242
  | 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]

243 244
  | ClassOpId Class		-- An operation of a class

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

  | 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]")
255
    ppr (DataConWorkId _) = ptext SLIT("[DataCon]")
256
    ppr (DataConWrapId _) = ptext SLIT("[DataConWrapper]")
257
    ppr (ClassOpId _)     = ptext SLIT("[ClassOp]")
258
    ppr (PrimOpId _)      = ptext SLIT("[PrimOp]")
259
    ppr (FCallId _)       = ptext SLIT("[ForeignCall]")
260
    ppr (RecordSelId _ _) = ptext SLIT("[RecSel]")
261 262 263 264 265 266 267 268 269
\end{code}


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

270 271 272 273 274 275 276 277 278 279
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
280 281
(except for @DemandInfo@? ToDo). (@lbvarInfo@ is also a marginal
case.  KSW 1999-04).
282 283 284

\begin{code}
data IdInfo
285
  = IdInfo {
286
	arityInfo 	:: !ArityInfo,		-- Its arity
287
	specInfo 	:: SpecInfo,		-- Specialisations of this function which exist
288
#ifdef OLD_STRICTNESS
289 290
	cprInfo 	:: CprInfo,             -- Function always constructs a product result
	demandInfo 	:: Demand.Demand,	-- Whether or not it is definitely demanded
291
	strictnessInfo	:: StrictnessInfo,	-- Strictness properties
292
#endif
293
        workerInfo      :: WorkerInfo,          -- Pointer to Worker Function
294 295 296 297 298 299 300
						-- Within one module this is irrelevant; the 
						-- inlining of a worker is handled via the Unfolding
						-- WorkerInfo is used *only* to indicate the form of
						-- the RHS, so that interface files don't actually 
						-- need to contain the RHS; it can be derived from
						-- the strictness info

301
	unfoldingInfo	:: Unfolding,		-- Its unfolding
302
	cafInfo		:: CafInfo,		-- CAF info
303
        lbvarInfo	:: LBVarInfo,		-- Info about a lambda-bound variable
304
	inlinePragInfo	:: InlinePragInfo,	-- Inline pragma
305 306
	occInfo		:: OccInfo,		-- How it occurs

307 308 309 310
	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.
311 312 313 314

	newDemandInfo	  :: Maybe Demand	-- Similarly we want to know if there's no
						-- known demand yet, for when we are looking for
						-- CPR info
315
    }
316 317 318 319 320 321

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

megaSeqIdInfo :: IdInfo -> ()
megaSeqIdInfo info
322
  = seqSpecInfo (specInfo info)			`seq`
323
    seqWorker (workerInfo info)			`seq`
324 325 326

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

329
    seqNewDemandInfo (newDemandInfo info)	`seq`
330 331
    seqNewStrictnessInfo (newStrictnessInfo info) `seq`

332
#ifdef OLD_STRICTNESS
333 334 335 336
    Demand.seqDemand (demandInfo info)		`seq`
    seqStrictnessInfo (strictnessInfo info)	`seq`
    seqCpr (cprInfo info)			`seq`
#endif
337

338 339
    seqCaf (cafInfo info)			`seq`
    seqLBVar (lbvarInfo info)			`seq`
340
    seqOccInfo (occInfo info) 
341
\end{code}
342

343
Setters
344

345
\begin{code}
346
setWorkerInfo     info wk = wk `seq` info { workerInfo = wk }
sof's avatar
sof committed
347
setSpecInfo 	  info sp = sp `seq` info { specInfo = sp }
348
setInlinePragInfo info pr = pr `seq` info { inlinePragInfo = pr }
349
setOccInfo	  info oc = oc `seq` info { occInfo = oc }
350
#ifdef OLD_STRICTNESS
351
setStrictnessInfo info st = st `seq` info { strictnessInfo = st }
352
#endif
353 354
	-- Try to avoid spack leaks by seq'ing

355 356 357 358 359
setUnfoldingInfoLazily info uf 	-- Lazy variant to avoid looking at the
  =				-- unfolding of an imported Id unless necessary
    info { unfoldingInfo = uf }	-- (In this case the demand-zapping is redundant.)

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

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

369 370
setArityInfo	  info ar  = info { arityInfo = ar  }
setCafInfo        info caf = info { cafInfo = caf }
371

372 373 374 375
setLBVarInfo      info lb = {-lb `seq`-} info { lbvarInfo = lb }

setNewDemandInfo     info dd = dd `seq` info { newDemandInfo = dd }
setNewStrictnessInfo info dd = dd `seq` info { newStrictnessInfo = dd }
376 377
\end{code}

378

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

400
noCafIdInfo  = vanillaIdInfo `setCafInfo`    NoCafRefs
401
	-- Used for built-in type Ids in MkId.
402 403 404
\end{code}


405 406 407 408 409 410
%************************************************************************
%*									*
\subsection[arity-IdInfo]{Arity info about an @Id@}
%*									*
%************************************************************************

411 412 413 414
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!)

415
\begin{code}
416
type ArityInfo = Arity
417 418 419 420
  	-- 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.
421

422 423
	-- The arity might increase later in the compilation process, if
	-- an extra lambda floats up to the binding site.
424

425
unknownArity = 0 :: Arity
426

427 428
ppArityInfo 0 = empty
ppArityInfo n = hsep [ptext SLIT("Arity"), int n]
429 430 431 432
\end{code}

%************************************************************************
%*									*
433
\subsection{Inline-pragma information}
434 435 436 437
%*									*
%************************************************************************

\begin{code}
438 439 440 441 442 443 444
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
445 446 447

	-- The default InlinePragInfo is AlwaysActive, so the info serves
	-- entirely as a way to inhibit inlining until we want it
448
\end{code}
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
%************************************************************************
%*									*
	SpecInfo
%*									*
%************************************************************************

\begin{code}
-- CoreRules is used only in an idSpecialisation (move to IdInfo?)
data SpecInfo 
  = SpecInfo [CoreRule] VarSet	-- Locally-defined free vars of RHSs

emptySpecInfo :: SpecInfo
emptySpecInfo = SpecInfo [] emptyVarSet

isEmptySpecInfo :: SpecInfo -> Bool
isEmptySpecInfo (SpecInfo rs _) = null rs

specInfoFreeVars :: SpecInfo -> VarSet
specInfoFreeVars (SpecInfo _ fvs) = fvs

specInfoRules :: SpecInfo -> [CoreRule]
specInfoRules (SpecInfo rules _) = rules

seqSpecInfo (SpecInfo rules fvs) = seqRules rules `seq` seqVarSet fvs
\end{code}


478 479 480 481 482 483 484 485
%************************************************************************
%*									*
\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
486
information from strictness analysis.
487 488 489 490 491

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.
492

493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509
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".

510
\begin{code}
511

512 513 514
data WorkerInfo = NoWorker
		| HasWorker Id Arity
	-- The Arity is the arity of the *wrapper* at the moment of the
515
	-- w/w split.  See notes above.
516

517
seqWorker :: WorkerInfo -> ()
518
seqWorker (HasWorker id a) = id `seq` a `seq` ()
519
seqWorker NoWorker	   = ()
520

521
ppWorkerInfo NoWorker            = empty
522
ppWorkerInfo (HasWorker wk_id _) = ptext SLIT("Worker") <+> ppr wk_id
sof's avatar
sof committed
523

524
workerExists :: WorkerInfo -> Bool
525 526 527 528 529 530 531 532
workerExists NoWorker        = False
workerExists (HasWorker _ _) = True

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

wrapperArity :: WorkerInfo -> Arity
wrapperArity (HasWorker _ a) = a
533 534 535 536 537
\end{code}


%************************************************************************
%*									*
538
\subsection[CG-IdInfo]{Code generator-related information}
539 540 541 542
%*									*
%************************************************************************

\begin{code}
543 544
-- CafInfo is used to build Static Reference Tables (see simplStg/SRT.lhs).

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

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

554 555
vanillaCafInfo = MayHaveCafRefs		-- Definitely safe

556 557
mayHaveCafRefs  MayHaveCafRefs = True
mayHaveCafRefs _	       = False
558

559
seqCaf c = c `seq` ()
560

561
ppCafInfo NoCafRefs = ptext SLIT("NoCafRefs")
562
ppCafInfo MayHaveCafRefs = empty
563
\end{code}
564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589

%************************************************************************
%*									*
\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}
590
#ifdef OLD_STRICTNESS
591 592
data CprInfo
  = NoCPRInfo
593 594 595 596 597 598 599 600
  | 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
601

602
seqCpr :: CprInfo -> ()
603 604
seqCpr ReturnsCPR = ()
seqCpr NoCPRInfo  = ()
605 606 607

noCprInfo       = NoCPRInfo

608 609
ppCprInfo NoCPRInfo  = empty
ppCprInfo ReturnsCPR = ptext SLIT("__M")
610 611 612 613 614 615

instance Outputable CprInfo where
    ppr = ppCprInfo

instance Show CprInfo where
    showsPrec p c = showsPrecSDoc p (ppr c)
616
#endif
617 618 619
\end{code}


620 621 622 623 624
%************************************************************************
%*									*
\subsection[lbvar-IdInfo]{Lambda-bound var info about an @Id@}
%*									*
%************************************************************************
625

626
If the @Id@ is a lambda-bound variable then it may have lambda-bound
627 628
var info.  Sometimes we know whether the lambda binding this var is a
``one-shot'' lambda; that is, whether it is applied at most once.
629 630 631 632 633 634

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

\begin{code}
635 636
data LBVarInfo = NoLBVarInfo 
	       | IsOneShotLambda	-- The lambda is applied at most once).
637 638

seqLBVar l = l `seq` ()
639 640 641
\end{code}

\begin{code}
642 643
hasNoLBVarInfo NoLBVarInfo     = True
hasNoLBVarInfo IsOneShotLambda = False
644

645 646
noLBVarInfo = NoLBVarInfo

647
pprLBVarInfo NoLBVarInfo     = empty
648
pprLBVarInfo IsOneShotLambda = ptext SLIT("OneShot")
649 650

instance Outputable LBVarInfo where
651
    ppr = pprLBVarInfo
652 653 654 655

instance Show LBVarInfo where
    showsPrec p c = showsPrecSDoc p (ppr c)
\end{code}
656 657 658 659 660 661 662 663 664 665 666 667 668


%************************************************************************
%*									*
\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
669
zapLamInfo info@(IdInfo {occInfo = occ, newDemandInfo = demand})
670
  | is_safe_occ occ && is_safe_dmd demand
671 672
  = Nothing
  | otherwise
673
  = Just (info {occInfo = safe_occ, newDemandInfo = Nothing})
674 675 676
  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
677 678
    is_safe_occ (OneOcc in_lam once) = in_lam
    is_safe_occ other		     = True
679 680 681 682

    safe_occ = case occ of
		 OneOcc _ once -> OneOcc insideLam once
		 other	       -> occ
683 684 685

    is_safe_dmd Nothing    = True
    is_safe_dmd (Just dmd) = not (isStrictDmd dmd)
686 687
\end{code}

688 689
\begin{code}
zapDemandInfo :: IdInfo -> Maybe IdInfo
690 691 692
zapDemandInfo info@(IdInfo {newDemandInfo = dmd})
  | isJust dmd = Just (info {newDemandInfo = Nothing})
  | otherwise  = Nothing
693 694
\end{code}