2 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1996
4 \section[SaAbsInt]{Abstract interpreter for strictness analysis}
7 #include "HsVersions.h"
21 import CoreUnfold ( UnfoldingDetails(..), FormSummary )
22 import CoreUtils ( unTagBinders )
23 import Id ( idType, getIdStrictness, getIdUnfolding,
24 dataConSig, dataConArgTys
26 import IdInfo ( StrictnessInfo(..), Demand(..),
27 wwPrim, wwStrict, wwEnum, wwUnpack
29 import MagicUFs ( MagicUnfoldingFun )
30 import Maybes ( maybeToBool )
31 import Outputable ( Outputable(..){-instance * []-} )
32 import PprStyle ( PprStyle(..) )
33 import PrelInfo ( intTyCon, integerTyCon, doubleTyCon,
34 floatTyCon, wordTyCon, addrTyCon
36 import Pretty ( ppStr )
37 import PrimOp ( PrimOp(..) )
39 import TyCon ( maybeTyConSingleCon, isEnumerationTyCon,
42 import Type ( maybeAppDataTyCon, isPrimType )
43 import Util ( isIn, isn'tIn, nOfThem, zipWithEqual,
44 pprTrace, panic, pprPanic, assertPanic
47 returnsRealWorld = panic "SaAbsInt.returnsRealWorld (ToDo)"
50 %************************************************************************
52 \subsection[AbsVal-ops]{Operations on @AbsVals@}
54 %************************************************************************
56 Least upper bound, greatest lower bound.
59 lub, glb :: AbsVal -> AbsVal -> AbsVal
61 lub val1 val2 | isBot val1 = val2 -- The isBot test includes the case where
62 lub val1 val2 | isBot val2 = val1 -- one of the val's is a function which
63 -- always returns bottom, such as \y.x,
64 -- when x is bound to bottom.
66 lub (AbsProd xs) (AbsProd ys) = AbsProd (zipWithEqual lub xs ys)
68 lub _ _ = AbsTop -- Crude, but conservative
69 -- The crudity only shows up if there
70 -- are functions involved
72 -- Slightly funny glb; for absence analysis only;
73 -- AbsBot is the safe answer.
75 -- Using anyBot rather than just testing for AbsBot is important.
80 -- g = \x y z -> case x of
84 -- Now, the abstract value of the branches of the case will be an
85 -- AbsFun, but when testing for z's absence we want to spot that it's
86 -- an AbsFun which can't possibly return AbsBot. So when glb'ing we
87 -- mustn't be too keen to bale out and return AbsBot; the anyBot test
88 -- spots that (f x) can't possibly return AbsBot.
90 -- We have also tripped over the following interesting case:
95 -- Now, suppose f is bound to AbsTop. Does this expression mention z?
96 -- Obviously not. But the case will take the glb of AbsTop (for f) and
97 -- an AbsFun (for \y->1). We should not bale out and give AbsBot, because
98 -- that would say that it *does* mention z (or anything else for that matter).
99 -- Nor can we always return AbsTop, because the AbsFun might be something
100 -- like (\y->z), which obviously does mention z. The point is that we're
101 -- glbing two functions, and AbsTop is not actually the top of the function
102 -- lattice. It is more like (\xyz -> x|y|z); that is, AbsTop returns
103 -- poison iff any of its arguments do.
105 -- Deal with functions specially, because AbsTop isn't the
106 -- top of their domain.
109 | is_fun v1 || is_fun v2
110 = if not (anyBot v1) && not (anyBot v2)
116 is_fun (AbsFun _ _ _) = True
117 is_fun (AbsApproxFun _) = True -- Not used, but the glb works ok
120 -- The non-functional cases are quite straightforward
122 glb (AbsProd xs) (AbsProd ys) = AbsProd (zipWithEqual glb xs ys)
127 glb _ _ = AbsBot -- Be pessimistic
133 -> AbsVal -- Value of scrutinee
134 -> [AbsVal] -- Value of branches (at least one)
137 -- For strictness analysis, see if the scrutinee is bottom; if so
138 -- return bottom; otherwise, the lub of the branches.
140 combineCaseValues StrAnal AbsBot branches = AbsBot
141 combineCaseValues StrAnal other_scrutinee branches
142 -- Scrutinee can only be AbsBot, AbsProd or AbsTop
143 = ASSERT(ok_scrutinee)
147 = case other_scrutinee of {
148 AbsTop -> True; -- i.e., cool
149 AbsProd _ -> True; -- ditto
150 _ -> False -- party over
153 -- For absence analysis, check if the scrutinee is all poison (isBot)
154 -- If so, return poison (AbsBot); otherwise, any nested poison will come
155 -- out from looking at the branches, so just glb together the branches
156 -- to get the worst one.
158 combineCaseValues AbsAnal AbsBot branches = AbsBot
159 combineCaseValues AbsAnal other_scrutinee branches
160 -- Scrutinee can only be AbsBot, AbsProd or AbsTop
161 = ASSERT(ok_scrutinee)
163 result = foldr1 glb branches
165 tracer = if at_least_one_AbsFun && at_least_one_AbsTop
167 pprTrace "combineCase:" (ppr PprDebug branches)
176 = case other_scrutinee of {
177 AbsTop -> True; -- i.e., cool
178 AbsProd _ -> True; -- ditto
179 _ -> False -- party over
182 at_least_one_AbsFun = foldr ((||) . is_AbsFun) False branches
183 at_least_one_AbsTop = foldr ((||) . is_AbsTop) False branches
184 no_AbsBots = foldr ((&&) . is_not_AbsBot) True branches
186 is_AbsFun x = case x of { AbsFun _ _ _ -> True; _ -> False }
187 is_AbsTop x = case x of { AbsTop -> True; _ -> False }
188 is_not_AbsBot x = case x of { AbsBot -> False; _ -> True }
191 @isBot@ returns True if its argument is (a representation of) bottom. The
192 ``representation'' part is because we need to detect the bottom {\em function}
193 too. To detect the bottom function, bind its args to top, and see if it
196 Used only in strictness analysis:
198 isBot :: AbsVal -> Bool
201 isBot (AbsFun args body env) = isBot (absEval StrAnal body env)
202 -- Don't bother to extend the envt because
203 -- unbound variables default to AbsTop anyway
207 Used only in absence analysis:
209 anyBot :: AbsVal -> Bool
211 anyBot AbsBot = True -- poisoned!
212 anyBot AbsTop = False
213 anyBot (AbsProd vals) = any anyBot vals
214 anyBot (AbsFun args body env) = anyBot (absEval AbsAnal body env)
215 anyBot (AbsApproxFun demands) = False
217 -- AbsApproxFun can only arise in absence analysis from the Demand
218 -- info of an imported value; whatever it is we're looking for is
219 -- certainly not present over in the imported value.
222 @widen@ takes an @AbsVal@, $val$, and returns and @AbsVal@ which is
223 approximated by $val$. Furthermore, the result has no @AbsFun@s in
224 it, so it can be compared for equality by @sameVal@.
227 widen :: AnalysisKind -> AbsVal -> AbsVal
229 widen StrAnal (AbsFun args body env)
230 | isBot (absEval StrAnal body env) = AbsBot
232 = ASSERT (not (null args))
233 AbsApproxFun (map (findDemandStrOnly env body) args)
235 -- It's worth checking for a function which is unconditionally
238 -- f x y = let g y = case x of ...
239 -- in (g ..) + (g ..)
241 -- Here, when we are considering strictness of f in x, we'll
242 -- evaluate the body of f with x bound to bottom. The current
243 -- strategy is to bind g to its *widened* value; without the isBot
244 -- (...) test above, we'd bind g to an AbsApproxFun, and deliver
245 -- Top, not Bot as the value of f's rhs. The test spots the
246 -- unconditional bottom-ness of g when x is bottom. (Another
247 -- alternative here would be to bind g to its exact abstract
248 -- value, but that entails lots of potential re-computation, at
249 -- every application of g.)
251 widen StrAnal (AbsProd vals) = AbsProd (map (widen StrAnal) vals)
252 widen StrAnal other_val = other_val
255 widen AbsAnal (AbsFun args body env)
256 | anyBot (absEval AbsAnal body env) = AbsBot
257 -- In the absence-analysis case it's *essential* to check
258 -- that the function has no poison in its body. If it does,
259 -- anywhere, then the whole function is poisonous.
262 = ASSERT (not (null args))
263 AbsApproxFun (map (findDemandAbsOnly env body) args)
265 widen AbsAnal (AbsProd vals) = AbsProd (map (widen AbsAnal) vals)
267 -- It's desirable to do a good job of widening for product
271 -- in ...(case p of (x,y) -> x)...
273 -- Now, is y absent in this expression? Currently the
274 -- analyser widens p before looking at p's scope, to avoid
275 -- lots of recomputation in the case where p is a function.
276 -- So if widening doesn't have a case for products, we'll
277 -- widen p to AbsBot (since when searching for absence in y we
278 -- bind y to poison ie AbsBot), and now we are lost.
280 widen AbsAnal other_val = other_val
282 -- WAS: if anyBot val then AbsBot else AbsTop
283 -- Nowadays widen is doing a better job on functions for absence analysis.
286 @crudeAbsWiden@ is used just for absence analysis, and always
287 returns AbsTop or AbsBot, so it widens to a two-point domain
290 crudeAbsWiden :: AbsVal -> AbsVal
291 crudeAbsWiden val = if anyBot val then AbsBot else AbsTop
294 @sameVal@ compares two abstract values for equality. It can't deal with
295 @AbsFun@, but that should have been removed earlier in the day by @widen@.
298 sameVal :: AbsVal -> AbsVal -> Bool -- Can't handle AbsFun!
301 sameVal (AbsFun _ _ _) _ = panic "sameVal: AbsFun: arg1"
302 sameVal _ (AbsFun _ _ _) = panic "sameVal: AbsFun: arg2"
305 sameVal AbsBot AbsBot = True
306 sameVal AbsBot other = False -- widen has reduced AbsFun bots to AbsBot
308 sameVal AbsTop AbsTop = True
309 sameVal AbsTop other = False -- Right?
311 sameVal (AbsProd vals1) (AbsProd vals2) = and (zipWithEqual sameVal vals1 vals2)
312 sameVal (AbsProd _) AbsTop = False
313 sameVal (AbsProd _) AbsBot = False
315 sameVal (AbsApproxFun str1) (AbsApproxFun str2) = str1 == str2
316 sameVal (AbsApproxFun _) AbsTop = False
317 sameVal (AbsApproxFun _) AbsBot = False
319 sameVal val1 val2 = panic "sameVal: type mismatch or AbsFun encountered"
323 @evalStrictness@ compares a @Demand@ with an abstract value, returning
324 @True@ iff the abstract value is {\em less defined} than the demand.
325 (@True@ is the exciting answer; @False@ is always safe.)
328 evalStrictness :: Demand
330 -> Bool -- True iff the value is sure
331 -- to be less defined than the Demand
333 evalStrictness (WwLazy _) _ = False
334 evalStrictness WwStrict val = isBot val
335 evalStrictness WwEnum val = isBot val
337 evalStrictness (WwUnpack demand_info) val
341 AbsProd vals -> or (zipWithEqual evalStrictness demand_info vals)
342 _ -> trace "evalStrictness?" False
344 evalStrictness WwPrim val
348 other -> -- A primitive value should be defined, never bottom;
349 -- hence this paranoia check
350 pprPanic "evalStrictness: WwPrim:" (ppr PprDebug other)
353 For absence analysis, we're interested in whether "poison" in the
354 argument (ie a bottom therein) can propagate to the result of the
355 function call; that is, whether the specified demand can {\em
356 possibly} hit poison.
359 evalAbsence (WwLazy True) _ = False -- Can't possibly hit poison
360 -- with Absent demand
362 evalAbsence (WwUnpack demand_info) val
364 AbsTop -> False -- No poison in here
365 AbsBot -> True -- Pure poison
366 AbsProd vals -> or (zipWithEqual evalAbsence demand_info vals)
367 _ -> panic "evalAbsence: other"
369 evalAbsence other val = anyBot val
370 -- The demand is conservative; even "Lazy" *might* evaluate the
371 -- argument arbitrarily so we have to look everywhere for poison
374 %************************************************************************
376 \subsection[absEval]{Evaluate an expression in the abstract domain}
378 %************************************************************************
381 -- The isBottomingId stuf is now dealt with via the Id's strictness info
382 -- absId anal var env | isBottomingId var
384 -- StrAnal -> AbsBot -- See discussion below
385 -- AbsAnal -> AbsTop -- Just want to see if there's any poison in
391 case (lookupAbsValEnv env var, getIdStrictness var, getIdUnfolding var) of
393 (Just abs_val, _, _) ->
394 abs_val -- Bound in the environment
396 (Nothing, NoStrictnessInfo, LitForm _) ->
397 AbsTop -- Literals all terminate, and have no poison
399 (Nothing, NoStrictnessInfo, ConForm _ _) ->
400 AbsTop -- An imported constructor won't have
401 -- bottom components, nor poison!
403 (Nothing, NoStrictnessInfo, GenForm _ _ unfolding _) ->
404 -- We have an unfolding for the expr
405 -- Assume the unfolding has no free variables since it
406 -- came from inside the Id
407 absEval anal (unTagBinders unfolding) env
408 -- Notice here that we only look in the unfolding if we don't
409 -- have strictness info (an unusual situation).
410 -- We could have chosen to look in the unfolding if it exists,
411 -- and only try the strictness info if it doesn't, and that would
412 -- give more accurate results, at the cost of re-abstract-interpreting
413 -- the unfolding every time.
414 -- We found only one place where the look-at-unfolding-first
415 -- method gave better results, which is in the definition of
416 -- showInt in the Prelude. In its defintion, fromIntegral is
417 -- not inlined (it's big) but ab-interp-ing its unfolding gave
418 -- a better result than looking at its strictness only.
419 -- showInt :: Integral a => a -> [Char] -> [Char]
420 -- ! {-# GHC_PRAGMA _A_ 1 _U_ 122 _S_
421 -- "U(U(U(U(SA)AAAAAAAAL)AA)AAAAASAAASA)" {...} _N_ _N_ #-}
423 -- showInt :: Integral a => a -> [Char] -> [Char]
424 -- ! {-# GHC_PRAGMA _A_ 1 _U_ 122 _S_
425 -- "U(U(U(U(SL)LLLLLLLLL)LL)LLLLLSLLLLL)" _N_ _N_ #-}
428 (Nothing, strictness_info, _) ->
429 -- Includes MagicForm, IWantToBeINLINEd, NoUnfoldingDetails
430 -- Try the strictness info
431 absValFromStrictness anal strictness_info
434 -- Done via strictness now
435 -- GenForm _ BottomForm _ _ -> AbsBot
437 -- pprTrace "absId:" (ppBesides [ppr PprDebug var, ppStr "=:", pp_anal anal, ppStr ":=",ppr PprDebug result]) (
441 pp_anal StrAnal = ppStr "STR"
442 pp_anal AbsAnal = ppStr "ABS"
444 absEvalAtom anal (VarArg v) env = absId anal v env
445 absEvalAtom anal (LitArg _) env = AbsTop
449 absEval :: AnalysisKind -> CoreExpr -> AbsValEnv -> AbsVal
451 absEval anal (Var var) env = absId anal var env
453 absEval anal (Lit _) env = AbsTop
454 -- What if an unboxed literal? That's OK: it terminates, so its
455 -- abstract value is AbsTop.
457 -- For absence analysis, a literal certainly isn't the "poison" variable
460 Discussion about \tr{error} (following/quoting Lennart): Any expression
461 \tr{error e} is regarded as bottom (with HBC, with the
462 \tr{-ffail-strict} flag, on with \tr{-O}).
464 Regarding it as bottom gives much better strictness properties for
468 f (x:xs) y = f xs (x+y)
470 f [] _ = error "no match"
472 f (x:xs) y = f xs (x+y)
474 is strict in \tr{y}, which you really want. But, it may lead to
475 transformations that turn a call to \tr{error} into non-termination.
476 (The odds of this happening aren't good.)
479 Things are a little different for absence analysis, because we want
480 to make sure that any poison (?????)
483 absEval StrAnal (Prim SeqOp [TyArg _, e]) env
485 if isBot (absEvalAtom StrAnal e env) then AbsBot else AbsTop
486 -- This is a special case to ensure that seq# is strict in its argument.
487 -- The comments below (for most normal PrimOps) do not apply.
489 absEval StrAnal (Prim op es) env = AbsTop
490 -- The arguments are all of unboxed type, so they will already
491 -- have been eval'd. If the boxed version was bottom, we'll
492 -- already have returned bottom.
494 -- Actually, I believe we are saying that either (1) the
495 -- primOp uses unboxed args and they've been eval'ed, so
496 -- there's no need to force strictness here, _or_ the primOp
497 -- uses boxed args and we don't know whether or not it's
498 -- strict, so we assume laziness. (JSM)
500 absEval AbsAnal (Prim op as) env
501 = if any anyBot [absEvalAtom AbsAnal a env | a <- as, isValArg a]
504 -- For absence analysis, we want to see if the poison shows up...
506 absEval anal (Con con as) env
508 = AbsProd [absEvalAtom anal a env | a <- as, isValArg a]
510 | otherwise -- Not single-constructor
512 StrAnal -> -- Strictness case: it's easy: it certainly terminates
514 AbsAnal -> -- In the absence case we need to be more
515 -- careful: look to see if there's any
516 -- poison in the components
517 if any anyBot [absEvalAtom AbsAnal a env | a <- as, isValArg a]
521 (_,_,_, tycon) = dataConSig con
522 has_single_con = maybeToBool (maybeTyConSingleCon tycon)
526 absEval anal (Lam (ValBinder binder) body) env
527 = AbsFun [binder] body env
528 absEval anal (Lam other_binder expr) env
529 = absEval anal expr env
530 absEval anal (App f a) env | isValArg a
531 = absApply anal (absEval anal f env) (absEvalAtom anal a env)
532 absEval anal (App expr _) env
533 = absEval anal expr env
536 For primitive cases, just GLB the branches, then LUB with the expr part.
539 absEval anal (Case expr (PrimAlts alts deflt)) env
541 expr_val = absEval anal expr env
542 abs_alts = [ absEval anal rhs env | (_, rhs) <- alts ]
543 -- Don't bother to extend envt, because unbound vars
544 -- default to the conservative AbsTop
546 abs_deflt = absEvalDefault anal expr_val deflt env
548 combineCaseValues anal expr_val
549 (abs_deflt ++ abs_alts)
551 absEval anal (Case expr (AlgAlts alts deflt)) env
553 expr_val = absEval anal expr env
554 abs_alts = [ absEvalAlgAlt anal expr_val alt env | alt <- alts ]
555 abs_deflt = absEvalDefault anal expr_val deflt env
559 combineCaseValues anal expr_val
560 (abs_deflt ++ abs_alts)
565 _ -> pprTrace "absCase:ABS:" (ppAbove (ppCat [ppr PprDebug expr, ppr PprDebug result, ppr PprDebug expr_val, ppr PprDebug abs_deflt, ppr PprDebug abs_alts]) (ppr PprDebug (keysFM env `zip` eltsFM env)))
571 For @Lets@ we widen the value we get. This is nothing to
572 do with fixpointing. The reason is so that we don't get an explosion
573 in the amount of computation. For example, consider:
585 If we bind @f@ and @g@ to their exact abstract value, then we'll
586 ``execute'' one call to @f@ and {\em two} calls to @g@. This can blow
587 up exponentially. Widening cuts it off by making a fixed
588 approximation to @f@ and @g@, so that the bodies of @f@ and @g@ are
589 not evaluated again at all when they are called.
591 Of course, this can lose useful joint strictness, which is sad. An
592 alternative approach would be to try with a certain amount of ``fuel''
593 and be prepared to bale out.
596 absEval anal (Let (NonRec binder e1) e2) env
598 new_env = addOneToAbsValEnv env binder (widen anal (absEval anal e1 env))
600 -- The binder of a NonRec should *not* be of unboxed type,
601 -- hence no need to strictly evaluate the Rhs.
602 absEval anal e2 new_env
604 absEval anal (Let (Rec pairs) body) env
606 (binders,rhss) = unzip pairs
607 rhs_vals = cheapFixpoint anal binders rhss env -- Returns widened values
608 new_env = growAbsValEnvList env (binders `zip` rhs_vals)
610 absEval anal body new_env
612 absEval anal (SCC cc expr) env = absEval anal expr env
616 absEvalAlgAlt :: AnalysisKind -> AbsVal -> (Id,[Id],CoreExpr) -> AbsValEnv -> AbsVal
618 absEvalAlgAlt anal (AbsProd arg_vals) (con, args, rhs) env
619 = -- The scrutinee is a product value, so it must be of a single-constr
620 -- type; so the constructor in this alternative must be the right one
621 -- so we can go ahead and bind the constructor args to the components
622 -- of the product value.
623 ASSERT(length arg_vals == length args)
625 new_env = growAbsValEnvList env (args `zip` arg_vals)
627 absEval anal rhs new_env
629 absEvalAlgAlt anal other_scrutinee (con, args, rhs) env
630 = -- Scrutinised value is Top or Bot (it can't be a function!)
631 -- So just evaluate the rhs with all constr args bound to Top.
632 -- (If the scrutinee is Top we'll never evaluated this function
638 = case other_scrutinee of {
639 AbsTop -> True; -- i.e., OK
640 AbsBot -> True; -- ditto
641 _ -> False -- party over
645 absEvalDefault :: AnalysisKind
646 -> AbsVal -- Value of scrutinee
649 -> [AbsVal] -- Empty or singleton
651 absEvalDefault anal scrut_val NoDefault env = []
652 absEvalDefault anal scrut_val (BindDefault binder expr) env
653 = [absEval anal expr (addOneToAbsValEnv env binder scrut_val)]
656 %************************************************************************
658 \subsection[absApply]{Apply an abstract function to an abstract argument}
660 %************************************************************************
665 absApply :: AnalysisKind -> AbsVal -> AbsVal -> AbsVal
667 absApply anal AbsBot arg = AbsBot
668 -- AbsBot represents the abstract bottom *function* too
670 absApply StrAnal AbsTop arg = AbsTop
671 absApply AbsAnal AbsTop arg = if anyBot arg
674 -- To be conservative, we have to assume that a function about
675 -- which we know nothing (AbsTop) might look at some part of
679 An @AbsFun@ with only one more argument needed---bind it and eval the
680 result. A @Lam@ with two or more args: return another @AbsFun@ with
681 an augmented environment.
684 absApply anal (AbsFun [binder] body env) arg
685 = absEval anal body (addOneToAbsValEnv env binder arg)
687 absApply anal (AbsFun (binder:bs) body env) arg
688 = AbsFun bs body (addOneToAbsValEnv env binder arg)
692 absApply StrAnal (AbsApproxFun (arg1_demand:ds)) arg
693 = if evalStrictness arg1_demand arg
697 other -> AbsApproxFun ds
699 absApply AbsAnal (AbsApproxFun (arg1_demand:ds)) arg
700 = if evalAbsence arg1_demand arg
704 other -> AbsApproxFun ds
707 absApply anal (AbsApproxFun []) arg = panic ("absApply: Duff function: AbsApproxFun." ++ show anal)
708 absApply anal (AbsFun [] _ _) arg = panic ("absApply: Duff function: AbsFun." ++ show anal)
709 absApply anal (AbsProd _) arg = panic ("absApply: Duff function: AbsProd." ++ show anal)
716 %************************************************************************
718 \subsection[findStrictness]{Determine some binders' strictness}
720 %************************************************************************
722 @findStrictness@ applies the function \tr{\ ids -> expr} to
723 \tr{[bot,top,top,...]}, \tr{[top,bot,top,top,...]}, etc., (i.e., once
724 with @AbsBot@ in each argument position), and evaluates the resulting
725 abstract value; it returns a vector of @Demand@s saying whether the
726 result of doing this is guaranteed to be bottom. This tells the
727 strictness of the function in each of the arguments.
729 If an argument is of unboxed type, then we declare that function to be
730 strict in that argument.
732 We don't really have to make up all those lists of mostly-@AbsTops@;
733 unbound variables in an @AbsValEnv@ are implicitly mapped to that.
735 See notes on @addStrictnessInfoToId@.
738 findStrictness :: StrAnalFlags
739 -> [Type] -- Types of args in which strictness is wanted
740 -> AbsVal -- Abstract strictness value of function
741 -> AbsVal -- Abstract absence value of function
742 -> [Demand] -- Resulting strictness annotation
744 findStrictness strflags [] str_val abs_val = []
746 findStrictness strflags (ty:tys) str_val abs_val
748 demand = findRecDemand strflags [] str_fn abs_fn ty
749 str_fn val = absApply StrAnal str_val val
750 abs_fn val = absApply AbsAnal abs_val val
752 demands = findStrictness strflags tys
753 (absApply StrAnal str_val AbsTop)
754 (absApply AbsAnal abs_val AbsTop)
761 findDemandStrOnly str_env expr binder -- Only strictness environment available
762 = findRecDemand strflags [] str_fn abs_fn (idType binder)
764 str_fn val = absEval StrAnal expr (addOneToAbsValEnv str_env binder val)
765 abs_fn val = AbsBot -- Always says poison; so it looks as if
766 -- nothing is absent; safe
767 strflags = getStrAnalFlags str_env
769 findDemandAbsOnly abs_env expr binder -- Only absence environment available
770 = findRecDemand strflags [] str_fn abs_fn (idType binder)
772 str_fn val = AbsBot -- Always says non-termination;
773 -- that'll make findRecDemand peer into the
774 -- structure of the value.
775 abs_fn val = absEval AbsAnal expr (addOneToAbsValEnv abs_env binder val)
776 strflags = getStrAnalFlags abs_env
779 findDemand str_env abs_env expr binder
780 = findRecDemand strflags [] str_fn abs_fn (idType binder)
782 str_fn val = absEval StrAnal expr (addOneToAbsValEnv str_env binder val)
783 abs_fn val = absEval AbsAnal expr (addOneToAbsValEnv abs_env binder val)
784 strflags = getStrAnalFlags str_env
787 @findRecDemand@ is where we finally convert strictness/absence info
788 into ``Demands'' which we can pin on Ids (etc.).
790 NOTE: What do we do if something is {\em both} strict and absent?
791 Should \tr{f x y z = error "foo"} says that \tr{f}'s arguments are all
792 strict (because of bottoming effect of \tr{error}) or all absent
793 (because they're not used)?
795 Well, for practical reasons, we prefer absence over strictness. In
796 particular, it makes the ``default defaults'' for class methods (the
797 ones that say \tr{defm.foo dict = error "I don't exist"}) come out
798 nicely [saying ``the dict isn't used''], rather than saying it is
799 strict in every component of the dictionary [massive gratuitious
800 casing to take the dict apart].
802 But you could have examples where going for strictness would be better
803 than absence. Consider:
805 let x = something big
810 If \tr{x} is marked absent in \tr{f}, but not strict, and \tr{g} is
811 lazy, then the thunk for \tr{x} will be built. If \tr{f} was strict,
812 then we'd let-to-case it:
814 case something big of
820 findRecDemand :: StrAnalFlags
821 -> [TyCon] -- TyCons already seen; used to avoid
822 -- zooming into recursive types
823 -> (AbsVal -> AbsVal) -- The strictness function
824 -> (AbsVal -> AbsVal) -- The absence function
825 -> Type -- The type of the argument
828 findRecDemand strflags seen str_fn abs_fn ty
829 = if isPrimType ty then -- It's a primitive type!
832 else if not (anyBot (abs_fn AbsBot)) then -- It's absent
833 -- We prefer absence over strictness: see NOTE above.
836 else if not (all_strict ||
837 (num_strict && is_numeric_type ty) ||
838 (isBot (str_fn AbsBot))) then
839 WwLazy False -- It's not strict and we're not pretending
841 else -- It's strict (or we're pretending it is)!
843 case maybeAppDataTyCon ty of
847 Just (tycon,tycon_arg_tys,[data_con]) | tycon `not_elem` seen ->
848 -- Single constructor case, tycon not already seen higher up
850 cmpnt_tys = dataConArgTys data_con tycon_arg_tys
851 prod_len = length cmpnt_tys
854 = [ findRecDemand strflags (tycon:seen)
856 str_fn (mkMainlyTopProd prod_len i cmpnt_val)
859 abs_fn (mkMainlyTopProd prod_len i cmpnt_val)
862 | (cmpnt_ty, i) <- cmpnt_tys `zip` [1..] ]
864 if null compt_strict_infos then
865 if isEnumerationTyCon tycon then wwEnum else wwStrict
867 wwUnpack compt_strict_infos
869 not_elem = isn'tIn "findRecDemand"
872 -- Multi-constr data types, *or* an abstract data
873 -- types, *or* things we don't have a way of conveying
874 -- the info over module boundaries (class ops,
875 -- superdict sels, dfns).
876 if isEnumerationTyCon tycon then
881 (all_strict, num_strict) = strflags
884 = case (maybeAppDataTyCon ty) of -- NB: duplicates stuff done above
888 [intTyCon, integerTyCon,
889 doubleTyCon, floatTyCon,
890 wordTyCon, addrTyCon]
892 _{-something else-} -> False
894 is_elem = isIn "is_numeric_type"
896 -- mkMainlyTopProd: make an AbsProd that is all AbsTops ("n"-1 of
897 -- them) except for a given value in the "i"th position.
899 mkMainlyTopProd :: Int -> Int -> AbsVal -> AbsVal
901 mkMainlyTopProd n i val
903 befores = nOfThem (i-1) AbsTop
904 afters = nOfThem (n-i) AbsTop
906 AbsProd (befores ++ (val : afters))
909 %************************************************************************
911 \subsection[fixpoint]{Fixpointer for the strictness analyser}
913 %************************************************************************
915 The @fixpoint@ functions take a list of \tr{(binder, expr)} pairs, an
916 environment, and returns the abstract value of each binder.
918 The @cheapFixpoint@ function makes a conservative approximation,
919 by binding each of the variables to Top in their own right hand sides.
920 That allows us to make rapid progress, at the cost of a less-than-wonderful
924 cheapFixpoint :: AnalysisKind -> [Id] -> [CoreExpr] -> AbsValEnv -> [AbsVal]
926 cheapFixpoint AbsAnal [id] [rhs] env
927 = [crudeAbsWiden (absEval AbsAnal rhs new_env)]
929 new_env = addOneToAbsValEnv env id AbsTop -- Unsafe starting point!
930 -- In the just-one-binding case, we guarantee to
931 -- find a fixed point in just one iteration,
932 -- because we are using only a two-point domain.
933 -- This improves matters in cases like:
935 -- f x y = letrec g = ...g...
938 -- Here, y isn't used at all, but if g is bound to
939 -- AbsBot we simply get AbsBot as the next
942 cheapFixpoint anal ids rhss env
943 = [widen anal (absEval anal rhs new_env) | rhs <- rhss]
944 -- We do just one iteration, starting from a safe
945 -- approximation. This won't do a good job in situations
947 -- \x -> letrec f = ...g...
951 -- Here, f will end up bound to Top after one iteration,
952 -- and hence we won't spot the strictness in x.
953 -- (A second iteration would solve this. ToDo: try the effect of
954 -- really searching for a fixed point.)
956 new_env = growAbsValEnvList env [(id,safe_val) | id <- ids]
959 = case anal of -- The safe starting point
965 mkLookupFun :: (key -> key -> Bool) -- Equality predicate
966 -> (key -> key -> Bool) -- Less-than predicate
967 -> [(key,val)] -- The assoc list
969 -> Maybe val -- The corresponding value
971 mkLookupFun eq lt alist s
972 = case [a | (s',a) <- alist, s' `eq` s] of
978 fixpoint :: AnalysisKind -> [Id] -> [CoreExpr] -> AbsValEnv -> [AbsVal]
980 fixpoint anal [] _ env = []
982 fixpoint anal ids rhss env
983 = fix_loop initial_vals
986 = case anal of -- The (unsafe) starting point
987 StrAnal -> if (returnsRealWorld (idType id))
988 then AbsTop -- this is a massively horrible hack (SLPJ 95/05)
992 initial_vals = [ initial_val id | id <- ids ]
994 fix_loop :: [AbsVal] -> [AbsVal]
996 fix_loop current_widened_vals
998 new_env = growAbsValEnvList env (ids `zip` current_widened_vals)
999 new_vals = [ absEval anal rhs new_env | rhs <- rhss ]
1000 new_widened_vals = map (widen anal) new_vals
1002 if (and (zipWith sameVal current_widened_vals new_widened_vals)) then
1003 current_widened_vals
1005 -- NB: I was too chicken to make that a zipWithEqual,
1006 -- lest I jump into a black hole. WDP 96/02
1008 -- Return the widened values. We might get a slightly
1009 -- better value by returning new_vals (which we used to
1010 -- do, see below), but alas that means that whenever the
1011 -- function is called we have to re-execute it, which is
1016 -- Return the un-widened values which may be a bit better
1017 -- than the widened ones, and are guaranteed safe, since
1018 -- they are one iteration beyond current_widened_vals,
1019 -- which itself is a fixed point.
1021 fix_loop new_widened_vals
1024 For absence analysis, we make do with a very very simple approach:
1025 look for convergence in a two-point domain.
1027 We used to use just one iteration, starting with the variables bound
1028 to @AbsBot@, which is safe.
1030 Prior to that, we used one iteration starting from @AbsTop@ (which
1031 isn't safe). Why isn't @AbsTop@ safe? Consider:
1039 Here, if p is @AbsBot@, then we'd better {\em not} end up with a ``fixed
1040 point'' of @d@ being @(AbsTop, AbsTop)@! An @AbsBot@ initial value is
1041 safe because it gives poison more often than really necessary, and
1042 thus may miss some absence, but will never claim absence when it ain't
1045 Anyway, one iteration starting with everything bound to @AbsBot@ give
1050 Here, f would always end up bound to @AbsBot@, which ain't very
1051 clever, because then it would introduce poison whenever it was
1052 applied. Much better to start with f bound to @AbsTop@, and widen it
1053 to @AbsBot@ if any poison shows up. In effect we look for convergence
1054 in the two-point @AbsTop@/@AbsBot@ domain.
1056 What we miss (compared with the cleverer strictness analysis) is
1057 spotting that in this case
1059 f = \ x y -> ...y...(f x y')...
1061 \tr{x} is actually absent, since it is only passed round the loop, never
1062 used. But who cares about missing that?
1064 NB: despite only having a two-point domain, we may still have many
1065 iterations, because there are several variables involved at once.