2 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1996
4 \section[SaAbsInt]{Abstract interpreter for strictness analysis}
16 #include "HsVersions.h"
18 import CmdLineOpts ( opt_AllStrict, opt_NumbersStrict )
20 import CoreUnfold ( Unfolding(..), SimpleUnfolding(..), FormSummary )
21 import CoreUtils ( unTagBinders )
22 import Id ( idType, getIdStrictness, getIdUnfolding,
23 dataConTyCon, dataConArgTys, Id
25 import IdInfo ( StrictnessInfo(..) )
26 import Demand ( Demand(..), wwPrim, wwStrict, wwEnum, wwUnpackData, wwUnpackNew )
27 import MagicUFs ( MagicUnfoldingFun )
28 import Maybes ( maybeToBool )
29 import PrimOp ( PrimOp(..) )
31 import TyCon ( isProductTyCon, isEnumerationTyCon, isNewTyCon,
34 import BasicTypes ( NewOrData(..) )
35 import Type ( splitAlgTyConApp_maybe,
36 isUnpointedType, Type )
37 import TysWiredIn ( intTyCon, integerTyCon, doubleTyCon,
38 floatTyCon, wordTyCon, addrTyCon
40 import Util ( isIn, isn'tIn, nOfThem, zipWithEqual )
41 import GlaExts ( trace )
44 returnsRealWorld x = False -- ToDo: panic "SaAbsInt.returnsRealWorld (ToDo)"
47 %************************************************************************
49 \subsection[AbsVal-ops]{Operations on @AbsVals@}
51 %************************************************************************
53 Least upper bound, greatest lower bound.
56 lub, glb :: AbsVal -> AbsVal -> AbsVal
58 lub val1 val2 | isBot val1 = val2 -- The isBot test includes the case where
59 lub val1 val2 | isBot val2 = val1 -- one of the val's is a function which
60 -- always returns bottom, such as \y.x,
61 -- when x is bound to bottom.
63 lub (AbsProd xs) (AbsProd ys) = AbsProd (zipWithEqual "lub" lub xs ys)
65 lub _ _ = AbsTop -- Crude, but conservative
66 -- The crudity only shows up if there
67 -- are functions involved
69 -- Slightly funny glb; for absence analysis only;
70 -- AbsBot is the safe answer.
72 -- Using anyBot rather than just testing for AbsBot is important.
77 -- g = \x y z -> case x of
81 -- Now, the abstract value of the branches of the case will be an
82 -- AbsFun, but when testing for z's absence we want to spot that it's
83 -- an AbsFun which can't possibly return AbsBot. So when glb'ing we
84 -- mustn't be too keen to bale out and return AbsBot; the anyBot test
85 -- spots that (f x) can't possibly return AbsBot.
87 -- We have also tripped over the following interesting case:
92 -- Now, suppose f is bound to AbsTop. Does this expression mention z?
93 -- Obviously not. But the case will take the glb of AbsTop (for f) and
94 -- an AbsFun (for \y->1). We should not bale out and give AbsBot, because
95 -- that would say that it *does* mention z (or anything else for that matter).
96 -- Nor can we always return AbsTop, because the AbsFun might be something
97 -- like (\y->z), which obviously does mention z. The point is that we're
98 -- glbing two functions, and AbsTop is not actually the top of the function
99 -- lattice. It is more like (\xyz -> x|y|z); that is, AbsTop returns
100 -- poison iff any of its arguments do.
102 -- Deal with functions specially, because AbsTop isn't the
103 -- top of their domain.
106 | is_fun v1 || is_fun v2
107 = if not (anyBot v1) && not (anyBot v2)
113 is_fun (AbsFun _ _ _) = True
114 is_fun (AbsApproxFun _ _) = True -- Not used, but the glb works ok
117 -- The non-functional cases are quite straightforward
119 glb (AbsProd xs) (AbsProd ys) = AbsProd (zipWithEqual "glb" glb xs ys)
124 glb _ _ = AbsBot -- Be pessimistic
130 -> AbsVal -- Value of scrutinee
131 -> [AbsVal] -- Value of branches (at least one)
134 -- For strictness analysis, see if the scrutinee is bottom; if so
135 -- return bottom; otherwise, the lub of the branches.
137 combineCaseValues StrAnal AbsBot branches = AbsBot
138 combineCaseValues StrAnal other_scrutinee branches
139 -- Scrutinee can only be AbsBot, AbsProd or AbsTop
140 = ASSERT(ok_scrutinee)
144 = case other_scrutinee of {
145 AbsTop -> True; -- i.e., cool
146 AbsProd _ -> True; -- ditto
147 _ -> False -- party over
150 -- For absence analysis, check if the scrutinee is all poison (isBot)
151 -- If so, return poison (AbsBot); otherwise, any nested poison will come
152 -- out from looking at the branches, so just glb together the branches
153 -- to get the worst one.
155 combineCaseValues AbsAnal AbsBot branches = AbsBot
156 combineCaseValues AbsAnal other_scrutinee branches
157 -- Scrutinee can only be AbsBot, AbsProd or AbsTop
158 = ASSERT(ok_scrutinee)
160 result = foldr1 glb branches
162 tracer = if at_least_one_AbsFun && at_least_one_AbsTop
164 pprTrace "combineCase:" (ppr branches)
173 = case other_scrutinee of {
174 AbsTop -> True; -- i.e., cool
175 AbsProd _ -> True; -- ditto
176 _ -> False -- party over
179 at_least_one_AbsFun = foldr ((||) . is_AbsFun) False branches
180 at_least_one_AbsTop = foldr ((||) . is_AbsTop) False branches
181 no_AbsBots = foldr ((&&) . is_not_AbsBot) True branches
183 is_AbsFun x = case x of { AbsFun _ _ _ -> True; _ -> False }
184 is_AbsTop x = case x of { AbsTop -> True; _ -> False }
185 is_not_AbsBot x = case x of { AbsBot -> False; _ -> True }
188 @isBot@ returns True if its argument is (a representation of) bottom. The
189 ``representation'' part is because we need to detect the bottom {\em function}
190 too. To detect the bottom function, bind its args to top, and see if it
193 Used only in strictness analysis:
195 isBot :: AbsVal -> Bool
198 isBot (AbsFun arg body env) = isBot (absEval StrAnal body env)
199 -- Don't bother to extend the envt because
200 -- unbound variables default to AbsTop anyway
204 Used only in absence analysis:
206 anyBot :: AbsVal -> Bool
208 anyBot AbsBot = True -- poisoned!
209 anyBot AbsTop = False
210 anyBot (AbsProd vals) = any anyBot vals
211 anyBot (AbsFun arg body env) = anyBot (absEval AbsAnal body env)
212 anyBot (AbsApproxFun _ _) = False
214 -- AbsApproxFun can only arise in absence analysis from the Demand
215 -- info of an imported value; whatever it is we're looking for is
216 -- certainly not present over in the imported value.
219 @widen@ takes an @AbsVal@, $val$, and returns and @AbsVal@ which is
220 approximated by $val$. Furthermore, the result has no @AbsFun@s in
221 it, so it can be compared for equality by @sameVal@.
224 widen :: AnalysisKind -> AbsVal -> AbsVal
226 widen StrAnal (AbsFun arg body env)
227 = AbsApproxFun (findDemandStrOnly env body arg)
228 (widen StrAnal abs_body)
230 abs_body = absEval StrAnal body env
233 This stuff is now instead handled neatly by the fact that AbsApproxFun
234 contains an AbsVal inside it. SLPJ Jan 97
236 | isBot abs_body = AbsBot
237 -- It's worth checking for a function which is unconditionally
240 -- f x y = let g y = case x of ...
241 -- in (g ..) + (g ..)
243 -- Here, when we are considering strictness of f in x, we'll
244 -- evaluate the body of f with x bound to bottom. The current
245 -- strategy is to bind g to its *widened* value; without the isBot
246 -- (...) test above, we'd bind g to an AbsApproxFun, and deliver
247 -- Top, not Bot as the value of f's rhs. The test spots the
248 -- unconditional bottom-ness of g when x is bottom. (Another
249 -- alternative here would be to bind g to its exact abstract
250 -- value, but that entails lots of potential re-computation, at
251 -- every application of g.)
254 widen StrAnal (AbsProd vals) = AbsProd (map (widen StrAnal) vals)
255 widen StrAnal other_val = other_val
258 widen AbsAnal (AbsFun arg body env)
259 | anyBot abs_body = AbsBot
260 -- In the absence-analysis case it's *essential* to check
261 -- that the function has no poison in its body. If it does,
262 -- anywhere, then the whole function is poisonous.
265 = AbsApproxFun (findDemandAbsOnly env body arg)
266 (widen AbsAnal abs_body)
268 abs_body = absEval AbsAnal body env
270 widen AbsAnal (AbsProd vals) = AbsProd (map (widen AbsAnal) vals)
272 -- It's desirable to do a good job of widening for product
276 -- in ...(case p of (x,y) -> x)...
278 -- Now, is y absent in this expression? Currently the
279 -- analyser widens p before looking at p's scope, to avoid
280 -- lots of recomputation in the case where p is a function.
281 -- So if widening doesn't have a case for products, we'll
282 -- widen p to AbsBot (since when searching for absence in y we
283 -- bind y to poison ie AbsBot), and now we are lost.
285 widen AbsAnal other_val = other_val
287 -- WAS: if anyBot val then AbsBot else AbsTop
288 -- Nowadays widen is doing a better job on functions for absence analysis.
291 @crudeAbsWiden@ is used just for absence analysis, and always
292 returns AbsTop or AbsBot, so it widens to a two-point domain
295 crudeAbsWiden :: AbsVal -> AbsVal
296 crudeAbsWiden val = if anyBot val then AbsBot else AbsTop
299 @sameVal@ compares two abstract values for equality. It can't deal with
300 @AbsFun@, but that should have been removed earlier in the day by @widen@.
303 sameVal :: AbsVal -> AbsVal -> Bool -- Can't handle AbsFun!
306 sameVal (AbsFun _ _ _) _ = panic "sameVal: AbsFun: arg1"
307 sameVal _ (AbsFun _ _ _) = panic "sameVal: AbsFun: arg2"
310 sameVal AbsBot AbsBot = True
311 sameVal AbsBot other = False -- widen has reduced AbsFun bots to AbsBot
313 sameVal AbsTop AbsTop = True
314 sameVal AbsTop other = False -- Right?
316 sameVal (AbsProd vals1) (AbsProd vals2) = and (zipWithEqual "sameVal" sameVal vals1 vals2)
317 sameVal (AbsProd _) AbsTop = False
318 sameVal (AbsProd _) AbsBot = False
320 sameVal (AbsApproxFun str1 v1) (AbsApproxFun str2 v2) = str1 == str2 && sameVal v1 v2
321 sameVal (AbsApproxFun _ _) AbsTop = False
322 sameVal (AbsApproxFun _ _) AbsBot = False
324 sameVal val1 val2 = panic "sameVal: type mismatch or AbsFun encountered"
328 @evalStrictness@ compares a @Demand@ with an abstract value, returning
329 @True@ iff the abstract value is {\em less defined} than the demand.
330 (@True@ is the exciting answer; @False@ is always safe.)
333 evalStrictness :: Demand
335 -> Bool -- True iff the value is sure
336 -- to be less defined than the Demand
338 evalStrictness (WwLazy _) _ = False
339 evalStrictness WwStrict val = isBot val
340 evalStrictness WwEnum val = isBot val
342 evalStrictness (WwUnpack NewType _ (demand:_)) val
343 = evalStrictness demand val
345 evalStrictness (WwUnpack DataType _ demand_info) val
349 AbsProd vals -> or (zipWithEqual "evalStrictness" evalStrictness demand_info vals)
350 _ -> trace "evalStrictness?" False
352 evalStrictness WwPrim val
356 other -> -- A primitive value should be defined, never bottom;
357 -- hence this paranoia check
358 pprPanic "evalStrictness: WwPrim:" (ppr other)
361 For absence analysis, we're interested in whether "poison" in the
362 argument (ie a bottom therein) can propagate to the result of the
363 function call; that is, whether the specified demand can {\em
364 possibly} hit poison.
367 evalAbsence (WwLazy True) _ = False -- Can't possibly hit poison
368 -- with Absent demand
370 evalAbsence (WwUnpack NewType _ (demand:_)) val
371 = evalAbsence demand val
373 evalAbsence (WwUnpack DataType _ demand_info) val
375 AbsTop -> False -- No poison in here
376 AbsBot -> True -- Pure poison
377 AbsProd vals -> or (zipWithEqual "evalAbsence" evalAbsence demand_info vals)
378 _ -> panic "evalAbsence: other"
380 evalAbsence other val = anyBot val
381 -- The demand is conservative; even "Lazy" *might* evaluate the
382 -- argument arbitrarily so we have to look everywhere for poison
385 %************************************************************************
387 \subsection[absEval]{Evaluate an expression in the abstract domain}
389 %************************************************************************
392 -- The isBottomingId stuf is now dealt with via the Id's strictness info
393 -- absId anal var env | isBottomingId var
395 -- StrAnal -> AbsBot -- See discussion below
396 -- AbsAnal -> AbsTop -- Just want to see if there's any poison in
402 case (lookupAbsValEnv env var, getIdStrictness var, getIdUnfolding var) of
404 (Just abs_val, _, _) ->
405 abs_val -- Bound in the environment
407 (Nothing, NoStrictnessInfo, CoreUnfolding (SimpleUnfolding _ _ unfolding)) ->
408 -- We have an unfolding for the expr
409 -- Assume the unfolding has no free variables since it
410 -- came from inside the Id
411 absEval anal (unTagBinders unfolding) env
412 -- Notice here that we only look in the unfolding if we don't
413 -- have strictness info (an unusual situation).
414 -- We could have chosen to look in the unfolding if it exists,
415 -- and only try the strictness info if it doesn't, and that would
416 -- give more accurate results, at the cost of re-abstract-interpreting
417 -- the unfolding every time.
418 -- We found only one place where the look-at-unfolding-first
419 -- method gave better results, which is in the definition of
420 -- showInt in the Prelude. In its defintion, fromIntegral is
421 -- not inlined (it's big) but ab-interp-ing its unfolding gave
422 -- a better result than looking at its strictness only.
423 -- showInt :: Integral a => a -> [Char] -> [Char]
424 -- ! {-# GHC_PRAGMA _A_ 1 _U_ 122 _S_
425 -- "U(U(U(U(SA)AAAAAAAAL)AA)AAAAASAAASA)" {...} _N_ _N_ #-}
427 -- showInt :: Integral a => a -> [Char] -> [Char]
428 -- ! {-# GHC_PRAGMA _A_ 1 _U_ 122 _S_
429 -- "U(U(U(U(SL)LLLLLLLLL)LL)LLLLLSLLLLL)" _N_ _N_ #-}
432 (Nothing, strictness_info, _) ->
433 -- Includes MagicUnfolding, NoUnfolding
434 -- Try the strictness info
435 absValFromStrictness anal strictness_info
437 -- pprTrace "absId:" (hcat [ppr var, ptext SLIT("=:"), pp_anal anal, text SLIT(":="),ppr result]) $
440 pp_anal StrAnal = ptext SLIT("STR")
441 pp_anal AbsAnal = ptext SLIT("ABS")
443 absEvalAtom anal (VarArg v) env = absId anal v env
444 absEvalAtom anal (LitArg _) env = AbsTop
448 absEval :: AnalysisKind -> CoreExpr -> AbsValEnv -> AbsVal
450 absEval anal (Var var) env = absId anal var env
452 absEval anal (Lit _) env = AbsTop
453 -- What if an unboxed literal? That's OK: it terminates, so its
454 -- abstract value is AbsTop.
456 -- For absence analysis, a literal certainly isn't the "poison" variable
459 Discussion about \tr{error} (following/quoting Lennart): Any expression
460 \tr{error e} is regarded as bottom (with HBC, with the
461 \tr{-ffail-strict} flag, on with \tr{-O}).
463 Regarding it as bottom gives much better strictness properties for
467 f (x:xs) y = f xs (x+y)
469 f [] _ = error "no match"
471 f (x:xs) y = f xs (x+y)
473 is strict in \tr{y}, which you really want. But, it may lead to
474 transformations that turn a call to \tr{error} into non-termination.
475 (The odds of this happening aren't good.)
478 Things are a little different for absence analysis, because we want
479 to make sure that any poison (?????)
482 absEval StrAnal (Prim SeqOp [TyArg _, e]) env
484 if isBot (absEvalAtom StrAnal e env) then AbsBot else AbsTop
485 -- This is a special case to ensure that seq# is strict in its argument.
486 -- The comments below (for most normal PrimOps) do not apply.
488 absEval StrAnal (Prim op es) env = AbsTop
489 -- The arguments are all of unboxed type, so they will already
490 -- have been eval'd. If the boxed version was bottom, we'll
491 -- already have returned bottom.
493 -- Actually, I believe we are saying that either (1) the
494 -- primOp uses unboxed args and they've been eval'ed, so
495 -- there's no need to force strictness here, _or_ the primOp
496 -- uses boxed args and we don't know whether or not it's
497 -- strict, so we assume laziness. (JSM)
499 absEval AbsAnal (Prim op as) env
500 = if any anyBot [absEvalAtom AbsAnal a env | a <- as, isValArg a]
503 -- For absence analysis, we want to see if the poison shows up...
505 absEval anal (Con con as) env
506 | isProductTyCon (dataConTyCon con)
507 = --pprTrace "absEval.Con" (cat[ text "con: ", (ppr con), text "args: ", interppSP as]) $
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]
523 absEval anal (Lam (ValBinder binder) body) env
524 = AbsFun binder body env
525 absEval anal (Lam other_binder expr) env
526 = absEval anal expr env
527 absEval anal (App f a) env | isValArg a
528 = absApply anal (absEval anal f env) (absEvalAtom anal a env)
529 absEval anal (App expr _) env
530 = absEval anal expr env
533 For primitive cases, just GLB the branches, then LUB with the expr part.
536 absEval anal (Case expr (PrimAlts alts deflt)) env
538 expr_val = absEval anal expr env
539 abs_alts = [ absEval anal rhs env | (_, rhs) <- alts ]
540 -- Don't bother to extend envt, because unbound vars
541 -- default to the conservative AbsTop
543 abs_deflt = absEvalDefault anal expr_val deflt env
545 combineCaseValues anal expr_val
546 (abs_deflt ++ abs_alts)
548 absEval anal (Case expr (AlgAlts alts deflt)) env
550 expr_val = absEval anal expr env
551 abs_alts = [ absEvalAlgAlt anal expr_val alt env | alt <- alts ]
552 abs_deflt = absEvalDefault anal expr_val deflt env
556 combineCaseValues anal expr_val
557 (abs_deflt ++ abs_alts)
562 _ -> pprTrace "absCase:ABS:" (($$) (hsep [ppr expr, ppr result, ppr expr_val, ppr abs_deflt, ppr abs_alts]) (ppr (keysFM env `zip` eltsFM env)))
568 For @Lets@ we widen the value we get. This is nothing to
569 do with fixpointing. The reason is so that we don't get an explosion
570 in the amount of computation. For example, consider:
582 If we bind @f@ and @g@ to their exact abstract value, then we'll
583 ``execute'' one call to @f@ and {\em two} calls to @g@. This can blow
584 up exponentially. Widening cuts it off by making a fixed
585 approximation to @f@ and @g@, so that the bodies of @f@ and @g@ are
586 not evaluated again at all when they are called.
588 Of course, this can lose useful joint strictness, which is sad. An
589 alternative approach would be to try with a certain amount of ``fuel''
590 and be prepared to bale out.
593 absEval anal (Let (NonRec binder e1) e2) env
595 new_env = addOneToAbsValEnv env binder (widen anal (absEval anal e1 env))
597 -- The binder of a NonRec should *not* be of unboxed type,
598 -- hence no need to strictly evaluate the Rhs.
599 absEval anal e2 new_env
601 absEval anal (Let (Rec pairs) body) env
603 (binders,rhss) = unzip pairs
604 rhs_vals = cheapFixpoint anal binders rhss env -- Returns widened values
605 new_env = growAbsValEnvList env (binders `zip` rhs_vals)
607 absEval anal body new_env
609 absEval anal (SCC cc expr) env = absEval anal expr env
610 absEval anal (Coerce c ty expr) env = absEval anal expr env
614 absEvalAlgAlt :: AnalysisKind -> AbsVal -> (Id,[Id],CoreExpr) -> AbsValEnv -> AbsVal
616 absEvalAlgAlt anal (AbsProd arg_vals) (con, args, rhs) env
617 = -- The scrutinee is a product value, so it must be of a single-constr
618 -- type; so the constructor in this alternative must be the right one
619 -- so we can go ahead and bind the constructor args to the components
620 -- of the product value.
621 ASSERT(length arg_vals == length args)
623 new_env = growAbsValEnvList env (args `zip` arg_vals)
625 absEval anal rhs new_env
627 absEvalAlgAlt anal other_scrutinee (con, args, rhs) env
628 = -- Scrutinised value is Top or Bot (it can't be a function!)
629 -- So just evaluate the rhs with all constr args bound to Top.
630 -- (If the scrutinee is Top we'll never evaluated this function
636 = case other_scrutinee of {
637 AbsTop -> True; -- i.e., OK
638 AbsBot -> True; -- ditto
639 _ -> False -- party over
643 absEvalDefault :: AnalysisKind
644 -> AbsVal -- Value of scrutinee
647 -> [AbsVal] -- Empty or singleton
649 absEvalDefault anal scrut_val NoDefault env = []
650 absEvalDefault anal scrut_val (BindDefault binder expr) env
651 = [absEval anal expr (addOneToAbsValEnv env binder scrut_val)]
654 %************************************************************************
656 \subsection[absApply]{Apply an abstract function to an abstract argument}
658 %************************************************************************
663 absApply :: AnalysisKind -> AbsVal -> AbsVal -> AbsVal
665 absApply anal AbsBot arg = AbsBot
666 -- AbsBot represents the abstract bottom *function* too
668 absApply StrAnal AbsTop arg = AbsTop
669 absApply AbsAnal AbsTop arg = if anyBot arg
672 -- To be conservative, we have to assume that a function about
673 -- which we know nothing (AbsTop) might look at some part of
677 An @AbsFun@ with only one more argument needed---bind it and eval the
678 result. A @Lam@ with two or more args: return another @AbsFun@ with
679 an augmented environment.
682 absApply anal (AbsFun binder body env) arg
683 = absEval anal body (addOneToAbsValEnv env binder arg)
687 absApply StrAnal (AbsApproxFun demand val) arg
688 = if evalStrictness demand arg
692 absApply AbsAnal (AbsApproxFun demand val) arg
693 = if evalAbsence demand arg
698 absApply anal f@(AbsProd _) arg = pprPanic ("absApply: Duff function: AbsProd." ++ show anal) ((ppr f) <+> (ppr arg))
705 %************************************************************************
707 \subsection[findStrictness]{Determine some binders' strictness}
709 %************************************************************************
711 @findStrictness@ applies the function \tr{\ ids -> expr} to
712 \tr{[bot,top,top,...]}, \tr{[top,bot,top,top,...]}, etc., (i.e., once
713 with @AbsBot@ in each argument position), and evaluates the resulting
714 abstract value; it returns a vector of @Demand@s saying whether the
715 result of doing this is guaranteed to be bottom. This tells the
716 strictness of the function in each of the arguments.
718 If an argument is of unboxed type, then we declare that function to be
719 strict in that argument.
721 We don't really have to make up all those lists of mostly-@AbsTops@;
722 unbound variables in an @AbsValEnv@ are implicitly mapped to that.
724 See notes on @addStrictnessInfoToId@.
727 findStrictness :: [Type] -- Types of args in which strictness is wanted
728 -> AbsVal -- Abstract strictness value of function
729 -> AbsVal -- Abstract absence value of function
730 -> [Demand] -- Resulting strictness annotation
732 findStrictness [] str_val abs_val = []
734 findStrictness (ty:tys) str_val abs_val
736 demand = findRecDemand str_fn abs_fn ty
737 str_fn val = absApply StrAnal str_val val
738 abs_fn val = absApply AbsAnal abs_val val
740 demands = findStrictness tys
741 (absApply StrAnal str_val AbsTop)
742 (absApply AbsAnal abs_val AbsTop)
749 findDemandStrOnly str_env expr binder -- Only strictness environment available
750 = findRecDemand str_fn abs_fn (idType binder)
752 str_fn val = absEval StrAnal expr (addOneToAbsValEnv str_env binder val)
753 abs_fn val = AbsBot -- Always says poison; so it looks as if
754 -- nothing is absent; safe
756 findDemandAbsOnly abs_env expr binder -- Only absence environment available
757 = findRecDemand str_fn abs_fn (idType binder)
759 str_fn val = AbsBot -- Always says non-termination;
760 -- that'll make findRecDemand peer into the
761 -- structure of the value.
762 abs_fn val = absEval AbsAnal expr (addOneToAbsValEnv abs_env binder val)
765 findDemand str_env abs_env expr binder
766 = findRecDemand str_fn abs_fn (idType binder)
768 str_fn val = absEval StrAnal expr (addOneToAbsValEnv str_env binder val)
769 abs_fn val = absEval AbsAnal expr (addOneToAbsValEnv abs_env binder val)
772 @findRecDemand@ is where we finally convert strictness/absence info
773 into ``Demands'' which we can pin on Ids (etc.).
775 NOTE: What do we do if something is {\em both} strict and absent?
776 Should \tr{f x y z = error "foo"} says that \tr{f}'s arguments are all
777 strict (because of bottoming effect of \tr{error}) or all absent
778 (because they're not used)?
780 Well, for practical reasons, we prefer absence over strictness. In
781 particular, it makes the ``default defaults'' for class methods (the
782 ones that say \tr{defm.foo dict = error "I don't exist"}) come out
783 nicely [saying ``the dict isn't used''], rather than saying it is
784 strict in every component of the dictionary [massive gratuitious
785 casing to take the dict apart].
787 But you could have examples where going for strictness would be better
788 than absence. Consider:
790 let x = something big
795 If \tr{x} is marked absent in \tr{f}, but not strict, and \tr{g} is
796 lazy, then the thunk for \tr{x} will be built. If \tr{f} was strict,
797 then we'd let-to-case it:
799 case something big of
805 findRecDemand :: (AbsVal -> AbsVal) -- The strictness function
806 -> (AbsVal -> AbsVal) -- The absence function
807 -> Type -- The type of the argument
810 findRecDemand str_fn abs_fn ty
811 = if isUnpointedType ty then -- It's a primitive type!
814 else if not (anyBot (abs_fn AbsBot)) then -- It's absent
815 -- We prefer absence over strictness: see NOTE above.
818 else if not (opt_AllStrict ||
819 (opt_NumbersStrict && is_numeric_type ty) ||
820 (isBot (str_fn AbsBot))) then
821 WwLazy False -- It's not strict and we're not pretending
823 else -- It's strict (or we're pretending it is)!
825 case (splitAlgTyConApp_maybe ty) of
829 Just (tycon,tycon_arg_tys,[data_con]) | isProductTyCon tycon ->
830 -- Non-recursive, single constructor case
832 cmpnt_tys = dataConArgTys data_con tycon_arg_tys
833 prod_len = length cmpnt_tys
836 if isNewTyCon tycon then -- A newtype!
837 ASSERT( null (tail cmpnt_tys) )
839 demand = findRecDemand str_fn abs_fn (head cmpnt_tys)
841 case demand of -- No point in unpacking unless there is more to see inside
842 WwUnpack _ _ _ -> wwUnpackNew demand
850 str_fn (mkMainlyTopProd prod_len i cmpnt_val)
853 abs_fn (mkMainlyTopProd prod_len i cmpnt_val)
856 | (cmpnt_ty, i) <- cmpnt_tys `zip` [1..] ]
858 if null compt_strict_infos then
859 if isEnumerationTyCon tycon then wwEnum else wwStrict
861 wwUnpackData compt_strict_infos
864 -- Multi-constr data types, *or* an abstract data
865 -- types, *or* things we don't have a way of conveying
866 -- the info over module boundaries (class ops,
867 -- superdict sels, dfns).
868 if isEnumerationTyCon tycon then
874 = case (splitAlgTyConApp_maybe ty) of -- NB: duplicates stuff done above
878 [intTyCon, integerTyCon,
879 doubleTyCon, floatTyCon,
880 wordTyCon, addrTyCon]
882 _{-something else-} -> False
884 is_elem = isIn "is_numeric_type"
886 -- mkMainlyTopProd: make an AbsProd that is all AbsTops ("n"-1 of
887 -- them) except for a given value in the "i"th position.
889 mkMainlyTopProd :: Int -> Int -> AbsVal -> AbsVal
891 mkMainlyTopProd n i val
893 befores = nOfThem (i-1) AbsTop
894 afters = nOfThem (n-i) AbsTop
896 AbsProd (befores ++ (val : afters))
899 %************************************************************************
901 \subsection[fixpoint]{Fixpointer for the strictness analyser}
903 %************************************************************************
905 The @fixpoint@ functions take a list of \tr{(binder, expr)} pairs, an
906 environment, and returns the abstract value of each binder.
908 The @cheapFixpoint@ function makes a conservative approximation,
909 by binding each of the variables to Top in their own right hand sides.
910 That allows us to make rapid progress, at the cost of a less-than-wonderful
914 cheapFixpoint :: AnalysisKind -> [Id] -> [CoreExpr] -> AbsValEnv -> [AbsVal]
916 cheapFixpoint AbsAnal [id] [rhs] env
917 = [crudeAbsWiden (absEval AbsAnal rhs new_env)]
919 new_env = addOneToAbsValEnv env id AbsTop -- Unsafe starting point!
920 -- In the just-one-binding case, we guarantee to
921 -- find a fixed point in just one iteration,
922 -- because we are using only a two-point domain.
923 -- This improves matters in cases like:
925 -- f x y = letrec g = ...g...
928 -- Here, y isn't used at all, but if g is bound to
929 -- AbsBot we simply get AbsBot as the next
932 cheapFixpoint anal ids rhss env
933 = [widen anal (absEval anal rhs new_env) | rhs <- rhss]
934 -- We do just one iteration, starting from a safe
935 -- approximation. This won't do a good job in situations
937 -- \x -> letrec f = ...g...
941 -- Here, f will end up bound to Top after one iteration,
942 -- and hence we won't spot the strictness in x.
943 -- (A second iteration would solve this. ToDo: try the effect of
944 -- really searching for a fixed point.)
946 new_env = growAbsValEnvList env [(id,safe_val) | id <- ids]
949 = case anal of -- The safe starting point
955 mkLookupFun :: (key -> key -> Bool) -- Equality predicate
956 -> (key -> key -> Bool) -- Less-than predicate
957 -> [(key,val)] -- The assoc list
959 -> Maybe val -- The corresponding value
961 mkLookupFun eq lt alist s
962 = case [a | (s',a) <- alist, s' `eq` s] of
968 fixpoint :: AnalysisKind -> [Id] -> [CoreExpr] -> AbsValEnv -> [AbsVal]
970 fixpoint anal [] _ env = []
972 fixpoint anal ids rhss env
973 = fix_loop initial_vals
976 = case anal of -- The (unsafe) starting point
977 StrAnal -> if (returnsRealWorld (idType id))
978 then AbsTop -- this is a massively horrible hack (SLPJ 95/05)
982 initial_vals = [ initial_val id | id <- ids ]
984 fix_loop :: [AbsVal] -> [AbsVal]
986 fix_loop current_widened_vals
988 new_env = growAbsValEnvList env (ids `zip` current_widened_vals)
989 new_vals = [ absEval anal rhs new_env | rhs <- rhss ]
990 new_widened_vals = map (widen anal) new_vals
992 if (and (zipWith sameVal current_widened_vals new_widened_vals)) then
995 -- NB: I was too chicken to make that a zipWithEqual,
996 -- lest I jump into a black hole. WDP 96/02
998 -- Return the widened values. We might get a slightly
999 -- better value by returning new_vals (which we used to
1000 -- do, see below), but alas that means that whenever the
1001 -- function is called we have to re-execute it, which is
1006 -- Return the un-widened values which may be a bit better
1007 -- than the widened ones, and are guaranteed safe, since
1008 -- they are one iteration beyond current_widened_vals,
1009 -- which itself is a fixed point.
1011 fix_loop new_widened_vals
1014 For absence analysis, we make do with a very very simple approach:
1015 look for convergence in a two-point domain.
1017 We used to use just one iteration, starting with the variables bound
1018 to @AbsBot@, which is safe.
1020 Prior to that, we used one iteration starting from @AbsTop@ (which
1021 isn't safe). Why isn't @AbsTop@ safe? Consider:
1029 Here, if p is @AbsBot@, then we'd better {\em not} end up with a ``fixed
1030 point'' of @d@ being @(AbsTop, AbsTop)@! An @AbsBot@ initial value is
1031 safe because it gives poison more often than really necessary, and
1032 thus may miss some absence, but will never claim absence when it ain't
1035 Anyway, one iteration starting with everything bound to @AbsBot@ give
1040 Here, f would always end up bound to @AbsBot@, which ain't very
1041 clever, because then it would introduce poison whenever it was
1042 applied. Much better to start with f bound to @AbsTop@, and widen it
1043 to @AbsBot@ if any poison shows up. In effect we look for convergence
1044 in the two-point @AbsTop@/@AbsBot@ domain.
1046 What we miss (compared with the cleverer strictness analysis) is
1047 spotting that in this case
1049 f = \ x y -> ...y...(f x y')...
1051 \tr{x} is actually absent, since it is only passed round the loop, never
1052 used. But who cares about missing that?
1054 NB: despite only having a two-point domain, we may still have many
1055 iterations, because there are several variables involved at once.