07c592be3fdc74770e2668e4e2b8e48ce72c2eae
[ghc.git] / compiler / stranal / DmdAnal.lhs
1 %
2 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
3 %
4
5                         -----------------
6                         A demand analysis
7                         -----------------
8
9 \begin{code}
10 {-# OPTIONS -fno-warn-tabs #-}
11
12 module DmdAnal ( dmdAnalProgram ) where
13
14 #include "HsVersions.h"
15
16 import Var              ( isTyVar )
17 import DynFlags
18 import WwLib            ( deepSplitProductType_maybe )
19 import Demand   -- All of it
20 import CoreSyn
21 import Outputable
22 import VarEnv
23 import BasicTypes       
24 import FastString
25 import Data.List
26 import DataCon
27 import Id
28 import CoreUtils        ( exprIsHNF, exprType, exprIsTrivial )
29 import PprCore  
30 import TyCon
31 import Type             ( eqType )
32 -- import Pair
33 -- import Coercion         ( coercionKind )
34 import Util
35 import Maybes           ( isJust, orElse )
36 import TysWiredIn       ( unboxedPairDataCon )
37 import TysPrim          ( realWorldStatePrimTy )
38 \end{code}
39
40 %************************************************************************
41 %*                                                                      *
42 \subsection{Top level stuff}
43 %*                                                                      *
44 %************************************************************************
45
46 \begin{code}
47 dmdAnalProgram :: DynFlags -> CoreProgram -> IO CoreProgram
48 dmdAnalProgram dflags binds
49   = do {
50         let { binds_plus_dmds = do_prog binds } ;
51         return binds_plus_dmds
52     }
53   where
54     do_prog :: CoreProgram -> CoreProgram
55     do_prog binds = snd $ mapAccumL dmdAnalTopBind (emptyAnalEnv dflags) binds
56
57 -- Analyse a (group of) top-level binding(s)
58 dmdAnalTopBind :: AnalEnv
59                -> CoreBind 
60                -> (AnalEnv, CoreBind)
61 dmdAnalTopBind sigs (NonRec id rhs)
62   = (extendAnalEnv TopLevel sigs id sig, NonRec id2 rhs2)
63   where
64     (  _, _, _,   rhs1) = dmdAnalRhs TopLevel Nothing sigs             id rhs
65     (sig, _, id2, rhs2) = dmdAnalRhs TopLevel Nothing (nonVirgin sigs) id rhs1
66         -- Do two passes to improve CPR information
67         -- See comments with ignore_cpr_info in mk_sig_ty
68         -- and with extendSigsWithLam
69
70 dmdAnalTopBind sigs (Rec pairs)
71   = (sigs', Rec pairs')
72   where
73     (sigs', _, pairs')  = dmdFix TopLevel sigs pairs
74                 -- We get two iterations automatically
75                 -- c.f. the NonRec case above
76 \end{code}
77
78 %************************************************************************
79 %*                                                                      *
80 \subsection{The analyser itself}        
81 %*                                                                      *
82 %************************************************************************
83
84 Note [Ensure demand is strict]
85 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
86 It's important not to analyse e with a lazy demand because
87 a) When we encounter   case s of (a,b) -> 
88         we demand s with U(d1d2)... but if the overall demand is lazy
89         that is wrong, and we'd need to reduce the demand on s,
90         which is inconvenient
91 b) More important, consider
92         f (let x = R in x+x), where f is lazy
93    We still want to mark x as demanded, because it will be when we
94    enter the let.  If we analyse f's arg with a Lazy demand, we'll
95    just mark x as Lazy
96 c) The application rule wouldn't be right either
97    Evaluating (f x) in a L demand does *not* cause
98    evaluation of f in a C(L) demand!
99
100 \begin{code}
101 dmdAnalThunk :: AnalEnv 
102              -> Demand  -- This one takes a *Demand*
103              -> CoreExpr -> (DmdType, CoreExpr)
104 dmdAnalThunk env dmd e
105   | exprIsTrivial e = dmdAnalStar env dmd e
106   | otherwise       = dmdAnalStar env (oneifyDmd dmd) e
107
108 -- Do not process absent demands
109 -- Otherwise act like in a normal demand analysis
110 -- See |-* relation in the companion paper
111 dmdAnalStar :: AnalEnv 
112             -> Demand   -- This one takes a *Demand*
113             -> CoreExpr -> (DmdType, CoreExpr)
114 dmdAnalStar env dmd e = toCleanDmd (dmdAnal env) dmd e
115
116 -- Main Demand Analsysis machinery
117 dmdAnal :: AnalEnv 
118         -> CleanDemand         -- The main one takes a *CleanDemand*
119         -> CoreExpr -> (DmdType, CoreExpr)
120
121 -- The CleanDemand is always strict and not absent
122 --    See Note [Ensure demand is strict]
123
124 dmdAnal _ _ (Lit lit)     = (topDmdType, Lit lit)
125 dmdAnal _ _ (Type ty)     = (topDmdType, Type ty)       -- Doesn't happen, in fact
126 dmdAnal _ _ (Coercion co) = (topDmdType, Coercion co)
127
128 dmdAnal env dmd (Var var)
129   = (dmdTransform env var dmd, Var var)
130
131 dmdAnal env dmd (Cast e co)
132   = (dmd_ty, Cast e' co)
133   where
134     (dmd_ty, e') = dmdAnal env dmd e
135
136 {-       ----- I don't get this, so commenting out -------
137     to_co        = pSnd (coercionKind co)
138     dmd'
139       | Just tc <- tyConAppTyCon_maybe to_co
140       , isRecursiveTyCon tc = cleanEvalDmd
141       | otherwise           = dmd
142         -- This coerce usually arises from a recursive
143         -- newtype, and we don't want to look inside them
144         -- for exactly the same reason that we don't look
145         -- inside recursive products -- we might not reach
146         -- a fixpoint.  So revert to a vanilla Eval demand
147 -}
148
149 dmdAnal env dmd (Tick t e)
150   = (dmd_ty, Tick t e')
151   where
152     (dmd_ty, e') = dmdAnal env dmd e
153
154 dmdAnal env dmd (App fun (Type ty))
155   = (fun_ty, App fun' (Type ty))
156   where
157     (fun_ty, fun') = dmdAnal env dmd fun
158
159 dmdAnal sigs dmd (App fun (Coercion co))
160   = (fun_ty, App fun' (Coercion co))
161   where
162     (fun_ty, fun') = dmdAnal sigs dmd fun
163
164 -- Lots of the other code is there to make this
165 -- beautiful, compositional, application rule :-)
166 dmdAnal env dmd (App fun arg)   -- Non-type arguments
167   = let                         -- [Type arg handled above]
168         call_dmd          = mkCallDmd dmd
169         (fun_ty, fun')    = dmdAnal env call_dmd fun
170         (arg_dmd, res_ty) = splitDmdTy fun_ty
171         (arg_ty, arg')    = dmdAnalThunk env arg_dmd arg
172     in
173 --    pprTrace "dmdAnal:app" (vcat
174 --         [ text "dmd =" <+> ppr dmd
175 --         , text "expr =" <+> ppr (App fun arg)
176 --         , text "fun dmd_ty =" <+> ppr fun_ty
177 --         , text "arg dmd =" <+> ppr arg_dmd
178 --         , text "arg dmd_ty =" <+> ppr arg_ty
179 --         , text "res dmd_ty =" <+> ppr res_ty
180 --         , text "overall res dmd_ty =" <+> ppr (res_ty `bothDmdType` arg_ty) ])
181     (res_ty `bothDmdType` arg_ty, App fun' arg')
182
183 dmdAnal env dmd (Lam var body)
184   | isTyVar var
185   = let    
186         (body_ty, body') = dmdAnal env dmd body
187     in
188     (body_ty, Lam var body')
189
190   | otherwise
191   = let (body_dmd, defer_me, one_shot) = peelCallDmd dmd        
192           -- body_dmd  - a demand to analyze the body
193           -- one_shot  - one-shotness of the lambda
194           --             hence, cardinality of its free vars
195
196         env'             = extendSigsWithLam env var
197         (body_ty, body') = dmdAnal env' body_dmd body
198         (lam_ty, var')   = annotateLamIdBndr env body_ty one_shot var
199     in
200     (deferAndUse defer_me one_shot lam_ty, Lam var' body')
201
202 dmdAnal env dmd (Case scrut case_bndr ty [alt@(DataAlt dc, _, _)])
203   -- Only one alternative with a product constructor
204   | let tycon = dataConTyCon dc
205   , isProductTyCon tycon 
206   , Just rec_tc' <- checkRecTc (ae_rec_tc env) tycon
207   = let
208         env_w_tc              = env { ae_rec_tc = rec_tc' }
209         env_alt               = extendAnalEnv NotTopLevel env_w_tc case_bndr case_bndr_sig
210         (alt_ty, alt')        = dmdAnalAlt env_alt dmd alt
211         (alt_ty1, case_bndr') = annotateBndr env alt_ty case_bndr
212         (_, bndrs', _)        = alt'
213         case_bndr_sig         = cprProdSig
214                 -- Inside the alternative, the case binder has the CPR property.
215                 -- Meaning that a case on it will successfully cancel.
216                 -- Example:
217                 --      f True  x = case x of y { I# x' -> if x' ==# 3 then y else I# 8 }
218                 --      f False x = I# 3
219                 --      
220                 -- We want f to have the CPR property:
221                 --      f b x = case fw b x of { r -> I# r }
222                 --      fw True  x = case x of y { I# x' -> if x' ==# 3 then x' else 8 }
223                 --      fw False x = 3
224
225         -- Figure out whether the demand on the case binder is used, and use
226         -- that to set the scrut_dmd.  This is utterly essential.
227         -- Consider     f x = case x of y { (a,b) -> k y a }
228         -- If we just take scrut_demand = U(L,A), then we won't pass x to the
229         -- worker, so the worker will rebuild 
230         --      x = (a, absent-error)
231         -- and that'll crash.
232         -- So at one stage I had:
233         --      dead_case_bndr           = isAbsDmd (idDemandInfo case_bndr')
234         --      keepity | dead_case_bndr = Drop
235         --              | otherwise      = Keep         
236         --
237         -- But then consider
238         --      case x of y { (a,b) -> h y + a }
239         -- where h : U(LL) -> T
240         -- The above code would compute a Keep for x, since y is not Abs, which is silly
241         -- The insight is, of course, that a demand on y is a demand on the
242         -- scrutinee, so we need to `both` it with the scrut demand
243         
244         scrut_dmd1 = mkProdDmd [idDemandInfo b | b <- bndrs', isId b]
245         scrut_dmd2 = strictenDmd (idDemandInfo case_bndr')
246         scrut_dmd  = scrut_dmd1 `bothCleanDmd` scrut_dmd2
247
248         (scrut_ty, scrut') = dmdAnal env scrut_dmd scrut
249         res_ty             = alt_ty1 `bothDmdType` scrut_ty
250     in
251 --    pprTrace "dmdAnal:Case1" (vcat [ text "scrut" <+> ppr scrut
252 --                                   , text "dmd" <+> ppr dmd
253 --                                   , text "alt_dmd" <+> ppr alt_dmd
254 --                                   , text "case_bndr_dmd" <+> ppr (idDemandInfo case_bndr')
255 --                                   , text "scrut_dmd" <+> ppr scrut_dmd
256 --                                   , text "scrut_ty" <+> ppr scrut_ty
257 --                                   , text "alt_ty" <+> ppr alt_ty1
258 --                                   , text "res_ty" <+> ppr res_ty ]) $
259     (res_ty, Case scrut' case_bndr' ty [alt'])
260
261 dmdAnal env dmd (Case scrut case_bndr ty alts)
262   = let      -- Case expression with multiple alternatives
263         (alt_tys, alts')     = mapAndUnzip (dmdAnalAlt env dmd) alts
264         (scrut_ty, scrut')   = dmdAnal env cleanEvalDmd scrut
265         (alt_ty, case_bndr') = annotateBndr env(foldr lubDmdType botDmdType alt_tys) case_bndr
266         res_ty               = alt_ty `bothDmdType` scrut_ty
267     in
268 --    pprTrace "dmdAnal:Case2" (vcat [ text "scrut" <+> ppr scrut
269 --                                   , text "scrut_ty" <+> ppr scrut_ty
270 --                                   , text "alt_ty" <+> ppr alt_ty
271 --                                   , text "res_ty" <+> ppr res_ty ]) $
272     (res_ty, Case scrut' case_bndr' ty alts')
273
274 dmdAnal env dmd (Let (NonRec id rhs) body)
275   = (body_ty2, Let (NonRec id2 annotated_rhs) body')                    
276   where
277     (sig, lazy_fv, id1, rhs') = dmdAnalRhs NotTopLevel Nothing env id rhs
278     (body_ty, body')          = dmdAnal (extendAnalEnv NotTopLevel env id sig) dmd body
279     (body_ty1, id2)           = annotateBndr env body_ty id1
280     body_ty2                  = addLazyFVs body_ty1 lazy_fv
281
282     -- Annotate top-level lambdas at RHS basing on the aggregated demand info
283     -- See Note [Annotating lambdas at right-hand side] 
284     annotated_rhs = annLamWithShotness (idDemandInfo id2) rhs'   
285
286         -- If the actual demand is better than the vanilla call
287         -- demand, you might think that we might do better to re-analyse 
288         -- the RHS with the stronger demand.
289         -- But (a) That seldom happens, because it means that *every* path in 
290         --         the body of the let has to use that stronger demand
291         -- (b) It often happens temporarily in when fixpointing, because
292         --     the recursive function at first seems to place a massive demand.
293         --     But we don't want to go to extra work when the function will
294         --     probably iterate to something less demanding.  
295         -- In practice, all the times the actual demand on id2 is more than
296         -- the vanilla call demand seem to be due to (b).  So we don't
297         -- bother to re-analyse the RHS.
298
299 dmdAnal env dmd (Let (Rec pairs) body)
300   = let
301         (env', lazy_fv, pairs') = dmdFix NotTopLevel env pairs
302         (body_ty, body')        = dmdAnal env' dmd body
303         body_ty1                = deleteFVs body_ty (map fst pairs)
304         body_ty2                = addLazyFVs body_ty1 lazy_fv 
305     in
306     body_ty2 `seq`
307     (body_ty2,  Let (Rec pairs') body')
308
309 annLamWithShotness :: Demand -> CoreExpr -> CoreExpr
310 annLamWithShotness d e
311   | Just u <- cleanUseDmd_maybe d
312   = go u e
313   | otherwise = e
314   where
315     go u e
316       | Just (c, u') <- peelUseCall u
317       , Lam bndr body <- e
318       = if isTyVar bndr 
319         then Lam bndr                    (go u  body)
320         else Lam (setOneShotness c bndr) (go u' body)
321       | otherwise
322       = e
323
324 setOneShotness :: Count -> Id -> Id
325 setOneShotness One  bndr = setOneShotLambda bndr
326 setOneShotness Many bndr = bndr
327
328 dmdAnalAlt :: AnalEnv -> CleanDemand -> Alt Var -> (DmdType, Alt Var)
329 dmdAnalAlt env dmd (con,bndrs,rhs)
330   = let 
331         (rhs_ty, rhs')   = dmdAnal env dmd rhs
332         rhs_ty'          = addDataConPatDmds con bndrs rhs_ty
333         (alt_ty, bndrs') = annotateBndrs env rhs_ty' bndrs
334         final_alt_ty | io_hack_reqd = alt_ty `lubDmdType` topDmdType
335                      | otherwise    = alt_ty
336
337         -- There's a hack here for I/O operations.  Consider
338         --      case foo x s of { (# s, r #) -> y }
339         -- Is this strict in 'y'.  Normally yes, but what if 'foo' is an I/O
340         -- operation that simply terminates the program (not in an erroneous way)?
341         -- In that case we should not evaluate y before the call to 'foo'.
342         -- Hackish solution: spot the IO-like situation and add a virtual branch,
343         -- as if we had
344         --      case foo x s of 
345         --         (# s, r #) -> y 
346         --         other      -> return ()
347         -- So the 'y' isn't necessarily going to be evaluated
348         --
349         -- A more complete example (Trac #148, #1592) where this shows up is:
350         --      do { let len = <expensive> ;
351         --         ; when (...) (exitWith ExitSuccess)
352         --         ; print len }
353
354         io_hack_reqd = con == DataAlt unboxedPairDataCon &&
355                        idType (head bndrs) `eqType` realWorldStatePrimTy
356     in  
357     (final_alt_ty, (con, bndrs', rhs'))
358 \end{code}
359
360 Note [Aggregated demand for cardinality]
361 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
362 We use different strategies for strictness and usage/cardinality to
363 "unleash" demands captured on free variables by bindings. Let us
364 consider the example:
365
366 f1 y = let {-# NOINLINE h #-}
367            h = y
368        in  (h, h)
369
370 We are interested in obtaining cardinality demand U1 on |y|, as it is
371 used only in a thunk, and, therefore, is not going to be updated any
372 more. Therefore, the demand on |y|, captured and unleashed by usage of
373 |h| is U1. However, if we unleash this demand every time |h| is used,
374 and then sum up the effects, the ultimate demand on |y| will be U1 +
375 U1 = U. In order to avoid it, we *first* collect the aggregate demand
376 on |h| in the body of let-expression, and only then apply the demand
377 transformer:
378
379 transf[x](U) = {y |-> U1}
380
381 so the resulting demand on |y| is U1. 
382
383 The situation is, however, different for strictness, where this
384 aggregating approach exhibits worse results because of the nature of
385 |both| operation for strictness. Consider the example:
386
387 f y c = 
388   let h x = y |seq| x
389    in case of 
390         True  -> h True
391         False -> y
392
393 It is clear that |f| is strict in |y|, however, the suggested analysis
394 will infer from the body of |let| that |h| is used lazily (as it is
395 used in one branch only), therefore lazy demand will be put on its
396 free variable |y|. Conversely, if the demand on |h| is unleashed right
397 on the spot, we will get the desired result, namely, that |f| is
398 strict in |y|.
399
400 Note [Annotating lambdas at right-hand side]
401 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
402 Let us take a look at the following example:
403
404 g f = let x = 100
405           h = \y -> f x y
406        in h 5
407
408 One can see that |h| is called just once, therefore the RHS of h can
409 be annotated as a one-shot lambda. This is done by the function
410 annLamWithShotness *a posteriori*, i.e., basing on the aggregated
411 usage demand on |h| from the body of |let|-expression, which is C1(U)
412 in this case.
413
414 In other words, for locally-bound lambdas we can infer
415 one-shotness. 
416
417 \begin{code}
418 addDataConPatDmds :: AltCon -> [Var] -> DmdType -> DmdType
419 -- See Note [Add demands for strict constructors]
420 addDataConPatDmds DEFAULT    _ dmd_ty = dmd_ty
421 addDataConPatDmds (LitAlt _) _ dmd_ty = dmd_ty
422 addDataConPatDmds (DataAlt con) bndrs dmd_ty
423   = foldr add dmd_ty str_bndrs 
424   where
425     add bndr dmd_ty = addVarDmd dmd_ty bndr seqDmd
426     str_bndrs = [ b | (b,s) <- zipEqual "addDataConPatBndrs"
427                                    (filter isId bndrs)
428                                    (dataConRepStrictness con)
429                     , isMarkedStrict s ]
430 \end{code}
431
432 Note [Add demands for strict constructors]
433 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
434 Consider this program (due to Roman):
435
436     data X a = X !a
437
438     foo :: X Int -> Int -> Int
439     foo (X a) n = go 0
440      where
441        go i | i < n     = a + go (i+1)
442             | otherwise = 0
443
444 We want the worker for 'foo' too look like this:
445
446     $wfoo :: Int# -> Int# -> Int#
447
448 with the first argument unboxed, so that it is not eval'd each time
449 around the loop (which would otherwise happen, since 'foo' is not
450 strict in 'a'.  It is sound for the wrapper to pass an unboxed arg
451 because X is strict, so its argument must be evaluated.  And if we
452 *don't* pass an unboxed argument, we can't even repair it by adding a
453 `seq` thus:
454
455     foo (X a) n = a `seq` go 0
456
457 because the seq is discarded (very early) since X is strict!
458
459 There is the usual danger of reboxing, which as usual we ignore. But 
460 if X is monomorphic, and has an UNPACK pragma, then this optimisation
461 is even more important.  We don't want the wrapper to rebox an unboxed
462 argument, and pass an Int to $wfoo!
463
464 %************************************************************************
465 %*                                                                      *
466                     Demand transformer
467 %*                                                                      *
468 %************************************************************************
469
470 \begin{code}
471 dmdTransform :: AnalEnv         -- The strictness environment
472              -> Id              -- The function
473              -> CleanDemand     -- The demand on the function
474              -> DmdType         -- The demand type of the function in this context
475         -- Returned DmdEnv includes the demand on 
476         -- this function plus demand on its free variables
477
478 dmdTransform env var dmd
479   | isDataConWorkId var                          -- Data constructor
480   = dmdTransformDataConSig 
481        (idArity var) (idStrictness var) dmd
482
483   | isGlobalId var                               -- Imported function
484   = let res = dmdTransformSig (idStrictness var) dmd in
485     -- pprTrace "dmdTransform" (vcat [ppr var, ppr dmd, ppr res]) 
486     res
487
488   | Just (sig, top_lvl) <- lookupSigEnv env var  -- Local letrec bound thing
489   , let fn_ty = dmdTransformSig sig dmd
490   = -- pprTrace "dmdTransform" (vcat [ppr var, ppr dmd, ppr fn_ty]) $
491     if isTopLevel top_lvl           
492     then fn_ty   -- Don't record top level things
493     else addVarDmd fn_ty var (mkOnceUsedDmd dmd)
494
495   | otherwise                                    -- Local non-letrec-bound thing
496   = unitVarDmd var (mkOnceUsedDmd dmd)
497 \end{code}
498
499 %************************************************************************
500 %*                                                                      *
501 \subsection{Bindings}
502 %*                                                                      *
503 %************************************************************************
504
505 \begin{code}
506
507 -- Recursive bindings
508 dmdFix :: TopLevelFlag
509        -> AnalEnv               -- Does not include bindings for this binding
510        -> [(Id,CoreExpr)]
511        -> (AnalEnv, DmdEnv,
512            [(Id,CoreExpr)])     -- Binders annotated with stricness info
513
514 dmdFix top_lvl env orig_pairs
515   = (updSigEnv env (sigEnv final_env), lazy_fv, pairs')
516      -- Return to original virgin state, keeping new signatures
517   where
518     bndrs        = map fst orig_pairs
519     initial_env = addInitialSigs top_lvl env bndrs
520     (final_env, lazy_fv, pairs') = loop 1 initial_env orig_pairs
521     
522     loop :: Int
523          -> AnalEnv                     -- Already contains the current sigs
524          -> [(Id,CoreExpr)]             
525          -> (AnalEnv, DmdEnv, [(Id,CoreExpr)])
526     loop n env pairs
527       = -- pprTrace "dmd loop" (ppr n <+> ppr bndrs $$ ppr env) $
528         loop' n env pairs
529
530     loop' n env pairs
531       | found_fixpoint
532       = (env', lazy_fv, pairs')
533                 -- Note: return pairs', not pairs.   pairs' is the result of 
534                 -- processing the RHSs with sigs (= sigs'), whereas pairs 
535                 -- is the result of processing the RHSs with the *previous* 
536                 -- iteration of sigs.
537
538       | n >= 10  
539       = pprTrace "dmdFix loop" (ppr n <+> (vcat 
540                         [ text "Sigs:" <+> ppr [ (id,lookupVarEnv (sigEnv env) id, 
541                                                      lookupVarEnv (sigEnv env') id) 
542                                                | (id,_) <- pairs],
543                           text "env:" <+> ppr env,
544                           text "binds:" <+> pprCoreBinding (Rec pairs)]))
545         (env, lazy_fv, orig_pairs)      -- Safe output
546                 -- The lazy_fv part is really important!  orig_pairs has no strictness
547                 -- info, including nothing about free vars.  But if we have
548                 --      letrec f = ....y..... in ...f...
549                 -- where 'y' is free in f, we must record that y is mentioned, 
550                 -- otherwise y will get recorded as absent altogether
551
552       | otherwise
553       = loop (n+1) (nonVirgin env') pairs'
554       where
555         found_fixpoint = all (same_sig (sigEnv env) (sigEnv env')) bndrs 
556
557         ((env',lazy_fv), pairs') = mapAccumL my_downRhs (env, emptyDmdEnv) pairs
558                 -- mapAccumL: Use the new signature to do the next pair
559                 -- The occurrence analyser has arranged them in a good order
560                 -- so this can significantly reduce the number of iterations needed
561         
562         my_downRhs (env, lazy_fv) (id,rhs)
563           = ((env', lazy_fv'), (id', rhs'))
564           where
565             (sig, lazy_fv1, id', rhs') = dmdAnalRhs top_lvl (Just bndrs) env id rhs
566             lazy_fv'                   = plusVarEnv_C bothDmd lazy_fv lazy_fv1
567             env'                       = extendAnalEnv top_lvl env id sig
568            
569     same_sig sigs sigs' var = lookup sigs var == lookup sigs' var
570     lookup sigs var = case lookupVarEnv sigs var of
571                         Just (sig,_) -> sig
572                         Nothing      -> pprPanic "dmdFix" (ppr var)
573
574 -- Non-recursive bindings
575 dmdAnalRhs :: TopLevelFlag 
576            -> Maybe [Id]   -- Just bs <=> recursive, Nothing <=> non-recursive
577            -> AnalEnv -> Id -> CoreExpr
578            -> (StrictSig,  DmdEnv, Id, CoreExpr)
579 -- Process the RHS of the binding, add the strictness signature
580 -- to the Id, and augment the environment with the signature as well.
581 dmdAnalRhs top_lvl rec_flag env id rhs
582   | Just fn <- unpackTrivial rhs   -- See Note [Trivial right-hand sides]
583   , let fn_str = getStrictness env fn
584   = (fn_str, emptyDmdEnv, set_idStrictness env id fn_str, rhs)
585
586   | otherwise
587   = (sig_ty, lazy_fv, id', mkLams bndrs' body')
588   where
589     (bndrs, body)        = collectBinders rhs
590     env_body             = foldl extendSigsWithLam env bndrs
591     (body_dmd_ty, body') = dmdAnal env_body body_dmd body
592     (rhs_dmd_ty, bndrs') = annotateLamBndrs env body_dmd_ty bndrs
593     id'                  = set_idStrictness env id sig_ty
594     sig_ty               = mkStrictSig (mkDmdType sig_fv rhs_dmds rhs_res')
595         -- See Note [NOINLINE and strictness]
596
597     -- See Note [Product demands for function body]
598     body_dmd = case deepSplitProductType_maybe (exprType body) of
599                  Nothing            -> cleanEvalDmd
600                  Just (dc, _, _, _) -> cleanEvalProdDmd (dataConRepArity dc)
601
602     DmdType rhs_fv rhs_dmds rhs_res = rhs_dmd_ty
603
604     -- See Note [Lazy and unleashable free variables]
605     -- See Note [Aggregated demand for cardinality]
606     rhs_fv1 = case rec_flag of
607                 Just bs -> useEnv (delVarEnvList rhs_fv bs)
608                 Nothing -> rhs_fv
609
610     (lazy_fv, sig_fv) = splitFVs is_thunk rhs_fv1
611
612     rhs_res' | returnsCPR rhs_res
613              , discard_cpr_info   = topRes
614              | otherwise          = rhs_res
615
616     discard_cpr_info = nested_sum || (is_thunk && not_strict)
617     nested_sum     -- See Note [CPR for sum types ]
618         = not (isTopLevel top_lvl || returnsCPRProd rhs_res) 
619
620     -- See Note [CPR for thunks]
621     is_thunk = not (exprIsHNF rhs)
622     not_strict 
623        =  isTopLevel top_lvl  -- Top level and recursive things don't 
624        || isJust rec_flag     -- get their demandInfo set at all
625        || not (isStrictDmd (idDemandInfo id) || ae_virgin env)
626           -- See Note [Optimistic CPR in the "virgin" case]
627
628 unpackTrivial :: CoreExpr -> Maybe Id
629 -- Returns (Just v) if the arg is really equal to v, modulo
630 -- casts, type applications etc 
631 -- See Note [Trivial right-hand sides]
632 unpackTrivial (Var v)                 = Just v
633 unpackTrivial (Cast e _)              = unpackTrivial e
634 unpackTrivial (Lam v e) | isTyVar v   = unpackTrivial e
635 unpackTrivial (App e a) | isTypeArg a = unpackTrivial e
636 unpackTrivial _                       = Nothing
637 \end{code}
638
639 Note [Trivial right-hand sides]
640 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
641 Consider
642         foo = plusInt |> co
643 where plusInt is an arity-2 function with known strictness.  Clearly
644 we want plusInt's strictness to propagate to foo!  But because it has
645 no manifest lambdas, it won't do so automatically.  So we have a 
646 special case for right-hand sides that are "trivial", namely variables,
647 casts, type applications, and the like. 
648
649 Note [Product demands for function body]
650 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
651 This example comes from shootout/binary_trees:
652
653     Main.check' = \ b z ds. case z of z' { I# ip ->
654                                 case ds_d13s of
655                                   Main.Nil -> z'
656                                   Main.Node s14k s14l s14m ->
657                                     Main.check' (not b)
658                                       (Main.check' b
659                                          (case b {
660                                             False -> I# (-# s14h s14k);
661                                             True  -> I# (+# s14h s14k)
662                                           })
663                                          s14l)
664                                      s14m   }   }   }
665
666 Here we *really* want to unbox z, even though it appears to be used boxed in
667 the Nil case.  Partly the Nil case is not a hot path.  But more specifically,
668 the whole function gets the CPR property if we do. 
669
670 So for the demand on the body of a RHS we use a product demand if it's
671 a product type.
672
673 %************************************************************************
674 %*                                                                      *
675 \subsection{Strictness signatures and types}
676 %*                                                                      *
677 %************************************************************************
678
679 \begin{code}
680 unitVarDmd :: Var -> Demand -> DmdType
681 unitVarDmd var dmd 
682   = DmdType (unitVarEnv var dmd) [] topRes
683
684 addVarDmd :: DmdType -> Var -> Demand -> DmdType
685 addVarDmd (DmdType fv ds res) var dmd
686   = DmdType (extendVarEnv_C bothDmd fv var dmd) ds res
687
688 addLazyFVs :: DmdType -> DmdEnv -> DmdType
689 addLazyFVs dmd_ty lazy_fvs
690   = dmd_ty `bothDmdType` mkDmdType lazy_fvs [] topRes
691         -- Using bothDmdType (rather than just both'ing the envs)
692         -- is vital.  Consider
693         --      let f = \x -> (x,y)
694         --      in  error (f 3)
695         -- Here, y is treated as a lazy-fv of f, but we must `bothDmd` that L
696         -- demand with the bottom coming up from 'error'
697         -- 
698         -- I got a loop in the fixpointer without this, due to an interaction
699         -- with the lazy_fv filtering in dmdAnalRhs.  Roughly, it was
700         --      letrec f n x 
701         --          = letrec g y = x `fatbar` 
702         --                         letrec h z = z + ...g...
703         --                         in h (f (n-1) x)
704         --      in ...
705         -- In the initial iteration for f, f=Bot
706         -- Suppose h is found to be strict in z, but the occurrence of g in its RHS
707         -- is lazy.  Now consider the fixpoint iteration for g, esp the demands it
708         -- places on its free variables.  Suppose it places none.  Then the
709         --      x `fatbar` ...call to h...
710         -- will give a x->V demand for x.  That turns into a L demand for x,
711         -- which floats out of the defn for h.  Without the modifyEnv, that
712         -- L demand doesn't get both'd with the Bot coming up from the inner
713         -- call to f.  So we just get an L demand for x for g.
714
715 peelFV :: DmdEnv -> Var -> DmdResult -> (DmdEnv, Demand)
716 peelFV fv id res = -- pprTrace "rfv" (ppr id <+> ppr dmd $$ ppr fv)
717                      (fv', dmd)
718                 where
719                   fv' = fv `delVarEnv` id
720                   dmd = lookupVarEnv fv id `orElse` deflt
721                   -- See note [Default demand for variables]
722                   deflt | isBotRes res = botDmd
723                         | otherwise    = absDmd
724 \end{code}
725
726 Note [Default demand for variables]
727 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
728
729 If the variable is not mentioned in the environment of a demand type,
730 its demand is taken to be a result demand of the type: either L or the
731 bottom. Both are safe from the semantical pont of view, however, for
732 the safe result we also have absent demand set to Abs, which makes it
733 possible to safely ignore non-mentioned variables (their joint demand
734 is <L,A>).
735
736 \begin{code}
737 annotateBndr :: AnalEnv -> DmdType -> Var -> (DmdType, Var)
738 -- The returned env has the var deleted
739 -- The returned var is annotated with demand info
740 -- according to the result demand of the provided demand type
741 -- No effect on the argument demands
742 annotateBndr env dmd_ty@(DmdType fv ds res) var
743   | isTyVar var = (dmd_ty, var)
744   | otherwise   = (DmdType fv' ds res, set_idDemandInfo env var dmd)
745   where
746     (fv', dmd) = peelFV fv var res
747
748 annotateBndrs :: AnalEnv -> DmdType -> [Var] -> (DmdType, [Var])
749 annotateBndrs env = mapAccumR (annotateBndr env)
750
751 annotateLamBndrs :: AnalEnv -> DmdType -> [Var] -> (DmdType, [Var])
752 annotateLamBndrs env ty bndrs = mapAccumR annotate ty bndrs
753   where
754     annotate dmd_ty bndr
755       | isId bndr = annotateLamIdBndr env dmd_ty Many bndr
756       | otherwise = (dmd_ty, bndr)
757
758 annotateLamIdBndr :: AnalEnv
759                   -> DmdType    -- Demand type of body
760                   -> Count      -- One-shot-ness of the lambda
761                   -> Id         -- Lambda binder
762                   -> (DmdType,  -- Demand type of lambda
763                       Id)       -- and binder annotated with demand     
764
765 annotateLamIdBndr env (DmdType fv ds res) one_shot id
766 -- For lambdas we add the demand to the argument demands
767 -- Only called for Ids
768   = ASSERT( isId id )
769     -- pprTrace "annLamBndr" (vcat [ppr id, ppr dmd_ty]) $
770     (final_ty, setOneShotness one_shot (set_idDemandInfo env id dmd))
771   where
772       -- Watch out!  See note [Lambda-bound unfoldings]
773     final_ty = case maybeUnfoldingTemplate (idUnfolding id) of
774                  Nothing  -> main_ty
775                  Just unf -> main_ty `bothDmdType` unf_ty
776                           where
777                              (unf_ty, _) = dmdAnalStar env dmd unf
778     
779     main_ty = DmdType fv' (dmd:ds) res
780
781     (fv', dmd) = peelFV fv id res
782
783 deleteFVs :: DmdType -> [Var] -> DmdType
784 deleteFVs (DmdType fvs dmds res) bndrs
785   = DmdType (delVarEnvList fvs bndrs) dmds res
786 \end{code}
787
788 Note [CPR for sum types]
789 ~~~~~~~~~~~~~~~~~~~~~~~~
790 At the moment we do not do CPR for let-bindings that
791    * non-top level
792    * bind a sum type
793 Reason: I found that in some benchmarks we were losing let-no-escapes,
794 which messed it all up.  Example
795    let j = \x. ....
796    in case y of
797         True  -> j False
798         False -> j True
799 If we w/w this we get
800    let j' = \x. ....
801    in case y of
802         True -> case j False of { (# a #) -> Just a }
803         True -> case j True of { (# a #) -> Just a }
804 Notice that j' is not a let-no-escape any more.
805
806 However this means in turn that the *enclosing* function
807 may be CPR'd (via the returned Justs).  But in the case of
808 sums, there may be Nothing alterantives; and that messes
809 up the sum-type CPR.
810
811 Conclusion: only do this for products.  It's still not
812 guaranteed OK for products, but sums definitely lose sometimes.
813
814 Note [CPR for thunks]
815 ~~~~~~~~~~~~~~~~~~~~~
816 If the rhs is a thunk, we usually forget the CPR info, because
817 it is presumably shared (else it would have been inlined, and 
818 so we'd lose sharing if w/w'd it into a function).  E.g.
819
820         let r = case expensive of
821                   (a,b) -> (b,a)
822         in ...
823
824 If we marked r as having the CPR property, then we'd w/w into
825
826         let $wr = \() -> case expensive of
827                             (a,b) -> (# b, a #)
828             r = case $wr () of
829                   (# b,a #) -> (b,a)
830         in ...
831
832 But now r is a thunk, which won't be inlined, so we are no further ahead.
833 But consider
834
835         f x = let r = case expensive of (a,b) -> (b,a)
836               in if foo r then r else (x,x)
837
838 Does f have the CPR property?  Well, no.
839
840 However, if the strictness analyser has figured out (in a previous 
841 iteration) that it's strict, then we DON'T need to forget the CPR info.
842 Instead we can retain the CPR info and do the thunk-splitting transform 
843 (see WorkWrap.splitThunk).
844
845 This made a big difference to PrelBase.modInt, which had something like
846         modInt = \ x -> let r = ... -> I# v in
847                         ...body strict in r...
848 r's RHS isn't a value yet; but modInt returns r in various branches, so
849 if r doesn't have the CPR property then neither does modInt
850 Another case I found in practice (in Complex.magnitude), looks like this:
851                 let k = if ... then I# a else I# b
852                 in ... body strict in k ....
853 (For this example, it doesn't matter whether k is returned as part of
854 the overall result; but it does matter that k's RHS has the CPR property.)  
855 Left to itself, the simplifier will make a join point thus:
856                 let $j k = ...body strict in k...
857                 if ... then $j (I# a) else $j (I# b)
858 With thunk-splitting, we get instead
859                 let $j x = let k = I#x in ...body strict in k...
860                 in if ... then $j a else $j b
861 This is much better; there's a good chance the I# won't get allocated.
862
863 The difficulty with this is that we need the strictness type to
864 look at the body... but we now need the body to calculate the demand
865 on the variable, so we can decide whether its strictness type should
866 have a CPR in it or not.  Simple solution: 
867         a) use strictness info from the previous iteration
868         b) make sure we do at least 2 iterations, by doing a second
869            round for top-level non-recs.  Top level recs will get at
870            least 2 iterations except for totally-bottom functions
871            which aren't very interesting anyway.
872
873 NB: strictly_demanded is never true of a top-level Id, or of a recursive Id.
874
875 Note [Optimistic CPR in the "virgin" case]
876 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
877 Demand and strictness info are initialized by top elements. However,
878 this prevents from inferring a CPR property in the first pass of the
879 analyser, so we keep an explicit flag ae_virgin in the AnalEnv
880 datatype.
881
882 We can't start with 'not-demanded' (i.e., top) because then consider
883         f x = let 
884                   t = ... I# x
885               in
886               if ... then t else I# y else f x'
887
888 In the first iteration we'd have no demand info for x, so assume
889 not-demanded; then we'd get TopRes for f's CPR info.  Next iteration
890 we'd see that t was demanded, and so give it the CPR property, but by
891 now f has TopRes, so it will stay TopRes.  Instead, by checking the
892 ae_virgin flag at the first time round, we say 'yes t is demanded' the
893 first time.
894
895 However, this does mean that for non-recursive bindings we must
896 iterate twice to be sure of not getting over-optimistic CPR info,
897 in the case where t turns out to be not-demanded.  This is handled
898 by dmdAnalTopBind.
899
900
901 Note [NOINLINE and strictness]
902 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
903 The strictness analyser used to have a HACK which ensured that NOINLNE
904 things were not strictness-analysed.  The reason was unsafePerformIO. 
905 Left to itself, the strictness analyser would discover this strictness 
906 for unsafePerformIO:
907         unsafePerformIO:  C(U(AV))
908 But then consider this sub-expression
909         unsafePerformIO (\s -> let r = f x in 
910                                case writeIORef v r s of (# s1, _ #) ->
911                                (# s1, r #)
912 The strictness analyser will now find that r is sure to be eval'd,
913 and may then hoist it out.  This makes tests/lib/should_run/memo002
914 deadlock.
915
916 Solving this by making all NOINLINE things have no strictness info is overkill.
917 In particular, it's overkill for runST, which is perfectly respectable.
918 Consider
919         f x = runST (return x)
920 This should be strict in x.
921
922 So the new plan is to define unsafePerformIO using the 'lazy' combinator:
923
924         unsafePerformIO (IO m) = lazy (case m realWorld# of (# _, r #) -> r)
925
926 Remember, 'lazy' is a wired-in identity-function Id, of type a->a, which is 
927 magically NON-STRICT, and is inlined after strictness analysis.  So
928 unsafePerformIO will look non-strict, and that's what we want.
929
930 Now we don't need the hack in the strictness analyser.  HOWEVER, this
931 decision does mean that even a NOINLINE function is not entirely
932 opaque: some aspect of its implementation leaks out, notably its
933 strictness.  For example, if you have a function implemented by an
934 error stub, but which has RULES, you may want it not to be eliminated
935 in favour of error!
936
937 Note [Lazy and unleasheable free variables]
938 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
939 We put the strict and once-used FVs in the DmdType of the Id, so 
940 that at its call sites we unleash demands on its strict fvs.
941 An example is 'roll' in imaginary/wheel-sieve2
942 Something like this:
943         roll x = letrec 
944                      go y = if ... then roll (x-1) else x+1
945                  in 
946                  go ms
947 We want to see that roll is strict in x, which is because
948 go is called.   So we put the DmdEnv for x in go's DmdType.
949
950 Another example:
951
952         f :: Int -> Int -> Int
953         f x y = let t = x+1
954             h z = if z==0 then t else 
955                   if z==1 then x+1 else
956                   x + h (z-1)
957         in h y
958
959 Calling h does indeed evaluate x, but we can only see
960 that if we unleash a demand on x at the call site for t.
961
962 Incidentally, here's a place where lambda-lifting h would
963 lose the cigar --- we couldn't see the joint strictness in t/x
964
965         ON THE OTHER HAND
966 We don't want to put *all* the fv's from the RHS into the
967 DmdType, because that makes fixpointing very slow --- the 
968 DmdType gets full of lazy demands that are slow to converge.
969
970
971 Note [Lamba-bound unfoldings]
972 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
973 We allow a lambda-bound variable to carry an unfolding, a facility that is used
974 exclusively for join points; see Note [Case binders and join points].  If so,
975 we must be careful to demand-analyse the RHS of the unfolding!  Example
976    \x. \y{=Just x}. <body>
977 Then if <body> uses 'y', then transitively it uses 'x', and we must not
978 forget that fact, otherwise we might make 'x' absent when it isn't.
979
980
981 %************************************************************************
982 %*                                                                      *
983 \subsection{Strictness signatures}
984 %*                                                                      *
985 %************************************************************************
986
987 \begin{code}
988 data AnalEnv
989   = AE { ae_dflags :: DynFlags
990        , ae_sigs   :: SigEnv
991        , ae_virgin :: Bool    -- True on first iteration only
992                               -- See Note [Initialising strictness]
993        , ae_rec_tc :: RecTcChecker
994  } 
995
996         -- We use the se_env to tell us whether to
997         -- record info about a variable in the DmdEnv
998         -- We do so if it's a LocalId, but not top-level
999         --
1000         -- The DmdEnv gives the demand on the free vars of the function
1001         -- when it is given enough args to satisfy the strictness signature
1002
1003 type SigEnv = VarEnv (StrictSig, TopLevelFlag)
1004
1005 instance Outputable AnalEnv where
1006   ppr (AE { ae_sigs = env, ae_virgin = virgin })
1007     = ptext (sLit "AE") <+> braces (vcat
1008          [ ptext (sLit "ae_virgin =") <+> ppr virgin
1009          , ptext (sLit "ae_sigs =") <+> ppr env ])
1010
1011 emptyAnalEnv :: DynFlags -> AnalEnv
1012 emptyAnalEnv dflags = AE { ae_dflags = dflags, ae_sigs = emptySigEnv
1013                          , ae_virgin = True, ae_rec_tc = initRecTc }
1014
1015 emptySigEnv :: SigEnv
1016 emptySigEnv = emptyVarEnv
1017
1018 sigEnv :: AnalEnv -> SigEnv
1019 sigEnv = ae_sigs
1020
1021 updSigEnv :: AnalEnv -> SigEnv -> AnalEnv
1022 updSigEnv env sigs = env { ae_sigs = sigs }
1023
1024 extendAnalEnv :: TopLevelFlag -> AnalEnv -> Id -> StrictSig -> AnalEnv
1025 extendAnalEnv top_lvl env var sig
1026   = env { ae_sigs = extendSigEnv top_lvl (ae_sigs env) var sig }
1027
1028 extendSigEnv :: TopLevelFlag -> SigEnv -> Id -> StrictSig -> SigEnv
1029 extendSigEnv top_lvl sigs var sig = extendVarEnv sigs var (sig, top_lvl)
1030
1031 lookupSigEnv :: AnalEnv -> Id -> Maybe (StrictSig, TopLevelFlag)
1032 lookupSigEnv env id = lookupVarEnv (ae_sigs env) id
1033
1034 getStrictness :: AnalEnv -> Id -> StrictSig
1035 getStrictness env fn
1036   | isGlobalId fn                        = idStrictness fn
1037   | Just (sig, _) <- lookupSigEnv env fn = sig
1038   | otherwise                            = topSig
1039
1040 addInitialSigs :: TopLevelFlag -> AnalEnv -> [Id] -> AnalEnv
1041 -- See Note [Initialising strictness]
1042 addInitialSigs top_lvl env@(AE { ae_sigs = sigs, ae_virgin = virgin }) ids
1043   = env { ae_sigs = extendVarEnvList sigs [ (id, (init_sig id, top_lvl))
1044                                           | id <- ids ] }
1045   where
1046     init_sig | virgin    = \_ -> botSig
1047              | otherwise = idStrictness
1048
1049 nonVirgin :: AnalEnv -> AnalEnv
1050 nonVirgin env = env { ae_virgin = False }
1051
1052 extendSigsWithLam :: AnalEnv -> Id -> AnalEnv
1053 -- Extend the AnalEnv when we meet a lambda binder
1054 extendSigsWithLam env id
1055   | isId id
1056   , isStrictDmd (idDemandInfo id) || ae_virgin env  
1057        -- See Note [Optimistic CPR in the "virgin" case]
1058        -- See Note [Initial CPR for strict binders]
1059   , Just {} <- deepSplitProductType_maybe $ idType id
1060   = extendAnalEnv NotTopLevel env id cprProdSig 
1061
1062   | otherwise 
1063   = env
1064
1065 set_idDemandInfo :: AnalEnv -> Id -> Demand -> Id
1066 set_idDemandInfo env id dmd 
1067   = setIdDemandInfo id (zapDemand (ae_dflags env) dmd)
1068
1069 set_idStrictness :: AnalEnv -> Id -> StrictSig -> Id
1070 set_idStrictness env id sig
1071   = setIdStrictness id (zapStrictSig (ae_dflags env) sig)
1072 \end{code}
1073
1074 Note [Initial CPR for strict binders]
1075 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1076 CPR is initialized for a lambda binder in an optimistic manner, i.e,
1077 if the binder is used strictly and at least some of its components as
1078 a product are used, which is checked by the value of the absence
1079 demand.
1080
1081 If the binder is marked demanded with a strict demand, then give it a
1082 CPR signature, because in the likely event that this is a lambda on a
1083 fn defn [we only use this when the lambda is being consumed with a
1084 call demand], it'll be w/w'd and so it will be CPR-ish.  E.g.
1085
1086         f = \x::(Int,Int).  if ...strict in x... then
1087                                 x
1088                             else
1089                                 (a,b)
1090 We want f to have the CPR property because x does, by the time f has been w/w'd
1091
1092 Also note that we only want to do this for something that definitely
1093 has product type, else we may get over-optimistic CPR results
1094 (e.g. from \x -> x!).
1095
1096
1097 Note [Initialising strictness]
1098 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1099 See section 9.2 (Finding fixpoints) of the paper.
1100
1101 Our basic plan is to initialise the strictness of each Id in a
1102 recursive group to "bottom", and find a fixpoint from there.  However,
1103 this group B might be inside an *enclosing* recursiveb group A, in
1104 which case we'll do the entire fixpoint shebang on for each iteration
1105 of A. This can be illustrated by the following example:
1106
1107 Example:
1108
1109   f [] = []
1110   f (x:xs) = let g []     = f xs
1111                  g (y:ys) = y+1 : g ys
1112               in g (h x)
1113
1114 At each iteration of the fixpoint for f, the analyser has to find a
1115 fixpoint for the enclosed function g. In the meantime, the demand
1116 values for g at each iteration for f are *greater* than those we
1117 encountered in the previous iteration for f. Therefore, we can begin
1118 the fixpoint for g not with the bottom value but rather with the
1119 result of the previous analysis. I.e., when beginning the fixpoint
1120 process for g, we can start from the demand signature computed for g
1121 previously and attached to the binding occurrence of g.
1122
1123 To speed things up, we initialise each iteration of A (the enclosing
1124 one) from the result of the last one, which is neatly recorded in each
1125 binder.  That way we make use of earlier iterations of the fixpoint
1126 algorithm. (Cunning plan.)
1127
1128 But on the *first* iteration we want to *ignore* the current strictness
1129 of the Id, and start from "bottom".  Nowadays the Id can have a current
1130 strictness, because interface files record strictness for nested bindings.
1131 To know when we are in the first iteration, we look at the ae_virgin
1132 field of the AnalEnv.