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(..),
24 intTyCon, integerTyCon, doubleTyCon,
25 floatTyCon, wordTyCon, addrTyCon,
28 import AbsUniType ( isPrimType, getUniDataTyCon_maybe,
29 maybeSingleConstructorTyCon,
31 isEnumerationTyCon, TyVarTemplate, TyCon
32 IF_ATTACK_PRAGMAS(COMMA cmpTyCon)
34 import Id ( getIdStrictness, getIdUniType, getIdUnfolding,
35 getDataConSig, getInstantiatedDataConSig,
36 DataCon(..), isBottomingId
39 import IdInfo -- various bits
41 import CoreFuns ( unTagBinders )
42 import Maybes ( maybeToBool, Maybe(..) )
45 import SimplEnv ( FormSummary(..) ) -- nice data abstraction, huh? (WDP 95/03)
49 %************************************************************************
51 \subsection[AbsVal-ops]{Operations on @AbsVals@}
53 %************************************************************************
55 Least upper bound, greatest lower bound.
58 lub, glb :: AbsVal -> AbsVal -> AbsVal
60 lub val1 val2 | isBot val1 = val2 -- The isBot test includes the case where
61 lub val1 val2 | isBot val2 = val1 -- one of the val's is a function which
62 -- always returns bottom, such as \y.x,
63 -- when x is bound to bottom.
65 lub (AbsProd xs) (AbsProd ys) = ASSERT (length xs == length ys)
66 AbsProd (zipWith lub xs ys)
68 lub _ _ = AbsTop -- Crude, but conservative
69 -- The crudity only shows up if there
70 -- are functions involved
72 -- Slightly funny glb; for absence analysis only;
73 -- AbsBot is the safe answer.
75 -- Using anyBot rather than just testing for AbsBot is important.
80 -- g = \x y z -> case x of
84 -- Now, the abstract value of the branches of the case will be an
85 -- AbsFun, but when testing for z's absence we want to spot that it's
86 -- an AbsFun which can't possibly return AbsBot. So when glb'ing we
87 -- mustn't be too keen to bale out and return AbsBot; the anyBot test
88 -- spots that (f x) can't possibly return AbsBot.
90 -- We have also tripped over the following interesting case:
95 -- Now, suppose f is bound to AbsTop. Does this expression mention z?
96 -- Obviously not. But the case will take the glb of AbsTop (for f) and
97 -- an AbsFun (for \y->1). We should not bale out and give AbsBot, because
98 -- that would say that it *does* mention z (or anything else for that matter).
99 -- Nor can we always return AbsTop, because the AbsFun might be something
100 -- like (\y->z), which obviously does mention z. The point is that we're
101 -- glbing two functions, and AbsTop is not actually the top of the function
102 -- lattice. It is more like (\xyz -> x|y|z); that is, AbsTop returns
103 -- poison iff any of its arguments do.
105 -- Deal with functions specially, because AbsTop isn't the
106 -- top of their domain.
109 | is_fun v1 || is_fun v2
110 = if not (anyBot v1) && not (anyBot v2)
116 is_fun (AbsFun _ _ _) = True
117 is_fun (AbsApproxFun _) = True -- Not used, but the glb works ok
120 -- The non-functional cases are quite straightforward
122 glb (AbsProd xs) (AbsProd ys) = ASSERT (length xs == length ys)
123 AbsProd (zipWith glb xs ys)
128 glb _ _ = AbsBot -- Be pessimistic
134 -> AbsVal -- Value of scrutinee
135 -> [AbsVal] -- Value of branches (at least one)
138 -- For strictness analysis, see if the scrutinee is bottom; if so
139 -- return bottom; otherwise, the lub of the branches.
141 combineCaseValues StrAnal AbsBot branches = AbsBot
142 combineCaseValues StrAnal other_scrutinee branches
143 -- Scrutinee can only be AbsBot, AbsProd or AbsTop
144 = ASSERT(ok_scrutinee)
148 = case other_scrutinee of {
149 AbsTop -> True; -- i.e., cool
150 AbsProd _ -> True; -- ditto
151 _ -> False -- party over
154 -- For absence analysis, check if the scrutinee is all poison (isBot)
155 -- If so, return poison (AbsBot); otherwise, any nested poison will come
156 -- out from looking at the branches, so just glb together the branches
157 -- to get the worst one.
159 combineCaseValues AbsAnal AbsBot branches = AbsBot
160 combineCaseValues AbsAnal other_scrutinee branches
161 -- Scrutinee can only be AbsBot, AbsProd or AbsTop
162 = ASSERT(ok_scrutinee)
164 result = foldr1 glb branches
166 tracer = if at_least_one_AbsFun && at_least_one_AbsTop
168 pprTrace "combineCase:" (ppr PprDebug branches)
177 = case other_scrutinee of {
178 AbsTop -> True; -- i.e., cool
179 AbsProd _ -> True; -- ditto
180 _ -> False -- party over
183 at_least_one_AbsFun = foldr ((||) . is_AbsFun) False branches
184 at_least_one_AbsTop = foldr ((||) . is_AbsTop) False branches
185 no_AbsBots = foldr ((&&) . is_not_AbsBot) True branches
187 is_AbsFun x = case x of { AbsFun _ _ _ -> True; _ -> False }
188 is_AbsTop x = case x of { AbsTop -> True; _ -> False }
189 is_not_AbsBot x = case x of { AbsBot -> False; _ -> True }
192 @isBot@ returns True if its argument is (a representation of) bottom. The
193 ``representation'' part is because we need to detect the bottom {\em function}
194 too. To detect the bottom function, bind its args to top, and see if it
197 Used only in strictness analysis:
199 isBot :: AbsVal -> Bool
202 isBot (AbsFun args body env) = isBot (absEval StrAnal body env)
203 -- Don't bother to extend the envt because
204 -- unbound variables default to AbsTop anyway
208 Used only in absence analysis:
210 anyBot :: AbsVal -> Bool
212 anyBot AbsBot = True -- poisoned!
213 anyBot AbsTop = False
214 anyBot (AbsProd vals) = any anyBot vals
215 anyBot (AbsFun args body env) = anyBot (absEval AbsAnal body env)
216 anyBot (AbsApproxFun demands) = False
218 -- AbsApproxFun can only arise in absence analysis from the Demand
219 -- info of an imported value; whatever it is we're looking for is
220 -- certainly not present over in the imported value.
223 @widen@ takes an @AbsVal@, $val$, and returns and @AbsVal@ which is
224 approximated by $val$. Furthermore, the result has no @AbsFun@s in
225 it, so it can be compared for equality by @sameVal@.
228 widen :: AnalysisKind -> AbsVal -> AbsVal
230 widen StrAnal (AbsFun args body env)
231 | isBot (absEval StrAnal body env) = AbsBot
233 = ASSERT (not (null args))
234 AbsApproxFun (map (findDemandStrOnly env body) args)
236 -- It's worth checking for a function which is unconditionally
239 -- f x y = let g y = case x of ...
240 -- in (g ..) + (g ..)
242 -- Here, when we are considering strictness of f in x, we'll
243 -- evaluate the body of f with x bound to bottom. The current
244 -- strategy is to bind g to its *widened* value; without the isBot
245 -- (...) test above, we'd bind g to an AbsApproxFun, and deliver
246 -- Top, not Bot as the value of f's rhs. The test spots the
247 -- unconditional bottom-ness of g when x is bottom. (Another
248 -- alternative here would be to bind g to its exact abstract
249 -- value, but that entails lots of potential re-computation, at
250 -- every application of g.)
252 widen StrAnal (AbsProd vals) = AbsProd (map (widen StrAnal) vals)
253 widen StrAnal other_val = other_val
256 widen AbsAnal (AbsFun args body env)
257 | anyBot (absEval AbsAnal body env) = AbsBot
258 -- In the absence-analysis case it's *essential* to check
259 -- that the function has no poison in its body. If it does,
260 -- anywhere, then the whole function is poisonous.
263 = ASSERT (not (null args))
264 AbsApproxFun (map (findDemandAbsOnly env body) args)
266 widen AbsAnal (AbsProd vals) = AbsProd (map (widen AbsAnal) vals)
268 -- It's desirable to do a good job of widening for product
272 -- in ...(case p of (x,y) -> x)...
274 -- Now, is y absent in this expression? Currently the
275 -- analyser widens p before looking at p's scope, to avoid
276 -- lots of recomputation in the case where p is a function.
277 -- So if widening doesn't have a case for products, we'll
278 -- widen p to AbsBot (since when searching for absence in y we
279 -- bind y to poison ie AbsBot), and now we are lost.
281 widen AbsAnal other_val = other_val
283 -- OLD if anyBot val then AbsBot else AbsTop
284 -- Nowadays widen is doing a better job on functions for absence analysis.
287 @crudeAbsWiden@ is used just for absence analysis, and always
288 returns AbsTop or AbsBot, so it widens to a two-point domain
291 crudeAbsWiden :: AbsVal -> AbsVal
292 crudeAbsWiden val = if anyBot val then AbsBot else AbsTop
295 @sameVal@ compares two abstract values for equality. It can't deal with
296 @AbsFun@, but that should have been removed earlier in the day by @widen@.
299 sameVal :: AbsVal -> AbsVal -> Bool -- Can't handle AbsFun!
302 sameVal (AbsFun _ _ _) _ = panic "sameVal: AbsFun: arg1"
303 sameVal _ (AbsFun _ _ _) = panic "sameVal: AbsFun: arg2"
306 sameVal AbsBot AbsBot = True
307 sameVal AbsBot other = False -- widen has reduced AbsFun bots to AbsBot
309 sameVal AbsTop AbsTop = True
310 sameVal AbsTop other = False -- Right?
312 sameVal (AbsProd vals1) (AbsProd vals2) = ASSERT (length vals1 == length vals2)
313 and (zipWith sameVal vals1 vals2)
314 sameVal (AbsProd _) AbsTop = False
315 sameVal (AbsProd _) AbsBot = False
317 sameVal (AbsApproxFun str1) (AbsApproxFun str2) = str1 == str2
318 sameVal (AbsApproxFun _) AbsTop = False
319 sameVal (AbsApproxFun _) AbsBot = False
321 sameVal val1 val2 = panic "sameVal: type mismatch or AbsFun encountered"
325 @evalStrictness@ compares a @Demand@ with an abstract value, returning
326 @True@ iff the abstract value is {\em less defined} than the demand.
327 (@True@ is the exciting answer; @False@ is always safe.)
330 evalStrictness :: Demand
332 -> Bool -- True iff the value is sure
333 -- to be less defined than the Demand
335 evalStrictness (WwLazy _) _ = False
336 evalStrictness WwStrict val = isBot val
337 evalStrictness WwEnum val = isBot val
339 evalStrictness (WwUnpack demand_info) val
343 AbsProd vals -> ASSERT (length vals == length demand_info)
344 or (zipWith evalStrictness demand_info vals)
345 _ -> trace "evalStrictness?" False
347 evalStrictness WwPrim val
351 other -> -- A primitive value should be defined, never bottom;
352 -- hence this paranoia check
353 pprPanic "evalStrictness: WwPrim:" (ppr PprDebug other)
356 For absence analysis, we're interested in whether "poison" in the
357 argument (ie a bottom therein) can propagate to the result of the
358 function call; that is, whether the specified demand can {\em
359 possibly} hit poison.
362 evalAbsence (WwLazy True) _ = False -- Can't possibly hit poison
363 -- with Absent demand
365 evalAbsence (WwUnpack demand_info) val
367 AbsTop -> False -- No poison in here
368 AbsBot -> True -- Pure poison
369 AbsProd vals -> ASSERT (length demand_info == length vals)
370 or (zipWith evalAbsence demand_info vals)
371 _ -> panic "evalAbsence: other"
373 evalAbsence other val = anyBot val
374 -- The demand is conservative; even "Lazy" *might* evaluate the
375 -- argument arbitrarily so we have to look everywhere for poison
378 %************************************************************************
380 \subsection[absEval]{Evaluate an expression in the abstract domain}
382 %************************************************************************
385 -- The isBottomingId stuf is now dealt with via the Id's strictness info
386 -- absId anal var env | isBottomingId var
388 -- StrAnal -> AbsBot -- See discussion below
389 -- AbsAnal -> AbsTop -- Just want to see if there's any poison in
395 case (lookupAbsValEnv env var, getIdStrictness var, getIdUnfolding var) of
397 (Just abs_val, _, _) ->
398 abs_val -- Bound in the environment
400 (Nothing, NoStrictnessInfo, LiteralForm _) ->
401 AbsTop -- Literals all terminate, and have no poison
403 (Nothing, NoStrictnessInfo, ConstructorForm _ _ _) ->
404 AbsTop -- An imported constructor won't have
405 -- bottom components, nor poison!
407 (Nothing, NoStrictnessInfo, GeneralForm _ _ 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 MagicForm, IWantToBeINLINEd, NoUnfoldingDetails
434 -- Try the strictness info
435 absValFromStrictness anal strictness_info
438 -- Done via strictness now
439 -- GeneralForm _ BottomForm _ _ -> AbsBot
441 -- pprTrace "absId:" (ppBesides [ppr PprDebug var, ppStr "=:", pp_anal anal, ppStr ":=",ppr PprDebug result]) (
445 pp_anal StrAnal = ppStr "STR"
446 pp_anal AbsAnal = ppStr "ABS"
448 absEvalAtom anal (CoVarAtom v) env = absId anal v env
449 absEvalAtom anal (CoLitAtom _) env = AbsTop
453 absEval :: AnalysisKind -> PlainCoreExpr -> AbsValEnv -> AbsVal
455 absEval anal (CoVar var) env = absId anal var env
457 absEval anal (CoLit _) env = AbsTop
458 -- What if an unboxed literal? That's OK: it terminates, so its
459 -- abstract value is AbsTop.
461 -- For absence analysis, a literal certainly isn't the "poison" variable
464 Discussion about \tr{error} (following/quoting Lennart): Any expression
465 \tr{error e} is regarded as bottom (with HBC, with the
466 \tr{-ffail-strict} flag, on with \tr{-O}).
468 Regarding it as bottom gives much better strictness properties for
472 f (x:xs) y = f xs (x+y)
474 f [] _ = error "no match"
476 f (x:xs) y = f xs (x+y)
478 is strict in \tr{y}, which you really want. But, it may lead to
479 transformations that turn a call to \tr{error} into non-termination.
480 (The odds of this happening aren't good.)
483 Things are a little different for absence analysis, because we want
484 to make sure that any poison (?????)
487 absEval StrAnal (CoPrim SeqOp [t] [e]) env
488 = if isBot (absEvalAtom StrAnal e env) then AbsBot else AbsTop
489 -- This is a special case to ensure that seq# is strict in its argument.
490 -- The comments below (for most normal PrimOps) do not apply.
492 absEval StrAnal (CoPrim op ts es) env = AbsTop
493 -- The arguments are all of unboxed type, so they will already
494 -- have been eval'd. If the boxed version was bottom, we'll
495 -- already have returned bottom.
497 -- Actually, I believe we are saying that either (1) the
498 -- primOp uses unboxed args and they've been eval'ed, so
499 -- there's no need to force strictness here, _or_ the primOp
500 -- uses boxed args and we don't know whether or not it's
501 -- strict, so we assume laziness. (JSM)
503 absEval AbsAnal (CoPrim op ts as) env
504 = if any anyBot [absEvalAtom AbsAnal a env | a <- as]
507 -- For absence analysis, we want to see if the poison shows up...
509 absEval anal (CoCon con ts as) env
511 = AbsProd [absEvalAtom anal a env | a <- as]
513 | otherwise -- Not single-constructor
515 StrAnal -> -- Strictness case: it's easy: it certainly terminates
517 AbsAnal -> -- In the absence case we need to be more
518 -- careful: look to see if there's any
519 -- poison in the components
520 if any anyBot [absEvalAtom AbsAnal a env | a <- as]
524 (_,_,_, tycon) = getDataConSig con
525 has_single_con = maybeToBool (maybeSingleConstructorTyCon tycon)
529 absEval anal (CoLam [] body) env = absEval anal body env -- paranoia
530 absEval anal (CoLam binders body) env = AbsFun binders body env
531 absEval anal (CoTyLam ty expr) env = absEval anal expr env
532 absEval anal (CoApp e1 e2) env = absApply anal (absEval anal e1 env)
533 (absEvalAtom anal e2 env)
534 absEval anal (CoTyApp expr ty) env = absEval anal expr env
537 For primitive cases, just GLB the branches, then LUB with the expr part.
540 absEval anal (CoCase expr (CoPrimAlts alts deflt)) env
542 expr_val = absEval anal expr env
543 abs_alts = [ absEval anal rhs env | (_, rhs) <- alts ]
544 -- Don't bother to extend envt, because unbound vars
545 -- default to the conservative AbsTop
547 abs_deflt = absEvalDefault anal expr_val deflt env
549 combineCaseValues anal expr_val
550 (abs_deflt ++ abs_alts)
552 absEval anal (CoCase expr (CoAlgAlts alts deflt)) env
554 expr_val = absEval anal expr env
555 abs_alts = [ absEvalAlgAlt anal expr_val alt env | alt <- alts ]
556 abs_deflt = absEvalDefault anal expr_val deflt env
560 combineCaseValues anal expr_val
561 (abs_deflt ++ abs_alts)
566 _ -> 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)))
572 For @CoLets@ we widen the value we get. This is nothing to
573 do with fixpointing. The reason is so that we don't get an explosion
574 in the amount of computation. For example, consider:
586 If we bind @f@ and @g@ to their exact abstract value, then we'll
587 ``execute'' one call to @f@ and {\em two} calls to @g@. This can blow
588 up exponentially. Widening cuts it off by making a fixed
589 approximation to @f@ and @g@, so that the bodies of @f@ and @g@ are
590 not evaluated again at all when they are called.
592 Of course, this can lose useful joint strictness, which is sad. An
593 alternative approach would be to try with a certain amount of ``fuel''
594 and be prepared to bale out.
597 absEval anal (CoLet (CoNonRec binder e1) e2) env
599 new_env = addOneToAbsValEnv env binder (widen anal (absEval anal e1 env))
601 -- The binder of a CoNonRec should *not* be of unboxed type,
602 -- hence no need to strictly evaluate the Rhs.
603 absEval anal e2 new_env
605 absEval anal (CoLet (CoRec pairs) body) env
607 (binders,rhss) = unzip pairs
608 rhs_vals = cheapFixpoint anal binders rhss env -- Returns widened values
609 new_env = growAbsValEnvList env (binders `zip` rhs_vals)
611 absEval anal body new_env
615 absEval anal (CoSCC cc expr) env = absEval anal expr env
617 -- ToDo: add DPH stuff here
621 absEvalAlgAlt :: AnalysisKind -> AbsVal -> (Id,[Id],PlainCoreExpr) -> AbsValEnv -> AbsVal
623 absEvalAlgAlt anal (AbsProd arg_vals) (con, args, rhs) env
624 = -- The scrutinee is a product value, so it must be of a single-constr
625 -- type; so the constructor in this alternative must be the right one
626 -- so we can go ahead and bind the constructor args to the components
627 -- of the product value.
628 ASSERT(length arg_vals == length args)
630 new_env = growAbsValEnvList env (args `zip` arg_vals)
632 absEval anal rhs new_env
634 absEvalAlgAlt anal other_scrutinee (con, args, rhs) env
635 = -- Scrutinised value is Top or Bot (it can't be a function!)
636 -- So just evaluate the rhs with all constr args bound to Top.
637 -- (If the scrutinee is Top we'll never evaluated this function
643 = case other_scrutinee of {
644 AbsTop -> True; -- i.e., OK
645 AbsBot -> True; -- ditto
646 _ -> False -- party over
650 absEvalDefault :: AnalysisKind
651 -> AbsVal -- Value of scrutinee
652 -> PlainCoreCaseDefault
654 -> [AbsVal] -- Empty or singleton
656 absEvalDefault anal scrut_val CoNoDefault env = []
657 absEvalDefault anal scrut_val (CoBindDefault binder expr) env
658 = [absEval anal expr (addOneToAbsValEnv env binder scrut_val)]
661 %************************************************************************
663 \subsection[absApply]{Apply an abstract function to an abstract argument}
665 %************************************************************************
670 absApply :: AnalysisKind -> AbsVal -> AbsVal -> AbsVal
672 absApply anal AbsBot arg = AbsBot
673 -- AbsBot represents the abstract bottom *function* too
675 absApply StrAnal AbsTop arg = AbsTop
676 absApply AbsAnal AbsTop arg = if anyBot arg
679 -- To be conservative, we have to assume that a function about
680 -- which we know nothing (AbsTop) might look at some part of
684 An @AbsFun@ with only one more argument needed---bind it and eval the
685 result. A @CoLam@ with two or more args: return another @AbsFun@ with
686 an augmented environment.
689 absApply anal (AbsFun [binder] body env) arg
690 = absEval anal body (addOneToAbsValEnv env binder arg)
692 absApply anal (AbsFun (binder:bs) body env) arg
693 = AbsFun bs body (addOneToAbsValEnv env binder arg)
697 absApply StrAnal (AbsApproxFun (arg1_demand:ds)) arg
698 = if evalStrictness arg1_demand arg
702 other -> AbsApproxFun ds
704 absApply AbsAnal (AbsApproxFun (arg1_demand:ds)) arg
705 = if evalAbsence arg1_demand arg
709 other -> AbsApproxFun ds
712 absApply anal (AbsApproxFun []) arg = panic ("absApply: Duff function: AbsApproxFun." ++ show anal)
713 absApply anal (AbsFun [] _ _) arg = panic ("absApply: Duff function: AbsFun." ++ show anal)
714 absApply anal (AbsProd _) arg = panic ("absApply: Duff function: AbsProd." ++ show anal)
721 %************************************************************************
723 \subsection[findStrictness]{Determine some binders' strictness}
725 %************************************************************************
727 @findStrictness@ applies the function \tr{\ ids -> expr} to
728 \tr{[bot,top,top,...]}, \tr{[top,bot,top,top,...]}, etc., (i.e., once
729 with @AbsBot@ in each argument position), and evaluates the resulting
730 abstract value; it returns a vector of @Demand@s saying whether the
731 result of doing this is guaranteed to be bottom. This tells the
732 strictness of the function in each of the arguments.
734 If an argument is of unboxed type, then we declare that function to be
735 strict in that argument.
737 We don't really have to make up all those lists of mostly-@AbsTops@;
738 unbound variables in an @AbsValEnv@ are implicitly mapped to that.
740 See notes on @addStrictnessInfoToId@.
743 findStrictness :: StrAnalFlags
744 -> [UniType] -- Types of args in which strictness is wanted
745 -> AbsVal -- Abstract strictness value of function
746 -> AbsVal -- Abstract absence value of function
747 -> [Demand] -- Resulting strictness annotation
749 findStrictness strflags [] str_val abs_val = []
751 findStrictness strflags (ty:tys) str_val abs_val
753 demand = findRecDemand strflags [] str_fn abs_fn ty
754 str_fn val = absApply StrAnal str_val val
755 abs_fn val = absApply AbsAnal abs_val val
757 demands = findStrictness strflags tys
758 (absApply StrAnal str_val AbsTop)
759 (absApply AbsAnal abs_val AbsTop)
766 findDemandStrOnly str_env expr binder -- Only strictness environment available
767 = findRecDemand strflags [] str_fn abs_fn (getIdUniType binder)
769 str_fn val = absEval StrAnal expr (addOneToAbsValEnv str_env binder val)
770 abs_fn val = AbsBot -- Always says poison; so it looks as if
771 -- nothing is absent; safe
772 strflags = getStrAnalFlags str_env
774 findDemandAbsOnly abs_env expr binder -- Only absence environment available
775 = findRecDemand strflags [] str_fn abs_fn (getIdUniType binder)
777 str_fn val = AbsBot -- Always says non-termination;
778 -- that'll make findRecDemand peer into the
779 -- structure of the value.
780 abs_fn val = absEval AbsAnal expr (addOneToAbsValEnv abs_env binder val)
781 strflags = getStrAnalFlags abs_env
784 findDemand str_env abs_env expr binder
785 = findRecDemand strflags [] str_fn abs_fn (getIdUniType binder)
787 str_fn val = absEval StrAnal expr (addOneToAbsValEnv str_env binder val)
788 abs_fn val = absEval AbsAnal expr (addOneToAbsValEnv abs_env binder val)
789 strflags = getStrAnalFlags str_env
792 @findRecDemand@ is where we finally convert strictness/absence info
793 into ``Demands'' which we can pin on Ids (etc.).
795 NOTE: What do we do if something is {\em both} strict and absent?
796 Should \tr{f x y z = error "foo"} says that \tr{f}'s arguments are all
797 strict (because of bottoming effect of \tr{error}) or all absent
798 (because they're not used)?
800 Well, for practical reasons, we prefer absence over strictness. In
801 particular, it makes the ``default defaults'' for class methods (the
802 ones that say \tr{defm.foo dict = error "I don't exist"}) come out
803 nicely [saying ``the dict isn't used''], rather than saying it is
804 strict in every component of the dictionary [massive gratuitious
805 casing to take the dict apart].
807 But you could have examples where going for strictness would be better
808 than absence. Consider:
810 let x = something big
815 If \tr{x} is marked absent in \tr{f}, but not strict, and \tr{g} is
816 lazy, then the thunk for \tr{x} will be built. If \tr{f} was strict,
817 then we'd let-to-case it:
819 case something big of
825 findRecDemand :: StrAnalFlags
826 -> [TyCon] -- TyCons already seen; used to avoid
827 -- zooming into recursive types
828 -> (AbsVal -> AbsVal) -- The strictness function
829 -> (AbsVal -> AbsVal) -- The absence function
830 -> UniType -- The type of the argument
833 findRecDemand strflags seen str_fn abs_fn ty
834 = if isPrimType ty then -- It's a primitive type!
837 else if not (anyBot (abs_fn AbsBot)) then -- It's absent
838 -- We prefer absence over strictness: see NOTE above.
841 else if not (all_strict ||
842 (num_strict && is_numeric_type ty) ||
843 (isBot (str_fn AbsBot))) then
844 WwLazy False -- It's not strict and we're not pretending
846 else -- It's strict (or we're pretending it is)!
848 case getUniDataTyCon_maybe ty of
852 Just (tycon,tycon_arg_tys,[data_con]) | tycon `not_elem` seen ->
853 -- Single constructor case, tycon not already seen higher up
855 (_,cmpnt_tys,_) = getInstantiatedDataConSig data_con tycon_arg_tys
856 prod_len = length cmpnt_tys
859 = [ findRecDemand strflags (tycon:seen)
861 str_fn (mkMainlyTopProd prod_len i cmpnt_val)
864 abs_fn (mkMainlyTopProd prod_len i cmpnt_val)
867 | (cmpnt_ty, i) <- cmpnt_tys `zip` [1..] ]
869 if null compt_strict_infos then
870 if isEnumerationTyCon tycon then wwEnum else wwStrict
872 wwUnpack compt_strict_infos
874 not_elem = isn'tIn "findRecDemand"
877 -- Multi-constr data types, *or* an abstract data
878 -- types, *or* things we don't have a way of conveying
879 -- the info over module boundaries (class ops,
880 -- superdict sels, dfns).
881 if isEnumerationTyCon tycon then
886 (all_strict, num_strict) = strflags
889 = case (getUniDataTyCon_maybe ty) of -- NB: duplicates stuff done above
893 [intTyCon, integerTyCon,
894 doubleTyCon, floatTyCon,
895 wordTyCon, addrTyCon]
897 _{-something else-} -> False
899 is_elem = isIn "is_numeric_type"
901 -- mkMainlyTopProd: make an AbsProd that is all AbsTops ("n"-1 of
902 -- them) except for a given value in the "i"th position.
904 mkMainlyTopProd :: Int -> Int -> AbsVal -> AbsVal
906 mkMainlyTopProd n i val
908 befores = nOfThem (i-1) AbsTop
909 afters = nOfThem (n-i) AbsTop
911 AbsProd (befores ++ (val : afters))
914 %************************************************************************
916 \subsection[fixpoint]{Fixpointer for the strictness analyser}
918 %************************************************************************
920 The @fixpoint@ functions take a list of \tr{(binder, expr)} pairs, an
921 environment, and returns the abstract value of each binder.
923 The @cheapFixpoint@ function makes a conservative approximation,
924 by binding each of the variables to Top in their own right hand sides.
925 That allows us to make rapid progress, at the cost of a less-than-wonderful
929 cheapFixpoint :: AnalysisKind -> [Id] -> [PlainCoreExpr] -> AbsValEnv -> [AbsVal]
931 cheapFixpoint AbsAnal [id] [rhs] env
932 = [crudeAbsWiden (absEval AbsAnal rhs new_env)]
934 new_env = addOneToAbsValEnv env id AbsTop -- Unsafe starting point!
935 -- In the just-one-binding case, we guarantee to
936 -- find a fixed point in just one iteration,
937 -- because we are using only a two-point domain.
938 -- This improves matters in cases like:
940 -- f x y = letrec g = ...g...
943 -- Here, y isn't used at all, but if g is bound to
944 -- AbsBot we simply get AbsBot as the next
947 cheapFixpoint anal ids rhss env
948 = [widen anal (absEval anal rhs new_env) | rhs <- rhss]
949 -- We do just one iteration, starting from a safe
950 -- approximation. This won't do a good job in situations
952 -- \x -> letrec f = ...g...
956 -- Here, f will end up bound to Top after one iteration,
957 -- and hence we won't spot the strictness in x.
958 -- (A second iteration would solve this. ToDo: try the effect of
959 -- really searching for a fixed point.)
961 new_env = growAbsValEnvList env [(id,safe_val) | id <- ids]
964 = case anal of -- The safe starting point
970 mkLookupFun :: (key -> key -> Bool) -- Equality predicate
971 -> (key -> key -> Bool) -- Less-than predicate
972 -> [(key,val)] -- The assoc list
974 -> Maybe val -- The corresponding value
976 mkLookupFun eq lt alist s
977 = case [a | (s',a) <- alist, s' `eq` s] of
983 fixpoint :: AnalysisKind -> [Id] -> [PlainCoreExpr] -> AbsValEnv -> [AbsVal]
985 fixpoint anal [] _ env = []
987 fixpoint anal ids rhss env
988 = fix_loop initial_vals
991 = case anal of -- The (unsafe) starting point
992 StrAnal -> if (returnsRealWorld (getIdUniType id))
993 then AbsTop -- this is a massively horrible hack (SLPJ 95/05)
997 initial_vals = [ initial_val id | id <- ids ]
999 fix_loop :: [AbsVal] -> [AbsVal]
1001 fix_loop current_widened_vals
1003 new_env = growAbsValEnvList env (ids `zip` current_widened_vals)
1004 new_vals = [ absEval anal rhs new_env | rhs <- rhss ]
1005 new_widened_vals = map (widen anal) new_vals
1007 if (and (zipWith sameVal current_widened_vals new_widened_vals)) then
1008 current_widened_vals
1010 -- Return the widened values. We might get a slightly
1011 -- better value by returning new_vals (which we used to
1012 -- do, see below), but alas that means that whenever the
1013 -- function is called we have to re-execute it, which is
1018 -- Return the un-widened values which may be a bit better
1019 -- than the widened ones, and are guaranteed safe, since
1020 -- they are one iteration beyond current_widened_vals,
1021 -- which itself is a fixed point.
1023 fix_loop new_widened_vals
1026 For absence analysis, we make do with a very very simple approach:
1027 look for convergence in a two-point domain.
1029 We used to use just one iteration, starting with the variables bound
1030 to @AbsBot@, which is safe.
1032 Prior to that, we used one iteration starting from @AbsTop@ (which
1033 isn't safe). Why isn't @AbsTop@ safe? Consider:
1041 Here, if p is @AbsBot@, then we'd better {\em not} end up with a ``fixed
1042 point'' of @d@ being @(AbsTop, AbsTop)@! An @AbsBot@ initial value is
1043 safe because it gives poison more often than really necessary, and
1044 thus may miss some absence, but will never claim absence when it ain't
1047 Anyway, one iteration starting with everything bound to @AbsBot@ give
1052 Here, f would always end up bound to @AbsBot@, which ain't very
1053 clever, because then it would introduce poison whenever it was
1054 applied. Much better to start with f bound to @AbsTop@, and widen it
1055 to @AbsBot@ if any poison shows up. In effect we look for convergence
1056 in the two-point @AbsTop@/@AbsBot@ domain.
1058 What we miss (compared with the cleverer strictness analysis) is
1059 spotting that in this case
1061 f = \ x y -> ...y...(f x y')...
1063 \tr{x} is actually absent, since it is only passed round the loop, never
1064 used. But who cares about missing that?
1066 NB: despite only having a two-point domain, we may still have many
1067 iterations, because there are several variables involved at once.