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 ( maybeUnfoldingTemplate )
21 import Id ( Id, idType, idStrictness, idUnfolding, isDataConId_maybe )
22 import DataCon ( dataConTyCon, splitProductType_maybe, dataConRepArgTys )
23 import IdInfo ( StrictnessInfo(..) )
24 import Demand ( Demand(..), wwPrim, wwStrict, wwUnpackData, wwLazy, wwUnpackNew,
25 mkStrictnessInfo, isLazy
28 import TyCon ( isProductTyCon, isRecursiveTyCon, isNewTyCon )
29 import BasicTypes ( NewOrData(..) )
30 import Type ( splitTyConApp_maybe,
31 isUnLiftedType, Type )
32 import TyCon ( tyConUnique )
33 import PrelInfo ( numericTyKeys )
34 import Util ( isIn, nOfThem, zipWithEqual )
38 %************************************************************************
40 \subsection[AbsVal-ops]{Operations on @AbsVals@}
42 %************************************************************************
44 Least upper bound, greatest lower bound.
47 lub, glb :: AbsVal -> AbsVal -> AbsVal
49 lub AbsBot val2 = val2
50 lub val1 AbsBot = val1
52 lub (AbsProd xs) (AbsProd ys) = AbsProd (zipWithEqual "lub" lub xs ys)
54 lub _ _ = AbsTop -- Crude, but conservative
55 -- The crudity only shows up if there
56 -- are functions involved
58 -- Slightly funny glb; for absence analysis only;
59 -- AbsBot is the safe answer.
61 -- Using anyBot rather than just testing for AbsBot is important.
66 -- g = \x y z -> case x of
70 -- Now, the abstract value of the branches of the case will be an
71 -- AbsFun, but when testing for z's absence we want to spot that it's
72 -- an AbsFun which can't possibly return AbsBot. So when glb'ing we
73 -- mustn't be too keen to bale out and return AbsBot; the anyBot test
74 -- spots that (f x) can't possibly return AbsBot.
76 -- We have also tripped over the following interesting case:
81 -- Now, suppose f is bound to AbsTop. Does this expression mention z?
82 -- Obviously not. But the case will take the glb of AbsTop (for f) and
83 -- an AbsFun (for \y->1). We should not bale out and give AbsBot, because
84 -- that would say that it *does* mention z (or anything else for that matter).
85 -- Nor can we always return AbsTop, because the AbsFun might be something
86 -- like (\y->z), which obviously does mention z. The point is that we're
87 -- glbing two functions, and AbsTop is not actually the top of the function
88 -- lattice. It is more like (\xyz -> x|y|z); that is, AbsTop returns
89 -- poison iff any of its arguments do.
91 -- Deal with functions specially, because AbsTop isn't the
92 -- top of their domain.
95 | is_fun v1 || is_fun v2
96 = if not (anyBot v1) && not (anyBot v2)
102 is_fun (AbsFun _ _) = True
103 is_fun (AbsApproxFun _ _) = True -- Not used, but the glb works ok
106 -- The non-functional cases are quite straightforward
108 glb (AbsProd xs) (AbsProd ys) = AbsProd (zipWithEqual "glb" glb xs ys)
113 glb _ _ = AbsBot -- Be pessimistic
116 @isBot@ returns True if its argument is (a representation of) bottom. The
117 ``representation'' part is because we need to detect the bottom {\em function}
118 too. To detect the bottom function, bind its args to top, and see if it
121 Used only in strictness analysis:
123 isBot :: AbsVal -> Bool
126 isBot other = False -- Functions aren't bottom any more
129 Used only in absence analysis:
132 anyBot :: AbsVal -> Bool
134 anyBot AbsBot = True -- poisoned!
135 anyBot AbsTop = False
136 anyBot (AbsProd vals) = any anyBot vals
137 anyBot (AbsFun bndr_ty abs_fn) = anyBot (abs_fn AbsTop)
138 anyBot (AbsApproxFun _ val) = anyBot val
141 @widen@ takes an @AbsVal@, $val$, and returns and @AbsVal@ which is
142 approximated by $val$. Furthermore, the result has no @AbsFun@s in
143 it, so it can be compared for equality by @sameVal@.
146 widen :: AnalysisKind -> AbsVal -> AbsVal
148 -- Widening is complicated by the fact that funtions are lifted
149 widen StrAnal the_fn@(AbsFun bndr_ty _)
150 = case widened_body of
151 AbsApproxFun ds val -> AbsApproxFun (d : ds) val
153 d = findRecDemand str_fn abs_fn bndr_ty
154 str_fn val = isBot (foldl (absApply StrAnal) the_fn
155 (val : [AbsTop | d <- ds]))
157 other -> AbsApproxFun [d] widened_body
159 d = findRecDemand str_fn abs_fn bndr_ty
160 str_fn val = isBot (absApply StrAnal the_fn val)
162 widened_body = widen StrAnal (absApply StrAnal the_fn AbsTop)
163 abs_fn val = False -- Always says poison; so it looks as if
164 -- nothing is absent; safe
167 This stuff is now instead handled neatly by the fact that AbsApproxFun
168 contains an AbsVal inside it. SLPJ Jan 97
170 | isBot abs_body = AbsBot
171 -- It's worth checking for a function which is unconditionally
174 -- f x y = let g y = case x of ...
175 -- in (g ..) + (g ..)
177 -- Here, when we are considering strictness of f in x, we'll
178 -- evaluate the body of f with x bound to bottom. The current
179 -- strategy is to bind g to its *widened* value; without the isBot
180 -- (...) test above, we'd bind g to an AbsApproxFun, and deliver
181 -- Top, not Bot as the value of f's rhs. The test spots the
182 -- unconditional bottom-ness of g when x is bottom. (Another
183 -- alternative here would be to bind g to its exact abstract
184 -- value, but that entails lots of potential re-computation, at
185 -- every application of g.)
188 widen StrAnal (AbsProd vals) = AbsProd (map (widen StrAnal) vals)
189 widen StrAnal other_val = other_val
192 widen AbsAnal the_fn@(AbsFun bndr_ty _)
193 | anyBot widened_body = AbsBot
194 -- In the absence-analysis case it's *essential* to check
195 -- that the function has no poison in its body. If it does,
196 -- anywhere, then the whole function is poisonous.
199 = case widened_body of
200 AbsApproxFun ds val -> AbsApproxFun (d : ds) val
202 d = findRecDemand str_fn abs_fn bndr_ty
203 abs_fn val = not (anyBot (foldl (absApply AbsAnal) the_fn
204 (val : [AbsTop | d <- ds])))
206 other -> AbsApproxFun [d] widened_body
208 d = findRecDemand str_fn abs_fn bndr_ty
209 abs_fn val = not (anyBot (absApply AbsAnal the_fn val))
211 widened_body = widen AbsAnal (absApply AbsAnal the_fn AbsTop)
212 str_fn val = True -- Always says non-termination;
213 -- that'll make findRecDemand peer into the
214 -- structure of the value.
216 widen AbsAnal (AbsProd vals) = AbsProd (map (widen AbsAnal) vals)
218 -- It's desirable to do a good job of widening for product
222 -- in ...(case p of (x,y) -> x)...
224 -- Now, is y absent in this expression? Currently the
225 -- analyser widens p before looking at p's scope, to avoid
226 -- lots of recomputation in the case where p is a function.
227 -- So if widening doesn't have a case for products, we'll
228 -- widen p to AbsBot (since when searching for absence in y we
229 -- bind y to poison ie AbsBot), and now we are lost.
231 widen AbsAnal other_val = other_val
233 -- WAS: if anyBot val then AbsBot else AbsTop
234 -- Nowadays widen is doing a better job on functions for absence analysis.
237 @crudeAbsWiden@ is used just for absence analysis, and always
238 returns AbsTop or AbsBot, so it widens to a two-point domain
241 crudeAbsWiden :: AbsVal -> AbsVal
242 crudeAbsWiden val = if anyBot val then AbsBot else AbsTop
245 @sameVal@ compares two abstract values for equality. It can't deal with
246 @AbsFun@, but that should have been removed earlier in the day by @widen@.
249 sameVal :: AbsVal -> AbsVal -> Bool -- Can't handle AbsFun!
252 sameVal (AbsFun _ _) _ = panic "sameVal: AbsFun: arg1"
253 sameVal _ (AbsFun _ _) = panic "sameVal: AbsFun: arg2"
256 sameVal AbsBot AbsBot = True
257 sameVal AbsBot other = False -- widen has reduced AbsFun bots to AbsBot
259 sameVal AbsTop AbsTop = True
260 sameVal AbsTop other = False -- Right?
262 sameVal (AbsProd vals1) (AbsProd vals2) = and (zipWithEqual "sameVal" sameVal vals1 vals2)
263 sameVal (AbsProd _) AbsTop = False
264 sameVal (AbsProd _) AbsBot = False
266 sameVal (AbsApproxFun str1 v1) (AbsApproxFun str2 v2) = str1 == str2 && sameVal v1 v2
267 sameVal (AbsApproxFun _ _) AbsTop = False
268 sameVal (AbsApproxFun _ _) AbsBot = False
270 sameVal val1 val2 = panic "sameVal: type mismatch or AbsFun encountered"
274 @evalStrictness@ compares a @Demand@ with an abstract value, returning
275 @True@ iff the abstract value is {\em less defined} than the demand.
276 (@True@ is the exciting answer; @False@ is always safe.)
279 evalStrictness :: Demand
281 -> Bool -- True iff the value is sure
282 -- to be less defined than the Demand
284 evalStrictness (WwLazy _) _ = False
285 evalStrictness WwStrict val = isBot val
286 evalStrictness WwEnum val = isBot val
288 evalStrictness (WwUnpack NewType _ (demand:_)) val
289 = evalStrictness demand val
291 evalStrictness (WwUnpack DataType _ demand_info) val
295 AbsProd vals -> or (zipWithEqual "evalStrictness" evalStrictness demand_info vals)
296 _ -> pprTrace "evalStrictness?" empty False
298 evalStrictness WwPrim val
301 AbsBot -> True -- Can happen: consider f (g x), where g is a
302 -- recursive function returning an Int# that diverges
304 other -> pprPanic "evalStrictness: WwPrim:" (ppr other)
307 For absence analysis, we're interested in whether "poison" in the
308 argument (ie a bottom therein) can propagate to the result of the
309 function call; that is, whether the specified demand can {\em
310 possibly} hit poison.
313 evalAbsence (WwLazy True) _ = False -- Can't possibly hit poison
314 -- with Absent demand
316 evalAbsence (WwUnpack NewType _ (demand:_)) val
317 = evalAbsence demand val
319 evalAbsence (WwUnpack DataType _ demand_info) val
321 AbsTop -> False -- No poison in here
322 AbsBot -> True -- Pure poison
323 AbsProd vals -> or (zipWithEqual "evalAbsence" evalAbsence demand_info vals)
324 _ -> panic "evalAbsence: other"
326 evalAbsence other val = anyBot val
327 -- The demand is conservative; even "Lazy" *might* evaluate the
328 -- argument arbitrarily so we have to look everywhere for poison
331 %************************************************************************
333 \subsection[absEval]{Evaluate an expression in the abstract domain}
335 %************************************************************************
338 -- The isBottomingId stuf is now dealt with via the Id's strictness info
339 -- absId anal var env | isBottomingId var
341 -- StrAnal -> AbsBot -- See discussion below
342 -- AbsAnal -> AbsTop -- Just want to see if there's any poison in
346 = case (lookupAbsValEnv env var,
347 isDataConId_maybe var,
349 maybeUnfoldingTemplate (idUnfolding var)) of
351 (Just abs_val, _, _, _) ->
352 abs_val -- Bound in the environment
354 (_, Just data_con, _, _) | isProductTyCon tycon &&
355 not (isRecursiveTyCon tycon)
356 -> -- A product. We get infinite loops if we don't
357 -- check for recursive products!
358 -- The strictness info on the constructor
359 -- isn't expressive enough to contain its abstract value
360 productAbsVal (dataConRepArgTys data_con) []
362 tycon = dataConTyCon data_con
364 (_, _, NoStrictnessInfo, Just unfolding) ->
365 -- We have an unfolding for the expr
366 -- Assume the unfolding has no free variables since it
367 -- came from inside the Id
368 absEval anal unfolding env
369 -- Notice here that we only look in the unfolding if we don't
370 -- have strictness info (an unusual situation).
371 -- We could have chosen to look in the unfolding if it exists,
372 -- and only try the strictness info if it doesn't, and that would
373 -- give more accurate results, at the cost of re-abstract-interpreting
374 -- the unfolding every time.
375 -- We found only one place where the look-at-unfolding-first
376 -- method gave better results, which is in the definition of
377 -- showInt in the Prelude. In its defintion, fromIntegral is
378 -- not inlined (it's big) but ab-interp-ing its unfolding gave
379 -- a better result than looking at its strictness only.
380 -- showInt :: Integral a => a -> [Char] -> [Char]
381 -- ! {-# GHC_PRAGMA _A_ 1 _U_ 122 _S_
382 -- "U(U(U(U(SA)AAAAAAAAL)AA)AAAAASAAASA)" {...} _N_ _N_ #-}
384 -- showInt :: Integral a => a -> [Char] -> [Char]
385 -- ! {-# GHC_PRAGMA _A_ 1 _U_ 122 _S_
386 -- "U(U(U(U(SL)LLLLLLLLL)LL)LLLLLSLLLLL)" _N_ _N_ #-}
389 (_, _, strictness_info, _) ->
390 -- Includes NoUnfolding
391 -- Try the strictness info
392 absValFromStrictness anal strictness_info
394 productAbsVal [] rev_abs_args = AbsProd (reverse rev_abs_args)
395 productAbsVal (arg_ty : arg_tys) rev_abs_args = AbsFun arg_ty (\ abs_arg -> productAbsVal arg_tys (abs_arg : rev_abs_args))
399 absEval :: AnalysisKind -> CoreExpr -> AbsValEnv -> AbsVal
401 absEval anal (Type ty) env = AbsTop
402 absEval anal (Var var) env = absId anal var env
405 Discussion about error (following/quoting Lennart): Any expression
406 'error e' is regarded as bottom (with HBC, with the -ffail-strict
409 Regarding it as bottom gives much better strictness properties for
413 f (x:xs) y = f xs (x+y)
415 f [] _ = error "no match"
417 f (x:xs) y = f xs (x+y)
419 is strict in y, which you really want. But, it may lead to
420 transformations that turn a call to \tr{error} into non-termination.
421 (The odds of this happening aren't good.)
423 Things are a little different for absence analysis, because we want
424 to make sure that any poison (?????)
427 absEval anal (Lit _) env = AbsTop
428 -- Literals terminate (strictness) and are not poison (absence)
432 absEval anal (Lam bndr body) env
433 | isTyVar bndr = absEval anal body env -- Type lambda
434 | otherwise = AbsFun (idType bndr) abs_fn -- Value lambda
436 abs_fn arg = absEval anal body (addOneToAbsValEnv env bndr arg)
438 absEval anal (App expr (Type ty)) env
439 = absEval anal expr env -- Type appplication
440 absEval anal (App f val_arg) env
441 = absApply anal (absEval anal f env) -- Value applicationn
442 (absEval anal val_arg env)
446 absEval anal expr@(Case scrut case_bndr alts) env
448 scrut_val = absEval anal scrut env
449 alts_env = addOneToAbsValEnv env case_bndr scrut_val
451 case (scrut_val, alts) of
452 (AbsBot, _) -> AbsBot
454 (AbsProd arg_vals, [(con, bndrs, rhs)])
456 -- The scrutinee is a product value, so it must be of a single-constr
457 -- type; so the constructor in this alternative must be the right one
458 -- so we can go ahead and bind the constructor args to the components
459 -- of the product value.
460 ASSERT(length arg_vals == length val_bndrs)
461 absEval anal rhs rhs_env
463 val_bndrs = filter isId bndrs
464 rhs_env = growAbsValEnvList alts_env (val_bndrs `zip` arg_vals)
466 other -> absEvalAlts anal alts alts_env
469 For @Lets@ we widen the value we get. This is nothing to
470 do with fixpointing. The reason is so that we don't get an explosion
471 in the amount of computation. For example, consider:
483 If we bind @f@ and @g@ to their exact abstract value, then we'll
484 ``execute'' one call to @f@ and {\em two} calls to @g@. This can blow
485 up exponentially. Widening cuts it off by making a fixed
486 approximation to @f@ and @g@, so that the bodies of @f@ and @g@ are
487 not evaluated again at all when they are called.
489 Of course, this can lose useful joint strictness, which is sad. An
490 alternative approach would be to try with a certain amount of ``fuel''
491 and be prepared to bale out.
494 absEval anal (Let (NonRec binder e1) e2) env
496 new_env = addOneToAbsValEnv env binder (widen anal (absEval anal e1 env))
498 -- The binder of a NonRec should *not* be of unboxed type,
499 -- hence no need to strictly evaluate the Rhs.
500 absEval anal e2 new_env
502 absEval anal (Let (Rec pairs) body) env
504 (binders,rhss) = unzip pairs
505 rhs_vals = cheapFixpoint anal binders rhss env -- Returns widened values
506 new_env = growAbsValEnvList env (binders `zip` rhs_vals)
508 absEval anal body new_env
510 absEval anal (Note note expr) env = absEval anal expr env
514 absEvalAlts :: AnalysisKind -> [CoreAlt] -> AbsValEnv -> AbsVal
515 absEvalAlts anal alts env
516 = combine anal (map go alts)
518 combine StrAnal = foldr1 lub -- Diverge only if all diverge
519 combine AbsAnal = foldr1 glb -- Find any poison
522 = absEval anal rhs rhs_env
524 rhs_env = growAbsValEnvList env (filter isId bndrs `zip` repeat AbsTop)
527 %************************************************************************
529 \subsection[absApply]{Apply an abstract function to an abstract argument}
531 %************************************************************************
536 absApply :: AnalysisKind -> AbsVal -> AbsVal -> AbsVal
538 absApply anal AbsBot arg = AbsBot
539 -- AbsBot represents the abstract bottom *function* too
541 absApply StrAnal AbsTop arg = AbsTop
542 absApply AbsAnal AbsTop arg = if anyBot arg
545 -- To be conservative, we have to assume that a function about
546 -- which we know nothing (AbsTop) might look at some part of
550 An @AbsFun@ with only one more argument needed---bind it and eval the
551 result. A @Lam@ with two or more args: return another @AbsFun@ with
552 an augmented environment.
555 absApply anal (AbsFun bndr_ty abs_fn) arg = abs_fn arg
559 absApply StrAnal (AbsApproxFun (d:ds) val) arg
562 other -> AbsApproxFun ds val' -- Result is non-bot if there are still args
564 val' | evalStrictness d arg = AbsBot
567 absApply AbsAnal (AbsApproxFun (d:ds) val) arg
568 = if evalAbsence d arg
569 then AbsBot -- Poison in arg means poison in the application
572 other -> AbsApproxFun ds val
575 absApply anal f@(AbsProd _) arg
576 = pprPanic ("absApply: Duff function: AbsProd." ++ show anal) ((ppr f) <+> (ppr arg))
583 %************************************************************************
585 \subsection[findStrictness]{Determine some binders' strictness}
587 %************************************************************************
591 -> AbsVal -- Abstract strictness value of function
592 -> AbsVal -- Abstract absence value of function
593 -> StrictnessInfo -- Resulting strictness annotation
595 findStrictness id (AbsApproxFun str_ds str_res) (AbsApproxFun abs_ds _)
596 -- You might think there's really no point in describing detailed
597 -- strictness for a divergent function;
598 -- If it's fully applied we get bottom regardless of the
599 -- argument. If it's not fully applied we don't get bottom.
600 -- Finally, we don't want to regard the args of a divergent function
601 -- as 'interesting' for inlining purposes (see Simplify.prepareArgs)
603 -- HOWEVER, if we make diverging functions appear lazy, they
604 -- don't get wrappers, and then we get dreadful reboxing.
605 -- See notes with WwLib.worthSplitting
606 = find_strictness id str_ds str_res abs_ds
608 findStrictness id str_val abs_val
609 | isBot str_val = mkStrictnessInfo ([], True)
610 | otherwise = NoStrictnessInfo
612 -- The list of absence demands passed to combineDemands
613 -- can be shorter than the list of absence demands
615 -- lookup = \ dEq -> letrec {
616 -- lookup = \ key ds -> ...lookup...
619 -- Here the strictness value takes three args, but the absence value
620 -- takes only one, for reasons I don't quite understand (see cheapFixpoint)
622 find_strictness id orig_str_ds orig_str_res orig_abs_ds
623 = mkStrictnessInfo (go orig_str_ds orig_abs_ds, res_bot)
625 res_bot = isBot orig_str_res
627 go str_ds abs_ds = zipWith mk_dmd str_ds (abs_ds ++ repeat wwLazy)
629 mk_dmd str_dmd (WwLazy True)
630 = WARN( not (res_bot || isLazy str_dmd),
631 ppr id <+> ppr orig_str_ds <+> ppr orig_abs_ds )
632 -- If the arg isn't used we jolly well don't expect the function
633 -- to be strict in it. Unless the function diverges.
634 WwLazy True -- Best of all
636 mk_dmd (WwUnpack nd u str_ds)
637 (WwUnpack _ _ abs_ds) = WwUnpack nd u (go str_ds abs_ds)
639 mk_dmd str_dmd abs_dmd = str_dmd
644 findDemand dmd str_env abs_env expr binder
645 = findRecDemand str_fn abs_fn (idType binder)
647 str_fn val = evalStrictness dmd (absEval StrAnal expr (addOneToAbsValEnv str_env binder val))
648 abs_fn val = not (evalAbsence dmd (absEval AbsAnal expr (addOneToAbsValEnv abs_env binder val)))
650 findDemandAlts dmd str_env abs_env alts binder
651 = findRecDemand str_fn abs_fn (idType binder)
653 str_fn val = evalStrictness dmd (absEvalAlts StrAnal alts (addOneToAbsValEnv str_env binder val))
654 abs_fn val = not (evalAbsence dmd (absEvalAlts AbsAnal alts (addOneToAbsValEnv abs_env binder val)))
657 @findRecDemand@ is where we finally convert strictness/absence info
658 into ``Demands'' which we can pin on Ids (etc.).
660 NOTE: What do we do if something is {\em both} strict and absent?
661 Should \tr{f x y z = error "foo"} says that \tr{f}'s arguments are all
662 strict (because of bottoming effect of \tr{error}) or all absent
663 (because they're not used)?
665 Well, for practical reasons, we prefer absence over strictness. In
666 particular, it makes the ``default defaults'' for class methods (the
667 ones that say \tr{defm.foo dict = error "I don't exist"}) come out
668 nicely [saying ``the dict isn't used''], rather than saying it is
669 strict in every component of the dictionary [massive gratuitious
670 casing to take the dict apart].
672 But you could have examples where going for strictness would be better
673 than absence. Consider:
675 let x = something big
680 If \tr{x} is marked absent in \tr{f}, but not strict, and \tr{g} is
681 lazy, then the thunk for \tr{x} will be built. If \tr{f} was strict,
682 then we'd let-to-case it:
684 case something big of
690 findRecDemand :: (AbsVal -> Bool) -- True => function applied to this value yields Bot
691 -> (AbsVal -> Bool) -- True => function applied to this value yields no poison
692 -> Type -- The type of the argument
695 findRecDemand str_fn abs_fn ty
696 = if isUnLiftedType ty then -- It's a primitive type!
699 else if abs_fn AbsBot then -- It's absent
700 -- We prefer absence over strictness: see NOTE above.
703 else if not (opt_AllStrict ||
704 (opt_NumbersStrict && is_numeric_type ty) ||
706 WwLazy False -- It's not strict and we're not pretending
708 else -- It's strict (or we're pretending it is)!
710 case splitProductType_maybe ty of
712 Nothing -> wwStrict -- Could have a test for wwEnum, but
713 -- we don't exploit it yet, so don't bother
715 Just (tycon,_,data_con,cmpnt_tys) -- Single constructor case
716 | isNewTyCon tycon -- A newtype!
717 -> ASSERT( null (tail cmpnt_tys) )
719 demand = findRecDemand str_fn abs_fn (head cmpnt_tys)
723 | null compt_strict_infos -- A nullary data type
724 || isRecursiveTyCon tycon -- Recursive data type; don't unpack
727 | otherwise -- Some other data type
728 -> wwUnpackData compt_strict_infos
731 prod_len = length cmpnt_tys
735 str_fn (mkMainlyTopProd prod_len i cmpnt_val)
738 abs_fn (mkMainlyTopProd prod_len i cmpnt_val)
741 | (cmpnt_ty, i) <- cmpnt_tys `zip` [1..] ]
745 = case (splitTyConApp_maybe ty) of -- NB: duplicates stuff done above
747 Just (tycon, _) -> tyConUnique tycon `is_elem` numericTyKeys
749 is_elem = isIn "is_numeric_type"
751 -- mkMainlyTopProd: make an AbsProd that is all AbsTops ("n"-1 of
752 -- them) except for a given value in the "i"th position.
754 mkMainlyTopProd :: Int -> Int -> AbsVal -> AbsVal
756 mkMainlyTopProd n i val
758 befores = nOfThem (i-1) AbsTop
759 afters = nOfThem (n-i) AbsTop
761 AbsProd (befores ++ (val : afters))
764 %************************************************************************
766 \subsection[fixpoint]{Fixpointer for the strictness analyser}
768 %************************************************************************
770 The @fixpoint@ functions take a list of \tr{(binder, expr)} pairs, an
771 environment, and returns the abstract value of each binder.
773 The @cheapFixpoint@ function makes a conservative approximation,
774 by binding each of the variables to Top in their own right hand sides.
775 That allows us to make rapid progress, at the cost of a less-than-wonderful
779 cheapFixpoint :: AnalysisKind -> [Id] -> [CoreExpr] -> AbsValEnv -> [AbsVal]
781 cheapFixpoint AbsAnal [id] [rhs] env
782 = [crudeAbsWiden (absEval AbsAnal rhs new_env)]
784 new_env = addOneToAbsValEnv env id AbsTop -- Unsafe starting point!
785 -- In the just-one-binding case, we guarantee to
786 -- find a fixed point in just one iteration,
787 -- because we are using only a two-point domain.
788 -- This improves matters in cases like:
790 -- f x y = letrec g = ...g...
793 -- Here, y isn't used at all, but if g is bound to
794 -- AbsBot we simply get AbsBot as the next
797 cheapFixpoint anal ids rhss env
798 = [widen anal (absEval anal rhs new_env) | rhs <- rhss]
799 -- We do just one iteration, starting from a safe
800 -- approximation. This won't do a good job in situations
802 -- \x -> letrec f = ...g...
806 -- Here, f will end up bound to Top after one iteration,
807 -- and hence we won't spot the strictness in x.
808 -- (A second iteration would solve this. ToDo: try the effect of
809 -- really searching for a fixed point.)
811 new_env = growAbsValEnvList env [(id,safe_val) | id <- ids]
814 = case anal of -- The safe starting point
820 fixpoint :: AnalysisKind -> [Id] -> [CoreExpr] -> AbsValEnv -> [AbsVal]
822 fixpoint anal [] _ env = []
824 fixpoint anal ids rhss env
825 = fix_loop initial_vals
828 = case anal of -- The (unsafe) starting point
831 -- At one stage for StrAnal we said:
832 -- if (returnsRealWorld (idType id))
833 -- then AbsTop -- this is a massively horrible hack (SLPJ 95/05)
834 -- but no one has the foggiest idea what this hack did,
835 -- and returnsRealWorld was a stub that always returned False
836 -- So this comment is all that is left of the hack!
838 initial_vals = [ initial_val id | id <- ids ]
840 fix_loop :: [AbsVal] -> [AbsVal]
842 fix_loop current_widened_vals
844 new_env = growAbsValEnvList env (ids `zip` current_widened_vals)
845 new_vals = [ absEval anal rhs new_env | rhs <- rhss ]
846 new_widened_vals = map (widen anal) new_vals
848 if (and (zipWith sameVal current_widened_vals new_widened_vals)) then
851 -- NB: I was too chicken to make that a zipWithEqual,
852 -- lest I jump into a black hole. WDP 96/02
854 -- Return the widened values. We might get a slightly
855 -- better value by returning new_vals (which we used to
856 -- do, see below), but alas that means that whenever the
857 -- function is called we have to re-execute it, which is
862 -- Return the un-widened values which may be a bit better
863 -- than the widened ones, and are guaranteed safe, since
864 -- they are one iteration beyond current_widened_vals,
865 -- which itself is a fixed point.
867 fix_loop new_widened_vals
870 For absence analysis, we make do with a very very simple approach:
871 look for convergence in a two-point domain.
873 We used to use just one iteration, starting with the variables bound
874 to @AbsBot@, which is safe.
876 Prior to that, we used one iteration starting from @AbsTop@ (which
877 isn't safe). Why isn't @AbsTop@ safe? Consider:
885 Here, if p is @AbsBot@, then we'd better {\em not} end up with a ``fixed
886 point'' of @d@ being @(AbsTop, AbsTop)@! An @AbsBot@ initial value is
887 safe because it gives poison more often than really necessary, and
888 thus may miss some absence, but will never claim absence when it ain't
891 Anyway, one iteration starting with everything bound to @AbsBot@ give
896 Here, f would always end up bound to @AbsBot@, which ain't very
897 clever, because then it would introduce poison whenever it was
898 applied. Much better to start with f bound to @AbsTop@, and widen it
899 to @AbsBot@ if any poison shows up. In effect we look for convergence
900 in the two-point @AbsTop@/@AbsBot@ domain.
902 What we miss (compared with the cleverer strictness analysis) is
903 spotting that in this case
905 f = \ x y -> ...y...(f x y')...
907 \tr{x} is actually absent, since it is only passed round the loop, never
908 used. But who cares about missing that?
910 NB: despite only having a two-point domain, we may still have many
911 iterations, because there are several variables involved at once.