2 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
4 \section[SaAbsInt]{Abstract interpreter for strictness analysis}
9 findDemand, findDemandAlts,
16 #include "HsVersions.h"
18 import CmdLineOpts ( opt_AllStrict, opt_NumbersStrict )
20 import CoreUnfold ( Unfolding(..) )
21 import Id ( Id, idType, getIdStrictness, getIdUnfolding )
22 import Const ( Con(..) )
23 import DataCon ( dataConTyCon, dataConArgTys )
24 import IdInfo ( StrictnessInfo(..) )
25 import Demand ( Demand(..), wwPrim, wwStrict, wwEnum, wwUnpackData,
28 import TyCon ( isProductTyCon, isEnumerationTyCon, isNewTyCon )
29 import BasicTypes ( NewOrData(..) )
30 import Type ( splitAlgTyConApp_maybe,
31 isUnLiftedType, Type )
32 import TyCon ( tyConUnique )
33 import PrelInfo ( numericTyKeys )
34 import Util ( isIn, nOfThem, zipWithEqual )
37 returnsRealWorld x = False -- ToDo: panic "SaAbsInt.returnsRealWorld (ToDo)"
40 %************************************************************************
42 \subsection[AbsVal-ops]{Operations on @AbsVals@}
44 %************************************************************************
46 Least upper bound, greatest lower bound.
49 lub, glb :: AbsVal -> AbsVal -> AbsVal
51 lub val1 val2 | isBot val1 = val2 -- The isBot test includes the case where
52 lub val1 val2 | isBot val2 = val1 -- one of the val's is a function which
53 -- always returns bottom, such as \y.x,
54 -- when x is bound to bottom.
56 lub (AbsProd xs) (AbsProd ys) = AbsProd (zipWithEqual "lub" lub xs ys)
58 lub _ _ = AbsTop -- Crude, but conservative
59 -- The crudity only shows up if there
60 -- are functions involved
62 -- Slightly funny glb; for absence analysis only;
63 -- AbsBot is the safe answer.
65 -- Using anyBot rather than just testing for AbsBot is important.
70 -- g = \x y z -> case x of
74 -- Now, the abstract value of the branches of the case will be an
75 -- AbsFun, but when testing for z's absence we want to spot that it's
76 -- an AbsFun which can't possibly return AbsBot. So when glb'ing we
77 -- mustn't be too keen to bale out and return AbsBot; the anyBot test
78 -- spots that (f x) can't possibly return AbsBot.
80 -- We have also tripped over the following interesting case:
85 -- Now, suppose f is bound to AbsTop. Does this expression mention z?
86 -- Obviously not. But the case will take the glb of AbsTop (for f) and
87 -- an AbsFun (for \y->1). We should not bale out and give AbsBot, because
88 -- that would say that it *does* mention z (or anything else for that matter).
89 -- Nor can we always return AbsTop, because the AbsFun might be something
90 -- like (\y->z), which obviously does mention z. The point is that we're
91 -- glbing two functions, and AbsTop is not actually the top of the function
92 -- lattice. It is more like (\xyz -> x|y|z); that is, AbsTop returns
93 -- poison iff any of its arguments do.
95 -- Deal with functions specially, because AbsTop isn't the
96 -- top of their domain.
99 | is_fun v1 || is_fun v2
100 = if not (anyBot v1) && not (anyBot v2)
106 is_fun (AbsFun _ _ _) = True
107 is_fun (AbsApproxFun _ _) = True -- Not used, but the glb works ok
110 -- The non-functional cases are quite straightforward
112 glb (AbsProd xs) (AbsProd ys) = AbsProd (zipWithEqual "glb" glb xs ys)
117 glb _ _ = AbsBot -- Be pessimistic
120 @isBot@ returns True if its argument is (a representation of) bottom. The
121 ``representation'' part is because we need to detect the bottom {\em function}
122 too. To detect the bottom function, bind its args to top, and see if it
125 Used only in strictness analysis:
127 isBot :: AbsVal -> Bool
130 isBot other = False -- Functions aren't bottom any more
134 Used only in absence analysis:
136 anyBot :: AbsVal -> Bool
138 anyBot AbsBot = True -- poisoned!
139 anyBot AbsTop = False
140 anyBot (AbsProd vals) = any anyBot vals
141 anyBot (AbsFun bndr body env) = anyBot (absEval AbsAnal body (addOneToAbsValEnv env bndr AbsTop))
142 anyBot (AbsApproxFun _ val) = anyBot val
145 @widen@ takes an @AbsVal@, $val$, and returns and @AbsVal@ which is
146 approximated by $val$. Furthermore, the result has no @AbsFun@s in
147 it, so it can be compared for equality by @sameVal@.
150 widen :: AnalysisKind -> AbsVal -> AbsVal
152 -- Widening is complicated by the fact that funtions are lifted
153 widen StrAnal the_fn@(AbsFun bndr body env)
154 = case widened_body of
155 AbsApproxFun ds val -> AbsApproxFun (d : ds) val
157 d = findRecDemand str_fn abs_fn bndr_ty
158 str_fn val = foldl (absApply StrAnal) the_fn
159 (val : [AbsTop | d <- ds])
161 other -> AbsApproxFun [d] widened_body
163 d = findRecDemand str_fn abs_fn bndr_ty
164 str_fn val = absApply StrAnal the_fn val
166 bndr_ty = idType bndr
167 widened_body = widen StrAnal (absApply StrAnal the_fn AbsTop)
168 abs_fn val = AbsBot -- Always says poison; so it looks as if
169 -- nothing is absent; safe
172 This stuff is now instead handled neatly by the fact that AbsApproxFun
173 contains an AbsVal inside it. SLPJ Jan 97
175 | isBot abs_body = AbsBot
176 -- It's worth checking for a function which is unconditionally
179 -- f x y = let g y = case x of ...
180 -- in (g ..) + (g ..)
182 -- Here, when we are considering strictness of f in x, we'll
183 -- evaluate the body of f with x bound to bottom. The current
184 -- strategy is to bind g to its *widened* value; without the isBot
185 -- (...) test above, we'd bind g to an AbsApproxFun, and deliver
186 -- Top, not Bot as the value of f's rhs. The test spots the
187 -- unconditional bottom-ness of g when x is bottom. (Another
188 -- alternative here would be to bind g to its exact abstract
189 -- value, but that entails lots of potential re-computation, at
190 -- every application of g.)
193 widen StrAnal (AbsProd vals) = AbsProd (map (widen StrAnal) vals)
194 widen StrAnal other_val = other_val
197 widen AbsAnal the_fn@(AbsFun bndr body env)
198 | anyBot widened_body = AbsBot
199 -- In the absence-analysis case it's *essential* to check
200 -- that the function has no poison in its body. If it does,
201 -- anywhere, then the whole function is poisonous.
204 = case widened_body of
205 AbsApproxFun ds val -> AbsApproxFun (d : ds) val
207 d = findRecDemand str_fn abs_fn bndr_ty
208 abs_fn val = foldl (absApply AbsAnal) the_fn
209 (val : [AbsTop | d <- ds])
211 other -> AbsApproxFun [d] widened_body
213 d = findRecDemand str_fn abs_fn bndr_ty
214 abs_fn val = absApply AbsAnal the_fn val
216 bndr_ty = idType bndr
217 widened_body = widen AbsAnal (absApply AbsAnal the_fn AbsTop)
218 str_fn val = AbsBot -- Always says non-termination;
219 -- that'll make findRecDemand peer into the
220 -- structure of the value.
222 widen AbsAnal (AbsProd vals) = AbsProd (map (widen AbsAnal) vals)
224 -- It's desirable to do a good job of widening for product
228 -- in ...(case p of (x,y) -> x)...
230 -- Now, is y absent in this expression? Currently the
231 -- analyser widens p before looking at p's scope, to avoid
232 -- lots of recomputation in the case where p is a function.
233 -- So if widening doesn't have a case for products, we'll
234 -- widen p to AbsBot (since when searching for absence in y we
235 -- bind y to poison ie AbsBot), and now we are lost.
237 widen AbsAnal other_val = other_val
239 -- WAS: if anyBot val then AbsBot else AbsTop
240 -- Nowadays widen is doing a better job on functions for absence analysis.
243 @crudeAbsWiden@ is used just for absence analysis, and always
244 returns AbsTop or AbsBot, so it widens to a two-point domain
247 crudeAbsWiden :: AbsVal -> AbsVal
248 crudeAbsWiden val = if anyBot val then AbsBot else AbsTop
251 @sameVal@ compares two abstract values for equality. It can't deal with
252 @AbsFun@, but that should have been removed earlier in the day by @widen@.
255 sameVal :: AbsVal -> AbsVal -> Bool -- Can't handle AbsFun!
258 sameVal (AbsFun _ _ _) _ = panic "sameVal: AbsFun: arg1"
259 sameVal _ (AbsFun _ _ _) = panic "sameVal: AbsFun: arg2"
262 sameVal AbsBot AbsBot = True
263 sameVal AbsBot other = False -- widen has reduced AbsFun bots to AbsBot
265 sameVal AbsTop AbsTop = True
266 sameVal AbsTop other = False -- Right?
268 sameVal (AbsProd vals1) (AbsProd vals2) = and (zipWithEqual "sameVal" sameVal vals1 vals2)
269 sameVal (AbsProd _) AbsTop = False
270 sameVal (AbsProd _) AbsBot = False
272 sameVal (AbsApproxFun str1 v1) (AbsApproxFun str2 v2) = str1 == str2 && sameVal v1 v2
273 sameVal (AbsApproxFun _ _) AbsTop = False
274 sameVal (AbsApproxFun _ _) AbsBot = False
276 sameVal val1 val2 = panic "sameVal: type mismatch or AbsFun encountered"
280 @evalStrictness@ compares a @Demand@ with an abstract value, returning
281 @True@ iff the abstract value is {\em less defined} than the demand.
282 (@True@ is the exciting answer; @False@ is always safe.)
285 evalStrictness :: Demand
287 -> Bool -- True iff the value is sure
288 -- to be less defined than the Demand
290 evalStrictness (WwLazy _) _ = False
291 evalStrictness WwStrict val = isBot val
292 evalStrictness WwEnum val = isBot val
294 evalStrictness (WwUnpack NewType _ (demand:_)) val
295 = evalStrictness demand val
297 evalStrictness (WwUnpack DataType _ demand_info) val
301 AbsProd vals -> or (zipWithEqual "evalStrictness" evalStrictness demand_info vals)
302 _ -> pprTrace "evalStrictness?" empty False
304 evalStrictness WwPrim val
307 AbsBot -> True -- Can happen: consider f (g x), where g is a
308 -- recursive function returning an Int# that diverges
310 other -> pprPanic "evalStrictness: WwPrim:" (ppr other)
313 For absence analysis, we're interested in whether "poison" in the
314 argument (ie a bottom therein) can propagate to the result of the
315 function call; that is, whether the specified demand can {\em
316 possibly} hit poison.
319 evalAbsence (WwLazy True) _ = False -- Can't possibly hit poison
320 -- with Absent demand
322 evalAbsence (WwUnpack NewType _ (demand:_)) val
323 = evalAbsence demand val
325 evalAbsence (WwUnpack DataType _ demand_info) val
327 AbsTop -> False -- No poison in here
328 AbsBot -> True -- Pure poison
329 AbsProd vals -> or (zipWithEqual "evalAbsence" evalAbsence demand_info vals)
330 _ -> panic "evalAbsence: other"
332 evalAbsence other val = anyBot val
333 -- The demand is conservative; even "Lazy" *might* evaluate the
334 -- argument arbitrarily so we have to look everywhere for poison
337 %************************************************************************
339 \subsection[absEval]{Evaluate an expression in the abstract domain}
341 %************************************************************************
344 -- The isBottomingId stuf is now dealt with via the Id's strictness info
345 -- absId anal var env | isBottomingId var
347 -- StrAnal -> AbsBot -- See discussion below
348 -- AbsAnal -> AbsTop -- Just want to see if there's any poison in
352 = case (lookupAbsValEnv env var, getIdStrictness var, getIdUnfolding var) of
354 (Just abs_val, _, _) ->
355 abs_val -- Bound in the environment
357 (Nothing, NoStrictnessInfo, CoreUnfolding _ _ unfolding) ->
358 -- We have an unfolding for the expr
359 -- Assume the unfolding has no free variables since it
360 -- came from inside the Id
361 absEval anal unfolding env
362 -- Notice here that we only look in the unfolding if we don't
363 -- have strictness info (an unusual situation).
364 -- We could have chosen to look in the unfolding if it exists,
365 -- and only try the strictness info if it doesn't, and that would
366 -- give more accurate results, at the cost of re-abstract-interpreting
367 -- the unfolding every time.
368 -- We found only one place where the look-at-unfolding-first
369 -- method gave better results, which is in the definition of
370 -- showInt in the Prelude. In its defintion, fromIntegral is
371 -- not inlined (it's big) but ab-interp-ing its unfolding gave
372 -- a better result than looking at its strictness only.
373 -- showInt :: Integral a => a -> [Char] -> [Char]
374 -- ! {-# GHC_PRAGMA _A_ 1 _U_ 122 _S_
375 -- "U(U(U(U(SA)AAAAAAAAL)AA)AAAAASAAASA)" {...} _N_ _N_ #-}
377 -- showInt :: Integral a => a -> [Char] -> [Char]
378 -- ! {-# GHC_PRAGMA _A_ 1 _U_ 122 _S_
379 -- "U(U(U(U(SL)LLLLLLLLL)LL)LLLLLSLLLLL)" _N_ _N_ #-}
382 (Nothing, strictness_info, _) ->
383 -- Includes MagicUnfolding, NoUnfolding
384 -- Try the strictness info
385 absValFromStrictness anal strictness_info
389 absEval :: AnalysisKind -> CoreExpr -> AbsValEnv -> AbsVal
391 absEval anal (Type ty) env = AbsTop
392 absEval anal (Var var) env = absId anal var env
395 Discussion about error (following/quoting Lennart): Any expression
396 'error e' is regarded as bottom (with HBC, with the -ffail-strict
399 Regarding it as bottom gives much better strictness properties for
403 f (x:xs) y = f xs (x+y)
405 f [] _ = error "no match"
407 f (x:xs) y = f xs (x+y)
409 is strict in y, which you really want. But, it may lead to
410 transformations that turn a call to \tr{error} into non-termination.
411 (The odds of this happening aren't good.)
413 Things are a little different for absence analysis, because we want
414 to make sure that any poison (?????)
417 absEval anal (Con (Literal _) args) env
418 = -- Literals terminate (strictness) and are not poison (absence)
421 absEval anal (Con (PrimOp _) args) env
422 = -- PrimOps evaluate all their arguments
423 if any (what_bot anal) [absEval anal arg env | arg <- args]
427 what_bot StrAnal = isBot -- Primops are strict
428 what_bot AbsAnal = anyBot -- Look for poison anywhere
430 absEval anal (Con (DataCon con) args) env
431 | isProductTyCon (dataConTyCon con)
432 = -- Products; filter out type arguments
433 AbsProd [absEval anal a env | a <- args, isValArg a]
435 | otherwise -- Not single-constructor
437 StrAnal -> -- Strictness case: it's easy: it certainly terminates
439 AbsAnal -> -- In the absence case we need to be more
440 -- careful: look to see if there's any
441 -- poison in the components
442 if any anyBot [absEval AbsAnal arg env | arg <- args]
448 absEval anal (Lam bndr body) env
449 | isTyVar bndr = absEval anal body env -- Type lambda
450 | otherwise = AbsFun bndr body env -- Value lambda
452 absEval anal (App expr (Type ty)) env
453 = absEval anal expr env -- Type appplication
454 absEval anal (App f val_arg) env
455 = absApply anal (absEval anal f env) -- Value applicationn
456 (absEval anal val_arg env)
460 absEval anal expr@(Case scrut case_bndr alts) env
462 scrut_val = absEval anal scrut env
463 alts_env = addOneToAbsValEnv env case_bndr scrut_val
465 case (scrut_val, alts) of
466 (AbsBot, _) -> AbsBot
468 (AbsProd arg_vals, [(con, bndrs, rhs)])
470 -- The scrutinee is a product value, so it must be of a single-constr
471 -- type; so the constructor in this alternative must be the right one
472 -- so we can go ahead and bind the constructor args to the components
473 -- of the product value.
474 ASSERT(length arg_vals == length val_bndrs)
475 absEval anal rhs rhs_env
477 val_bndrs = filter isId bndrs
478 rhs_env = growAbsValEnvList alts_env (val_bndrs `zip` arg_vals)
480 other -> absEvalAlts anal alts alts_env
483 For @Lets@ we widen the value we get. This is nothing to
484 do with fixpointing. The reason is so that we don't get an explosion
485 in the amount of computation. For example, consider:
497 If we bind @f@ and @g@ to their exact abstract value, then we'll
498 ``execute'' one call to @f@ and {\em two} calls to @g@. This can blow
499 up exponentially. Widening cuts it off by making a fixed
500 approximation to @f@ and @g@, so that the bodies of @f@ and @g@ are
501 not evaluated again at all when they are called.
503 Of course, this can lose useful joint strictness, which is sad. An
504 alternative approach would be to try with a certain amount of ``fuel''
505 and be prepared to bale out.
508 absEval anal (Let (NonRec binder e1) e2) env
510 new_env = addOneToAbsValEnv env binder (widen anal (absEval anal e1 env))
512 -- The binder of a NonRec should *not* be of unboxed type,
513 -- hence no need to strictly evaluate the Rhs.
514 absEval anal e2 new_env
516 absEval anal (Let (Rec pairs) body) env
518 (binders,rhss) = unzip pairs
519 rhs_vals = cheapFixpoint anal binders rhss env -- Returns widened values
520 new_env = growAbsValEnvList env (binders `zip` rhs_vals)
522 absEval anal body new_env
524 absEval anal (Note note expr) env = absEval anal expr env
528 absEvalAlts :: AnalysisKind -> [CoreAlt] -> AbsValEnv -> AbsVal
529 absEvalAlts anal alts env
530 = combine anal (map go alts)
532 combine StrAnal = foldr1 lub -- Diverge only if all diverge
533 combine AbsAnal = foldr1 glb -- Find any poison
536 = absEval anal rhs rhs_env
538 rhs_env = growAbsValEnvList env (filter isId bndrs `zip` repeat AbsTop)
541 %************************************************************************
543 \subsection[absApply]{Apply an abstract function to an abstract argument}
545 %************************************************************************
550 absApply :: AnalysisKind -> AbsVal -> AbsVal -> AbsVal
552 absApply anal AbsBot arg = AbsBot
553 -- AbsBot represents the abstract bottom *function* too
555 absApply StrAnal AbsTop arg = AbsTop
556 absApply AbsAnal AbsTop arg = if anyBot arg
559 -- To be conservative, we have to assume that a function about
560 -- which we know nothing (AbsTop) might look at some part of
564 An @AbsFun@ with only one more argument needed---bind it and eval the
565 result. A @Lam@ with two or more args: return another @AbsFun@ with
566 an augmented environment.
569 absApply anal (AbsFun binder body env) arg
570 = absEval anal body (addOneToAbsValEnv env binder arg)
574 absApply StrAnal (AbsApproxFun (d:ds) val) arg
577 other -> AbsApproxFun ds val' -- Result is non-bot if there are still args
579 val' | evalStrictness d arg = AbsBot
582 absApply AbsAnal (AbsApproxFun (d:ds) val) arg
583 = if evalAbsence d arg
584 then AbsBot -- Poison in arg means poison in the application
587 other -> AbsApproxFun ds val
590 absApply anal f@(AbsProd _) arg = pprPanic ("absApply: Duff function: AbsProd." ++ show anal) ((ppr f) <+> (ppr arg))
597 %************************************************************************
599 \subsection[findStrictness]{Determine some binders' strictness}
601 %************************************************************************
603 @findStrictness@ applies the function \tr{\ ids -> expr} to
604 \tr{[bot,top,top,...]}, \tr{[top,bot,top,top,...]}, etc., (i.e., once
605 with @AbsBot@ in each argument position), and evaluates the resulting
606 abstract value; it returns a vector of @Demand@s saying whether the
607 result of doing this is guaranteed to be bottom. This tells the
608 strictness of the function in each of the arguments.
610 If an argument is of unboxed type, then we declare that function to be
611 strict in that argument.
613 We don't really have to make up all those lists of mostly-@AbsTops@;
614 unbound variables in an @AbsValEnv@ are implicitly mapped to that.
616 See notes on @addStrictnessInfoToId@.
619 findStrictness :: [Type] -- Types of args in which strictness is wanted
620 -> AbsVal -- Abstract strictness value of function
621 -> AbsVal -- Abstract absence value of function
622 -> ([Demand], Bool) -- Resulting strictness annotation
624 findStrictness tys str_val abs_val
625 = (map find_str tys_w_index, isBot (foldl (absApply StrAnal) str_val all_tops))
627 tys_w_index = tys `zip` [1..]
629 find_str (ty,n) = findRecDemand str_fn abs_fn ty
631 str_fn val = foldl (absApply StrAnal) str_val
632 (map (mk_arg val n) tys_w_index)
634 abs_fn val = foldl (absApply AbsAnal) abs_val
635 (map (mk_arg val n) tys_w_index)
637 mk_arg val n (_,m) | m==n = val
640 all_tops = [AbsTop | _ <- tys]
645 findDemand str_env abs_env expr binder
646 = findRecDemand str_fn abs_fn (idType binder)
648 str_fn val = absEval StrAnal expr (addOneToAbsValEnv str_env binder val)
649 abs_fn val = absEval AbsAnal expr (addOneToAbsValEnv abs_env binder val)
651 findDemandAlts str_env abs_env alts binder
652 = findRecDemand str_fn abs_fn (idType binder)
654 str_fn val = absEvalAlts StrAnal alts (addOneToAbsValEnv str_env binder val)
655 abs_fn val = absEvalAlts AbsAnal alts (addOneToAbsValEnv abs_env binder val)
658 @findRecDemand@ is where we finally convert strictness/absence info
659 into ``Demands'' which we can pin on Ids (etc.).
661 NOTE: What do we do if something is {\em both} strict and absent?
662 Should \tr{f x y z = error "foo"} says that \tr{f}'s arguments are all
663 strict (because of bottoming effect of \tr{error}) or all absent
664 (because they're not used)?
666 Well, for practical reasons, we prefer absence over strictness. In
667 particular, it makes the ``default defaults'' for class methods (the
668 ones that say \tr{defm.foo dict = error "I don't exist"}) come out
669 nicely [saying ``the dict isn't used''], rather than saying it is
670 strict in every component of the dictionary [massive gratuitious
671 casing to take the dict apart].
673 But you could have examples where going for strictness would be better
674 than absence. Consider:
676 let x = something big
681 If \tr{x} is marked absent in \tr{f}, but not strict, and \tr{g} is
682 lazy, then the thunk for \tr{x} will be built. If \tr{f} was strict,
683 then we'd let-to-case it:
685 case something big of
691 findRecDemand :: (AbsVal -> AbsVal) -- The strictness function
692 -> (AbsVal -> AbsVal) -- The absence function
693 -> Type -- The type of the argument
696 findRecDemand str_fn abs_fn ty
697 = if isUnLiftedType ty then -- It's a primitive type!
700 else if not (anyBot (abs_fn AbsBot)) then -- It's absent
701 -- We prefer absence over strictness: see NOTE above.
704 else if not (opt_AllStrict ||
705 (opt_NumbersStrict && is_numeric_type ty) ||
706 (isBot (str_fn AbsBot))) then
707 WwLazy False -- It's not strict and we're not pretending
709 else -- It's strict (or we're pretending it is)!
711 case (splitAlgTyConApp_maybe ty) of
715 Just (tycon,tycon_arg_tys,[data_con]) | isProductTyCon tycon ->
716 -- Non-recursive, single constructor case
718 cmpnt_tys = dataConArgTys data_con tycon_arg_tys
719 prod_len = length cmpnt_tys
722 if isNewTyCon tycon then -- A newtype!
723 ASSERT( null (tail cmpnt_tys) )
725 demand = findRecDemand str_fn abs_fn (head cmpnt_tys)
733 str_fn (mkMainlyTopProd prod_len i cmpnt_val)
736 abs_fn (mkMainlyTopProd prod_len i cmpnt_val)
739 | (cmpnt_ty, i) <- cmpnt_tys `zip` [1..] ]
741 if null compt_strict_infos then
742 if isEnumerationTyCon tycon then wwEnum else wwStrict
744 wwUnpackData compt_strict_infos
747 -- Multi-constr data types, *or* an abstract data
748 -- types, *or* things we don't have a way of conveying
749 -- the info over module boundaries (class ops,
750 -- superdict sels, dfns).
751 if isEnumerationTyCon tycon then
757 = case (splitAlgTyConApp_maybe ty) of -- NB: duplicates stuff done above
760 | tyConUnique tycon `is_elem` numericTyKeys
762 _{-something else-} -> False
764 is_elem = isIn "is_numeric_type"
766 -- mkMainlyTopProd: make an AbsProd that is all AbsTops ("n"-1 of
767 -- them) except for a given value in the "i"th position.
769 mkMainlyTopProd :: Int -> Int -> AbsVal -> AbsVal
771 mkMainlyTopProd n i val
773 befores = nOfThem (i-1) AbsTop
774 afters = nOfThem (n-i) AbsTop
776 AbsProd (befores ++ (val : afters))
779 %************************************************************************
781 \subsection[fixpoint]{Fixpointer for the strictness analyser}
783 %************************************************************************
785 The @fixpoint@ functions take a list of \tr{(binder, expr)} pairs, an
786 environment, and returns the abstract value of each binder.
788 The @cheapFixpoint@ function makes a conservative approximation,
789 by binding each of the variables to Top in their own right hand sides.
790 That allows us to make rapid progress, at the cost of a less-than-wonderful
794 cheapFixpoint :: AnalysisKind -> [Id] -> [CoreExpr] -> AbsValEnv -> [AbsVal]
796 cheapFixpoint AbsAnal [id] [rhs] env
797 = [crudeAbsWiden (absEval AbsAnal rhs new_env)]
799 new_env = addOneToAbsValEnv env id AbsTop -- Unsafe starting point!
800 -- In the just-one-binding case, we guarantee to
801 -- find a fixed point in just one iteration,
802 -- because we are using only a two-point domain.
803 -- This improves matters in cases like:
805 -- f x y = letrec g = ...g...
808 -- Here, y isn't used at all, but if g is bound to
809 -- AbsBot we simply get AbsBot as the next
812 cheapFixpoint anal ids rhss env
813 = [widen anal (absEval anal rhs new_env) | rhs <- rhss]
814 -- We do just one iteration, starting from a safe
815 -- approximation. This won't do a good job in situations
817 -- \x -> letrec f = ...g...
821 -- Here, f will end up bound to Top after one iteration,
822 -- and hence we won't spot the strictness in x.
823 -- (A second iteration would solve this. ToDo: try the effect of
824 -- really searching for a fixed point.)
826 new_env = growAbsValEnvList env [(id,safe_val) | id <- ids]
829 = case anal of -- The safe starting point
835 mkLookupFun :: (key -> key -> Bool) -- Equality predicate
836 -> (key -> key -> Bool) -- Less-than predicate
837 -> [(key,val)] -- The assoc list
839 -> Maybe val -- The corresponding value
841 mkLookupFun eq lt alist s
842 = case [a | (s',a) <- alist, s' `eq` s] of
848 fixpoint :: AnalysisKind -> [Id] -> [CoreExpr] -> AbsValEnv -> [AbsVal]
850 fixpoint anal [] _ env = []
852 fixpoint anal ids rhss env
853 = fix_loop initial_vals
856 = case anal of -- The (unsafe) starting point
857 StrAnal -> if (returnsRealWorld (idType id))
858 then AbsTop -- this is a massively horrible hack (SLPJ 95/05)
862 initial_vals = [ initial_val id | id <- ids ]
864 fix_loop :: [AbsVal] -> [AbsVal]
866 fix_loop current_widened_vals
868 new_env = growAbsValEnvList env (ids `zip` current_widened_vals)
869 new_vals = [ absEval anal rhs new_env | rhs <- rhss ]
870 new_widened_vals = map (widen anal) new_vals
872 if (and (zipWith sameVal current_widened_vals new_widened_vals)) then
875 -- NB: I was too chicken to make that a zipWithEqual,
876 -- lest I jump into a black hole. WDP 96/02
878 -- Return the widened values. We might get a slightly
879 -- better value by returning new_vals (which we used to
880 -- do, see below), but alas that means that whenever the
881 -- function is called we have to re-execute it, which is
886 -- Return the un-widened values which may be a bit better
887 -- than the widened ones, and are guaranteed safe, since
888 -- they are one iteration beyond current_widened_vals,
889 -- which itself is a fixed point.
891 fix_loop new_widened_vals
894 For absence analysis, we make do with a very very simple approach:
895 look for convergence in a two-point domain.
897 We used to use just one iteration, starting with the variables bound
898 to @AbsBot@, which is safe.
900 Prior to that, we used one iteration starting from @AbsTop@ (which
901 isn't safe). Why isn't @AbsTop@ safe? Consider:
909 Here, if p is @AbsBot@, then we'd better {\em not} end up with a ``fixed
910 point'' of @d@ being @(AbsTop, AbsTop)@! An @AbsBot@ initial value is
911 safe because it gives poison more often than really necessary, and
912 thus may miss some absence, but will never claim absence when it ain't
915 Anyway, one iteration starting with everything bound to @AbsBot@ give
920 Here, f would always end up bound to @AbsBot@, which ain't very
921 clever, because then it would introduce poison whenever it was
922 applied. Much better to start with f bound to @AbsTop@, and widen it
923 to @AbsBot@ if any poison shows up. In effect we look for convergence
924 in the two-point @AbsTop@/@AbsBot@ domain.
926 What we miss (compared with the cleverer strictness analysis) is
927 spotting that in this case
929 f = \ x y -> ...y...(f x y')...
931 \tr{x} is actually absent, since it is only passed round the loop, never
932 used. But who cares about missing that?
934 NB: despite only having a two-point domain, we may still have many
935 iterations, because there are several variables involved at once.