2 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1995
4 \section[SaAbsInt]{Abstract interpreter for strictness analysis}
7 #include "HsVersions.h"
18 IMPORT_Trace -- ToDo: rm
23 import AbsPrel ( PrimOp(..), PrimKind )
24 import AbsUniType ( isPrimType, getUniDataTyCon_maybe,
25 maybeSingleConstructorTyCon,
27 isEnumerationTyCon, TyVarTemplate, TyCon
28 IF_ATTACK_PRAGMAS(COMMA cmpTyCon)
30 import Id ( getIdStrictness, getIdUniType, getIdUnfolding,
31 getDataConSig, getInstantiatedDataConSig,
32 DataCon(..), isBottomingId
35 import IdInfo -- various bits
37 import CoreFuns ( unTagBinders )
38 import Maybes ( maybeToBool, Maybe(..) )
41 import SimplEnv ( FormSummary(..) ) -- nice data abstraction, huh? (WDP 95/03)
45 %************************************************************************
47 \subsection[AbsVal-ops]{Operations on @AbsVals@}
49 %************************************************************************
51 Least upper bound, greatest lower bound.
54 lub, glb :: AbsVal -> AbsVal -> AbsVal
56 lub val1 val2 | isBot val1 = val2 -- The isBot test includes the case where
57 lub val1 val2 | isBot val2 = val1 -- one of the val's is a function which
58 -- always returns bottom, such as \y.x,
59 -- when x is bound to bottom.
61 lub (AbsProd xs) (AbsProd ys) = ASSERT (length xs == length ys)
62 AbsProd (zipWith lub xs ys)
64 lub _ _ = AbsTop -- Crude, but conservative
65 -- The crudity only shows up if there
66 -- are functions involved
68 -- Slightly funny glb; for absence analysis only;
69 -- AbsBot is the safe answer.
71 -- Using anyBot rather than just testing for AbsBot is important.
76 -- g = \x y z -> case x of
80 -- Now, the abstract value of the branches of the case will be an
81 -- AbsFun, but when testing for z's absence we want to spot that it's
82 -- an AbsFun which can't possibly return AbsBot. So when glb'ing we
83 -- mustn't be too keen to bale out and return AbsBot; the anyBot test
84 -- spots that (f x) can't possibly return AbsBot.
86 -- We have also tripped over the following interesting case:
91 -- Now, suppose f is bound to AbsTop. Does this expression mention z?
92 -- Obviously not. But the case will take the glb of AbsTop (for f) and
93 -- an AbsFun (for \y->1). We should not bale out and give AbsBot, because
94 -- that would say that it *does* mention z (or anything else for that matter).
95 -- Nor can we always return AbsTop, because the AbsFun might be something
96 -- like (\y->z), which obviously does mention z. The point is that we're
97 -- glbing two functions, and AbsTop is not actually the top of the function
98 -- lattice. It is more like (\xyz -> x|y|z); that is, AbsTop returns
99 -- poison iff any of its arguments do.
101 -- Deal with functions specially, because AbsTop isn't the
102 -- top of their domain.
105 | is_fun v1 || is_fun v2
106 = if not (anyBot v1) && not (anyBot v2)
112 is_fun (AbsFun _ _ _) = True
113 is_fun (AbsApproxFun _) = True -- Not used, but the glb works ok
116 -- The non-functional cases are quite straightforward
118 glb (AbsProd xs) (AbsProd ys) = ASSERT (length xs == length ys)
119 AbsProd (zipWith 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 PprDebug 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 args 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 args body env) = anyBot (absEval AbsAnal body env)
212 anyBot (AbsApproxFun demands) = 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 args body env)
227 | isBot (absEval StrAnal body env) = AbsBot
229 = ASSERT (not (null args))
230 AbsApproxFun (map (findDemandStrOnly env body) args)
232 -- It's worth checking for a function which is unconditionally
235 -- f x y = let g y = case x of ...
236 -- in (g ..) + (g ..)
238 -- Here, when we are considering strictness of f in x, we'll
239 -- evaluate the body of f with x bound to bottom. The current
240 -- strategy is to bind g to its *widened* value; without the isBot
241 -- (...) test above, we'd bind g to an AbsApproxFun, and deliver
242 -- Top, not Bot as the value of f's rhs. The test spots the
243 -- unconditional bottom-ness of g when x is bottom. (Another
244 -- alternative here would be to bind g to its exact abstract
245 -- value, but that entails lots of potential re-computation, at
246 -- every application of g.)
248 widen StrAnal (AbsProd vals) = AbsProd (map (widen StrAnal) vals)
249 widen StrAnal other_val = other_val
252 widen AbsAnal (AbsFun args body env)
253 | anyBot (absEval AbsAnal body env) = AbsBot
254 -- In the absence-analysis case it's *essential* to check
255 -- that the function has no poison in its body. If it does,
256 -- anywhere, then the whole function is poisonous.
259 = ASSERT (not (null args))
260 AbsApproxFun (map (findDemandAbsOnly env body) args)
262 widen AbsAnal (AbsProd vals) = AbsProd (map (widen AbsAnal) vals)
264 -- It's desirable to do a good job of widening for product
268 -- in ...(case p of (x,y) -> x)...
270 -- Now, is y absent in this expression? Currently the
271 -- analyser widens p before looking at p's scope, to avoid
272 -- lots of recomputation in the case where p is a function.
273 -- So if widening doesn't have a case for products, we'll
274 -- widen p to AbsBot (since when searching for absence in y we
275 -- bind y to poison ie AbsBot), and now we are lost.
277 widen AbsAnal other_val = other_val
279 -- OLD if anyBot val then AbsBot else AbsTop
280 -- Nowadays widen is doing a better job on functions for absence analysis.
283 @crudeAbsWiden@ is used just for absence analysis, and always
284 returns AbsTop or AbsBot, so it widens to a two-point domain
287 crudeAbsWiden :: AbsVal -> AbsVal
288 crudeAbsWiden val = if anyBot val then AbsBot else AbsTop
291 @sameVal@ compares two abstract values for equality. It can't deal with
292 @AbsFun@, but that should have been removed earlier in the day by @widen@.
295 sameVal :: AbsVal -> AbsVal -> Bool -- Can't handle AbsFun!
298 sameVal (AbsFun _ _ _) _ = panic "sameVal: AbsFun: arg1"
299 sameVal _ (AbsFun _ _ _) = panic "sameVal: AbsFun: arg2"
302 sameVal AbsBot AbsBot = True
303 sameVal AbsBot other = False -- widen has reduced AbsFun bots to AbsBot
305 sameVal AbsTop AbsTop = True
306 sameVal AbsTop other = False -- Right?
308 sameVal (AbsProd vals1) (AbsProd vals2) = ASSERT (length vals1 == length vals2)
309 and (zipWith sameVal vals1 vals2)
310 sameVal (AbsProd _) AbsTop = False
311 sameVal (AbsProd _) AbsBot = False
313 sameVal (AbsApproxFun str1) (AbsApproxFun str2) = str1 == str2
314 sameVal (AbsApproxFun _) AbsTop = False
315 sameVal (AbsApproxFun _) AbsBot = False
317 sameVal val1 val2 = panic "sameVal: type mismatch or AbsFun encountered"
321 @evalStrictness@ compares a @Demand@ with an abstract value, returning
322 @True@ iff the abstract value is {\em less defined} than the demand.
323 (@True@ is the exciting answer; @False@ is always safe.)
326 evalStrictness :: Demand
328 -> Bool -- True iff the value is sure
329 -- to be less defined than the Demand
331 evalStrictness (WwLazy _) _ = False
332 evalStrictness WwStrict val = isBot val
333 evalStrictness WwEnum val = isBot val
335 evalStrictness (WwUnpack demand_info) val
339 AbsProd vals -> ASSERT (length vals == length demand_info)
340 or (zipWith evalStrictness demand_info vals)
341 _ -> trace "evalStrictness?" False
343 evalStrictness WwPrim val
347 other -> -- A primitive value should be defined, never bottom;
348 -- hence this paranoia check
349 pprPanic "evalStrictness: WwPrim:" (ppr PprDebug other)
352 For absence analysis, we're interested in whether "poison" in the
353 argument (ie a bottom therein) can propagate to the result of the
354 function call; that is, whether the specified demand can {\em
355 possibly} hit poison.
358 evalAbsence (WwLazy True) _ = False -- Can't possibly hit poison
359 -- with Absent demand
361 evalAbsence (WwUnpack demand_info) val
363 AbsTop -> False -- No poison in here
364 AbsBot -> True -- Pure poison
365 AbsProd vals -> ASSERT (length demand_info == length vals)
366 or (zipWith 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, LiteralForm _) ->
397 AbsTop -- Literals all terminate, and have no poison
399 (Nothing, NoStrictnessInfo, ConstructorForm _ _ _) ->
400 AbsTop -- An imported constructor won't have
401 -- bottom components, nor poison!
403 (Nothing, NoStrictnessInfo, GeneralForm _ _ 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 -- GeneralForm _ 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 (CoVarAtom v) env = absId anal v env
445 absEvalAtom anal (CoLitAtom _) env = AbsTop
449 absEval :: AnalysisKind -> PlainCoreExpr -> AbsValEnv -> AbsVal
451 absEval anal (CoVar var) env = absId anal var env
453 absEval anal (CoLit _) 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 (CoPrim SeqOp [t] [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 (CoPrim op ts 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 (CoPrim op ts as) env
500 = if any anyBot [absEvalAtom AbsAnal a env | a <- as]
503 -- For absence analysis, we want to see if the poison shows up...
505 absEval anal (CoCon con ts as) env
507 = AbsProd [absEvalAtom anal a env | a <- as]
509 | otherwise -- Not single-constructor
511 StrAnal -> -- Strictness case: it's easy: it certainly terminates
513 AbsAnal -> -- In the absence case we need to be more
514 -- careful: look to see if there's any
515 -- poison in the components
516 if any anyBot [absEvalAtom AbsAnal a env | a <- as]
520 (_,_,_, tycon) = getDataConSig con
521 has_single_con = maybeToBool (maybeSingleConstructorTyCon tycon)
525 absEval anal (CoLam [] body) env = absEval anal body env -- paranoia
526 absEval anal (CoLam binders body) env = AbsFun binders body env
527 absEval anal (CoTyLam ty expr) env = absEval anal expr env
528 absEval anal (CoApp e1 e2) env = absApply anal (absEval anal e1 env)
529 (absEvalAtom anal e2 env)
530 absEval anal (CoTyApp expr ty) env = absEval anal expr env
533 For primitive cases, just GLB the branches, then LUB with the expr part.
536 absEval anal (CoCase expr (CoPrimAlts 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 (CoCase expr (CoAlgAlts 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:" (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)))
568 For @CoLets@ 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 (CoLet (CoNonRec binder e1) e2) env
595 new_env = addOneToAbsValEnv env binder (widen anal (absEval anal e1 env))
597 -- The binder of a CoNonRec should *not* be of unboxed type,
598 -- hence no need to strictly evaluate the Rhs.
599 absEval anal e2 new_env
601 absEval anal (CoLet (CoRec 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
611 absEval anal (CoSCC cc expr) env = absEval anal expr env
613 -- ToDo: add DPH stuff here
617 absEvalAlgAlt :: AnalysisKind -> AbsVal -> (Id,[Id],PlainCoreExpr) -> AbsValEnv -> AbsVal
619 absEvalAlgAlt anal (AbsProd arg_vals) (con, args, rhs) env
620 = -- The scrutinee is a product value, so it must be of a single-constr
621 -- type; so the constructor in this alternative must be the right one
622 -- so we can go ahead and bind the constructor args to the components
623 -- of the product value.
624 ASSERT(length arg_vals == length args)
626 new_env = growAbsValEnvList env (args `zip` arg_vals)
628 absEval anal rhs new_env
630 absEvalAlgAlt anal other_scrutinee (con, args, rhs) env
631 = -- Scrutinised value is Top or Bot (it can't be a function!)
632 -- So just evaluate the rhs with all constr args bound to Top.
633 -- (If the scrutinee is Top we'll never evaluated this function
639 = case other_scrutinee of {
640 AbsTop -> True; -- i.e., OK
641 AbsBot -> True; -- ditto
642 _ -> False -- party over
646 absEvalDefault :: AnalysisKind
647 -> AbsVal -- Value of scrutinee
648 -> PlainCoreCaseDefault
650 -> [AbsVal] -- Empty or singleton
652 absEvalDefault anal scrut_val CoNoDefault env = []
653 absEvalDefault anal scrut_val (CoBindDefault binder expr) env
654 = [absEval anal expr (addOneToAbsValEnv env binder scrut_val)]
657 %************************************************************************
659 \subsection[absApply]{Apply an abstract function to an abstract argument}
661 %************************************************************************
666 absApply :: AnalysisKind -> AbsVal -> AbsVal -> AbsVal
668 absApply anal AbsBot arg = AbsBot
669 -- AbsBot represents the abstract bottom *function* too
671 absApply StrAnal AbsTop arg = AbsTop
672 absApply AbsAnal AbsTop arg = if anyBot arg
675 -- To be conservative, we have to assume that a function about
676 -- which we know nothing (AbsTop) might look at some part of
680 An @AbsFun@ with only one more argument needed---bind it and eval the
681 result. A @CoLam@ with two or more args: return another @AbsFun@ with
682 an augmented environment.
685 absApply anal (AbsFun [binder] body env) arg
686 = absEval anal body (addOneToAbsValEnv env binder arg)
688 absApply anal (AbsFun (binder:bs) body env) arg
689 = AbsFun bs body (addOneToAbsValEnv env binder arg)
693 absApply StrAnal (AbsApproxFun (arg1_demand:ds)) arg
694 = if evalStrictness arg1_demand arg
698 other -> AbsApproxFun ds
700 absApply AbsAnal (AbsApproxFun (arg1_demand:ds)) arg
701 = if evalAbsence arg1_demand arg
705 other -> AbsApproxFun ds
708 absApply anal (AbsApproxFun []) arg = panic ("absApply: Duff function: AbsApproxFun." ++ show anal)
709 absApply anal (AbsFun [] _ _) arg = panic ("absApply: Duff function: AbsFun." ++ show anal)
710 absApply anal (AbsProd _) arg = panic ("absApply: Duff function: AbsProd." ++ show anal)
717 %************************************************************************
719 \subsection[findStrictness]{Determine some binders' strictness}
721 %************************************************************************
723 @findStrictness@ applies the function \tr{\ ids -> expr} to
724 \tr{[bot,top,top,...]}, \tr{[top,bot,top,top,...]}, etc., (i.e., once
725 with @AbsBot@ in each argument position), and evaluates the resulting
726 abstract value; it returns a vector of @Demand@s saying whether the
727 result of doing this is guaranteed to be bottom. This tells the
728 strictness of the function in each of the arguments.
730 If an argument is of unboxed type, then we declare that function to be
731 strict in that argument.
733 We don't really have to make up all those lists of mostly-@AbsTops@;
734 unbound variables in an @AbsValEnv@ are implicitly mapped to that.
736 See notes on @addStrictnessInfoToId@.
739 findStrictness :: [UniType] -- 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 [] str_val abs_val = []
746 findStrictness (ty:tys) str_val abs_val
748 demand = findRecDemand [] 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 tys (absApply StrAnal str_val AbsTop)
753 (absApply AbsAnal abs_val AbsTop)
755 -- pprTrace "findRecDemand:" (ppCat [ppr PprDebug demand, ppr PprDebug ty]) (
762 findDemandStrOnly str_env expr binder -- Only strictness environment available
763 = findRecDemand [] str_fn abs_fn (getIdUniType binder)
765 str_fn val = absEval StrAnal expr (addOneToAbsValEnv str_env binder val)
766 abs_fn val = AbsBot -- Always says poison; so it looks as if
767 -- nothing is absent; safe
770 findDemandAbsOnly abs_env expr binder -- Only absence environment available
771 = findRecDemand [] str_fn abs_fn (getIdUniType binder)
773 str_fn val = AbsBot -- Always says non-termination;
774 -- that'll make findRecDemand peer into the
775 -- structure of the value.
776 abs_fn val = absEval AbsAnal expr (addOneToAbsValEnv abs_env binder val)
779 findDemand str_env abs_env expr binder
780 = findRecDemand [] str_fn abs_fn (getIdUniType 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)
786 @findRecDemand@ is where we finally convert strictness/absence info
787 into ``Demands'' which we can pin on Ids (etc.).
789 NOTE: What do we do if something is {\em both} strict and absent?
790 Should \tr{f x y z = error "foo"} says that \tr{f}'s arguments are all
791 strict (because of bottoming effect of \tr{error}) or all absent
792 (because they're not used)?
794 Well, for practical reasons, we prefer absence over strictness. In
795 particular, it makes the ``default defaults'' for class methods (the
796 ones that say \tr{defm.foo dict = error "I don't exist"}) come out
797 nicely [saying ``the dict isn't used''], rather than saying it is
798 strict in every component of the dictionary [massive gratuitious
799 casing to take the dict apart].
801 But you could have examples where going for strictness would be better
802 than absence. Consider:
804 let x = something big
809 If \tr{x} is marked absent in \tr{f}, but not strict, and \tr{g} is
810 lazy, then the thunk for \tr{x} will be built. If \tr{f} was strict,
811 then we'd let-to-case it:
813 case something big of
819 findRecDemand :: [TyCon] -- TyCons already seen; used to avoid
820 -- zooming into recursive types
821 -> (AbsVal -> AbsVal) -- The strictness function
822 -> (AbsVal -> AbsVal) -- The absence function
823 -> UniType -- The type of the argument
826 findRecDemand seen str_fn abs_fn ty
827 = if isPrimType ty then -- It's a primitive type!
830 else if not (anyBot (abs_fn AbsBot)) then -- It's absent
831 -- We prefer absence over strictness: see NOTE above.
834 else if not (isBot (str_fn AbsBot)) then -- It's not strict
839 case getUniDataTyCon_maybe ty of
843 Just (tycon,tycon_arg_tys,[data_con]) | tycon `not_elem` seen ->
844 -- Single constructor case, tycon not already seen higher up
846 (_,cmpnt_tys,_) = getInstantiatedDataConSig data_con tycon_arg_tys
847 prod_len = length cmpnt_tys
850 = [ findRecDemand (tycon:seen)
852 str_fn (mkMainlyTopProd prod_len i cmpnt_val)
855 abs_fn (mkMainlyTopProd prod_len i cmpnt_val)
858 | (cmpnt_ty, i) <- cmpnt_tys `zip` [1..] ]
860 if null compt_strict_infos then
861 if isEnumerationTyCon tycon then wwEnum else wwStrict
863 wwUnpack compt_strict_infos
865 not_elem = isn'tIn "findRecDemand"
868 -- Multi-constr data types, *or* an abstract data
869 -- types, *or* things we don't have a way of conveying
870 -- the info over module boundaries (class ops,
871 -- superdict sels, dfns).
872 if isEnumerationTyCon tycon then
877 -- mkMainlyTopProd: make an AbsProd that is all AbsTops ("n"-1 of
878 -- them) except for a given value in the "i"th position.
880 mkMainlyTopProd :: Int -> Int -> AbsVal -> AbsVal
882 mkMainlyTopProd n i val
884 befores = nOfThem (i-1) AbsTop
885 afters = nOfThem (n-i) AbsTop
887 AbsProd (befores ++ (val : afters))
890 %************************************************************************
892 \subsection[fixpoint]{Fixpointer for the strictness analyser}
894 %************************************************************************
896 The @fixpoint@ functions take a list of \tr{(binder, expr)} pairs, an
897 environment, and returns the abstract value of each binder.
899 The @cheapFixpoint@ function makes a conservative approximation,
900 by binding each of the variables to Top in their own right hand sides.
901 That allows us to make rapid progress, at the cost of a less-than-wonderful
905 cheapFixpoint :: AnalysisKind -> [Id] -> [PlainCoreExpr] -> AbsValEnv -> [AbsVal]
907 cheapFixpoint AbsAnal [id] [rhs] env
908 = [crudeAbsWiden (absEval AbsAnal rhs new_env)]
910 new_env = addOneToAbsValEnv env id AbsTop -- Unsafe starting point!
911 -- In the just-one-binding case, we guarantee to
912 -- find a fixed point in just one iteration,
913 -- because we are using only a two-point domain.
914 -- This improves matters in cases like:
916 -- f x y = letrec g = ...g...
919 -- Here, y isn't used at all, but if g is bound to
920 -- AbsBot we simply get AbsBot as the next
923 cheapFixpoint anal ids rhss env
924 = [widen anal (absEval anal rhs new_env) | rhs <- rhss]
925 -- We do just one iteration, starting from a safe
926 -- approximation. This won't do a good job in situations
928 -- \x -> letrec f = ...g...
932 -- Here, f will end up bound to Top after one iteration,
933 -- and hence we won't spot the strictness in x.
934 -- (A second iteration would solve this. ToDo: try the effect of
935 -- really searching for a fixed point.)
937 new_env = growAbsValEnvList env [(id,safe_val) | id <- ids]
940 = case anal of -- The safe starting point
946 mkLookupFun :: (key -> key -> Bool) -- Equality predicate
947 -> (key -> key -> Bool) -- Less-than predicate
948 -> [(key,val)] -- The assoc list
950 -> Maybe val -- The corresponding value
952 mkLookupFun eq lt alist s
953 = case [a | (s',a) <- alist, s' `eq` s] of
959 fixpoint :: AnalysisKind -> [Id] -> [PlainCoreExpr] -> AbsValEnv -> [AbsVal]
961 fixpoint anal [] _ env = []
963 fixpoint anal ids rhss env
964 = fix_loop initial_vals
967 = case anal of -- The (unsafe) starting point
968 StrAnal -> if (returnsRealWorld (getIdUniType id))
969 then AbsTop -- this is a massively horrible hack (SLPJ 95/05)
973 initial_vals = [ initial_val id | id <- ids ]
975 fix_loop :: [AbsVal] -> [AbsVal]
977 fix_loop current_widened_vals
979 new_env = growAbsValEnvList env (ids `zip` current_widened_vals)
980 new_vals = [ absEval anal rhs new_env | rhs <- rhss ]
981 new_widened_vals = map (widen anal) new_vals
983 if (and (zipWith sameVal current_widened_vals new_widened_vals)) then
986 -- Return the widened values. We might get a slightly
987 -- better value by returning new_vals (which we used to
988 -- do, see below), but alas that means that whenever the
989 -- function is called we have to re-execute it, which is
994 -- Return the un-widened values which may be a bit better
995 -- than the widened ones, and are guaranteed safe, since
996 -- they are one iteration beyond current_widened_vals,
997 -- which itself is a fixed point.
999 fix_loop new_widened_vals
1002 For absence analysis, we make do with a very very simple approach:
1003 look for convergence in a two-point domain.
1005 We used to use just one iteration, starting with the variables bound
1006 to @AbsBot@, which is safe.
1008 Prior to that, we used one iteration starting from @AbsTop@ (which
1009 isn't safe). Why isn't @AbsTop@ safe? Consider:
1017 Here, if p is @AbsBot@, then we'd better {\em not} end up with a ``fixed
1018 point'' of @d@ being @(AbsTop, AbsTop)@! An @AbsBot@ initial value is
1019 safe because it gives poison more often than really necessary, and
1020 thus may miss some absence, but will never claim absence when it ain't
1023 Anyway, one iteration starting with everything bound to @AbsBot@ give
1028 Here, f would always end up bound to @AbsBot@, which ain't very
1029 clever, because then it would introduce poison whenever it was
1030 applied. Much better to start with f bound to @AbsTop@, and widen it
1031 to @AbsBot@ if any poison shows up. In effect we look for convergence
1032 in the two-point @AbsTop@/@AbsBot@ domain.
1034 What we miss (compared with the cleverer strictness analysis) is
1035 spotting that in this case
1037 f = \ x y -> ...y...(f x y')...
1039 \tr{x} is actually absent, since it is only passed round the loop, never
1040 used. But who cares about missing that?
1042 NB: despite only having a two-point domain, we may still have many
1043 iterations, because there are several variables involved at once.