2 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1996
4 \section[SaAbsInt]{Abstract interpreter for strictness analysis}
7 #include "HsVersions.h"
18 IMPORT_Trace -- ToDo: rm
23 import PrelInfo ( PrimOp(..),
24 intTyCon, integerTyCon, doubleTyCon,
25 floatTyCon, wordTyCon, addrTyCon,
28 import Type ( isPrimType, maybeDataTyCon,
29 maybeSingleConstructorTyCon,
31 isEnumerationTyCon, TyVarTemplate, TyCon
33 import CoreUtils ( unTagBinders )
34 import Id ( getIdStrictness, idType, getIdUnfolding,
35 getDataConSig, getInstantiatedDataConSig,
36 DataCon(..), isBottomingId
38 import IdInfo -- various bits
39 import Maybes ( maybeToBool, Maybe(..) )
44 %************************************************************************
46 \subsection[AbsVal-ops]{Operations on @AbsVals@}
48 %************************************************************************
50 Least upper bound, greatest lower bound.
53 lub, glb :: AbsVal -> AbsVal -> AbsVal
55 lub val1 val2 | isBot val1 = val2 -- The isBot test includes the case where
56 lub val1 val2 | isBot val2 = val1 -- one of the val's is a function which
57 -- always returns bottom, such as \y.x,
58 -- when x is bound to bottom.
60 lub (AbsProd xs) (AbsProd ys) = AbsProd (zipWithEqual lub xs ys)
62 lub _ _ = AbsTop -- Crude, but conservative
63 -- The crudity only shows up if there
64 -- are functions involved
66 -- Slightly funny glb; for absence analysis only;
67 -- AbsBot is the safe answer.
69 -- Using anyBot rather than just testing for AbsBot is important.
74 -- g = \x y z -> case x of
78 -- Now, the abstract value of the branches of the case will be an
79 -- AbsFun, but when testing for z's absence we want to spot that it's
80 -- an AbsFun which can't possibly return AbsBot. So when glb'ing we
81 -- mustn't be too keen to bale out and return AbsBot; the anyBot test
82 -- spots that (f x) can't possibly return AbsBot.
84 -- We have also tripped over the following interesting case:
89 -- Now, suppose f is bound to AbsTop. Does this expression mention z?
90 -- Obviously not. But the case will take the glb of AbsTop (for f) and
91 -- an AbsFun (for \y->1). We should not bale out and give AbsBot, because
92 -- that would say that it *does* mention z (or anything else for that matter).
93 -- Nor can we always return AbsTop, because the AbsFun might be something
94 -- like (\y->z), which obviously does mention z. The point is that we're
95 -- glbing two functions, and AbsTop is not actually the top of the function
96 -- lattice. It is more like (\xyz -> x|y|z); that is, AbsTop returns
97 -- poison iff any of its arguments do.
99 -- Deal with functions specially, because AbsTop isn't the
100 -- top of their domain.
103 | is_fun v1 || is_fun v2
104 = if not (anyBot v1) && not (anyBot v2)
110 is_fun (AbsFun _ _ _) = True
111 is_fun (AbsApproxFun _) = True -- Not used, but the glb works ok
114 -- The non-functional cases are quite straightforward
116 glb (AbsProd xs) (AbsProd ys) = AbsProd (zipWithEqual glb xs ys)
121 glb _ _ = AbsBot -- Be pessimistic
127 -> AbsVal -- Value of scrutinee
128 -> [AbsVal] -- Value of branches (at least one)
131 -- For strictness analysis, see if the scrutinee is bottom; if so
132 -- return bottom; otherwise, the lub of the branches.
134 combineCaseValues StrAnal AbsBot branches = AbsBot
135 combineCaseValues StrAnal other_scrutinee branches
136 -- Scrutinee can only be AbsBot, AbsProd or AbsTop
137 = ASSERT(ok_scrutinee)
141 = case other_scrutinee of {
142 AbsTop -> True; -- i.e., cool
143 AbsProd _ -> True; -- ditto
144 _ -> False -- party over
147 -- For absence analysis, check if the scrutinee is all poison (isBot)
148 -- If so, return poison (AbsBot); otherwise, any nested poison will come
149 -- out from looking at the branches, so just glb together the branches
150 -- to get the worst one.
152 combineCaseValues AbsAnal AbsBot branches = AbsBot
153 combineCaseValues AbsAnal other_scrutinee branches
154 -- Scrutinee can only be AbsBot, AbsProd or AbsTop
155 = ASSERT(ok_scrutinee)
157 result = foldr1 glb branches
159 tracer = if at_least_one_AbsFun && at_least_one_AbsTop
161 pprTrace "combineCase:" (ppr PprDebug branches)
170 = case other_scrutinee of {
171 AbsTop -> True; -- i.e., cool
172 AbsProd _ -> True; -- ditto
173 _ -> False -- party over
176 at_least_one_AbsFun = foldr ((||) . is_AbsFun) False branches
177 at_least_one_AbsTop = foldr ((||) . is_AbsTop) False branches
178 no_AbsBots = foldr ((&&) . is_not_AbsBot) True branches
180 is_AbsFun x = case x of { AbsFun _ _ _ -> True; _ -> False }
181 is_AbsTop x = case x of { AbsTop -> True; _ -> False }
182 is_not_AbsBot x = case x of { AbsBot -> False; _ -> True }
185 @isBot@ returns True if its argument is (a representation of) bottom. The
186 ``representation'' part is because we need to detect the bottom {\em function}
187 too. To detect the bottom function, bind its args to top, and see if it
190 Used only in strictness analysis:
192 isBot :: AbsVal -> Bool
195 isBot (AbsFun args body env) = isBot (absEval StrAnal body env)
196 -- Don't bother to extend the envt because
197 -- unbound variables default to AbsTop anyway
201 Used only in absence analysis:
203 anyBot :: AbsVal -> Bool
205 anyBot AbsBot = True -- poisoned!
206 anyBot AbsTop = False
207 anyBot (AbsProd vals) = any anyBot vals
208 anyBot (AbsFun args body env) = anyBot (absEval AbsAnal body env)
209 anyBot (AbsApproxFun demands) = False
211 -- AbsApproxFun can only arise in absence analysis from the Demand
212 -- info of an imported value; whatever it is we're looking for is
213 -- certainly not present over in the imported value.
216 @widen@ takes an @AbsVal@, $val$, and returns and @AbsVal@ which is
217 approximated by $val$. Furthermore, the result has no @AbsFun@s in
218 it, so it can be compared for equality by @sameVal@.
221 widen :: AnalysisKind -> AbsVal -> AbsVal
223 widen StrAnal (AbsFun args body env)
224 | isBot (absEval StrAnal body env) = AbsBot
226 = ASSERT (not (null args))
227 AbsApproxFun (map (findDemandStrOnly env body) args)
229 -- It's worth checking for a function which is unconditionally
232 -- f x y = let g y = case x of ...
233 -- in (g ..) + (g ..)
235 -- Here, when we are considering strictness of f in x, we'll
236 -- evaluate the body of f with x bound to bottom. The current
237 -- strategy is to bind g to its *widened* value; without the isBot
238 -- (...) test above, we'd bind g to an AbsApproxFun, and deliver
239 -- Top, not Bot as the value of f's rhs. The test spots the
240 -- unconditional bottom-ness of g when x is bottom. (Another
241 -- alternative here would be to bind g to its exact abstract
242 -- value, but that entails lots of potential re-computation, at
243 -- every application of g.)
245 widen StrAnal (AbsProd vals) = AbsProd (map (widen StrAnal) vals)
246 widen StrAnal other_val = other_val
249 widen AbsAnal (AbsFun args body env)
250 | anyBot (absEval AbsAnal body env) = AbsBot
251 -- In the absence-analysis case it's *essential* to check
252 -- that the function has no poison in its body. If it does,
253 -- anywhere, then the whole function is poisonous.
256 = ASSERT (not (null args))
257 AbsApproxFun (map (findDemandAbsOnly env body) args)
259 widen AbsAnal (AbsProd vals) = AbsProd (map (widen AbsAnal) vals)
261 -- It's desirable to do a good job of widening for product
265 -- in ...(case p of (x,y) -> x)...
267 -- Now, is y absent in this expression? Currently the
268 -- analyser widens p before looking at p's scope, to avoid
269 -- lots of recomputation in the case where p is a function.
270 -- So if widening doesn't have a case for products, we'll
271 -- widen p to AbsBot (since when searching for absence in y we
272 -- bind y to poison ie AbsBot), and now we are lost.
274 widen AbsAnal other_val = other_val
276 -- WAS: if anyBot val then AbsBot else AbsTop
277 -- Nowadays widen is doing a better job on functions for absence analysis.
280 @crudeAbsWiden@ is used just for absence analysis, and always
281 returns AbsTop or AbsBot, so it widens to a two-point domain
284 crudeAbsWiden :: AbsVal -> AbsVal
285 crudeAbsWiden val = if anyBot val then AbsBot else AbsTop
288 @sameVal@ compares two abstract values for equality. It can't deal with
289 @AbsFun@, but that should have been removed earlier in the day by @widen@.
292 sameVal :: AbsVal -> AbsVal -> Bool -- Can't handle AbsFun!
295 sameVal (AbsFun _ _ _) _ = panic "sameVal: AbsFun: arg1"
296 sameVal _ (AbsFun _ _ _) = panic "sameVal: AbsFun: arg2"
299 sameVal AbsBot AbsBot = True
300 sameVal AbsBot other = False -- widen has reduced AbsFun bots to AbsBot
302 sameVal AbsTop AbsTop = True
303 sameVal AbsTop other = False -- Right?
305 sameVal (AbsProd vals1) (AbsProd vals2) = and (zipWithEqual sameVal vals1 vals2)
306 sameVal (AbsProd _) AbsTop = False
307 sameVal (AbsProd _) AbsBot = False
309 sameVal (AbsApproxFun str1) (AbsApproxFun str2) = str1 == str2
310 sameVal (AbsApproxFun _) AbsTop = False
311 sameVal (AbsApproxFun _) AbsBot = False
313 sameVal val1 val2 = panic "sameVal: type mismatch or AbsFun encountered"
317 @evalStrictness@ compares a @Demand@ with an abstract value, returning
318 @True@ iff the abstract value is {\em less defined} than the demand.
319 (@True@ is the exciting answer; @False@ is always safe.)
322 evalStrictness :: Demand
324 -> Bool -- True iff the value is sure
325 -- to be less defined than the Demand
327 evalStrictness (WwLazy _) _ = False
328 evalStrictness WwStrict val = isBot val
329 evalStrictness WwEnum val = isBot val
331 evalStrictness (WwUnpack demand_info) val
335 AbsProd vals -> or (zipWithEqual evalStrictness demand_info vals)
336 _ -> trace "evalStrictness?" False
338 evalStrictness WwPrim val
342 other -> -- A primitive value should be defined, never bottom;
343 -- hence this paranoia check
344 pprPanic "evalStrictness: WwPrim:" (ppr PprDebug other)
347 For absence analysis, we're interested in whether "poison" in the
348 argument (ie a bottom therein) can propagate to the result of the
349 function call; that is, whether the specified demand can {\em
350 possibly} hit poison.
353 evalAbsence (WwLazy True) _ = False -- Can't possibly hit poison
354 -- with Absent demand
356 evalAbsence (WwUnpack demand_info) val
358 AbsTop -> False -- No poison in here
359 AbsBot -> True -- Pure poison
360 AbsProd vals -> or (zipWithEqual evalAbsence demand_info vals)
361 _ -> panic "evalAbsence: other"
363 evalAbsence other val = anyBot val
364 -- The demand is conservative; even "Lazy" *might* evaluate the
365 -- argument arbitrarily so we have to look everywhere for poison
368 %************************************************************************
370 \subsection[absEval]{Evaluate an expression in the abstract domain}
372 %************************************************************************
375 -- The isBottomingId stuf is now dealt with via the Id's strictness info
376 -- absId anal var env | isBottomingId var
378 -- StrAnal -> AbsBot -- See discussion below
379 -- AbsAnal -> AbsTop -- Just want to see if there's any poison in
385 case (lookupAbsValEnv env var, getIdStrictness var, getIdUnfolding var) of
387 (Just abs_val, _, _) ->
388 abs_val -- Bound in the environment
390 (Nothing, NoStrictnessInfo, LitForm _) ->
391 AbsTop -- Literals all terminate, and have no poison
393 (Nothing, NoStrictnessInfo, ConForm _ _ _) ->
394 AbsTop -- An imported constructor won't have
395 -- bottom components, nor poison!
397 (Nothing, NoStrictnessInfo, GenForm _ _ unfolding _) ->
398 -- We have an unfolding for the expr
399 -- Assume the unfolding has no free variables since it
400 -- came from inside the Id
401 absEval anal (unTagBinders unfolding) env
402 -- Notice here that we only look in the unfolding if we don't
403 -- have strictness info (an unusual situation).
404 -- We could have chosen to look in the unfolding if it exists,
405 -- and only try the strictness info if it doesn't, and that would
406 -- give more accurate results, at the cost of re-abstract-interpreting
407 -- the unfolding every time.
408 -- We found only one place where the look-at-unfolding-first
409 -- method gave better results, which is in the definition of
410 -- showInt in the Prelude. In its defintion, fromIntegral is
411 -- not inlined (it's big) but ab-interp-ing its unfolding gave
412 -- a better result than looking at its strictness only.
413 -- showInt :: Integral a => a -> [Char] -> [Char]
414 -- ! {-# GHC_PRAGMA _A_ 1 _U_ 122 _S_
415 -- "U(U(U(U(SA)AAAAAAAAL)AA)AAAAASAAASA)" {...} _N_ _N_ #-}
417 -- showInt :: Integral a => a -> [Char] -> [Char]
418 -- ! {-# GHC_PRAGMA _A_ 1 _U_ 122 _S_
419 -- "U(U(U(U(SL)LLLLLLLLL)LL)LLLLLSLLLLL)" _N_ _N_ #-}
422 (Nothing, strictness_info, _) ->
423 -- Includes MagicForm, IWantToBeINLINEd, NoUnfoldingDetails
424 -- Try the strictness info
425 absValFromStrictness anal strictness_info
428 -- Done via strictness now
429 -- GenForm _ BottomForm _ _ -> AbsBot
431 -- pprTrace "absId:" (ppBesides [ppr PprDebug var, ppStr "=:", pp_anal anal, ppStr ":=",ppr PprDebug result]) (
435 pp_anal StrAnal = ppStr "STR"
436 pp_anal AbsAnal = ppStr "ABS"
438 absEvalAtom anal (VarArg v) env = absId anal v env
439 absEvalAtom anal (LitArg _) env = AbsTop
443 absEval :: AnalysisKind -> CoreExpr -> AbsValEnv -> AbsVal
445 absEval anal (Var var) env = absId anal var env
447 absEval anal (Lit _) env = AbsTop
448 -- What if an unboxed literal? That's OK: it terminates, so its
449 -- abstract value is AbsTop.
451 -- For absence analysis, a literal certainly isn't the "poison" variable
454 Discussion about \tr{error} (following/quoting Lennart): Any expression
455 \tr{error e} is regarded as bottom (with HBC, with the
456 \tr{-ffail-strict} flag, on with \tr{-O}).
458 Regarding it as bottom gives much better strictness properties for
462 f (x:xs) y = f xs (x+y)
464 f [] _ = error "no match"
466 f (x:xs) y = f xs (x+y)
468 is strict in \tr{y}, which you really want. But, it may lead to
469 transformations that turn a call to \tr{error} into non-termination.
470 (The odds of this happening aren't good.)
473 Things are a little different for absence analysis, because we want
474 to make sure that any poison (?????)
477 absEval StrAnal (Prim SeqOp [t] [e]) env
478 = if isBot (absEvalAtom StrAnal e env) then AbsBot else AbsTop
479 -- This is a special case to ensure that seq# is strict in its argument.
480 -- The comments below (for most normal PrimOps) do not apply.
482 absEval StrAnal (Prim op ts es) env = AbsTop
483 -- The arguments are all of unboxed type, so they will already
484 -- have been eval'd. If the boxed version was bottom, we'll
485 -- already have returned bottom.
487 -- Actually, I believe we are saying that either (1) the
488 -- primOp uses unboxed args and they've been eval'ed, so
489 -- there's no need to force strictness here, _or_ the primOp
490 -- uses boxed args and we don't know whether or not it's
491 -- strict, so we assume laziness. (JSM)
493 absEval AbsAnal (Prim op ts as) env
494 = if any anyBot [absEvalAtom AbsAnal a env | a <- as]
497 -- For absence analysis, we want to see if the poison shows up...
499 absEval anal (Con con ts as) env
501 = AbsProd [absEvalAtom anal a env | a <- as]
503 | otherwise -- Not single-constructor
505 StrAnal -> -- Strictness case: it's easy: it certainly terminates
507 AbsAnal -> -- In the absence case we need to be more
508 -- careful: look to see if there's any
509 -- poison in the components
510 if any anyBot [absEvalAtom AbsAnal a env | a <- as]
514 (_,_,_, tycon) = getDataConSig con
515 has_single_con = maybeToBool (maybeSingleConstructorTyCon tycon)
519 absEval anal (Lam binder body) env
520 = AbsFun [binder] body env
521 absEval anal (CoTyLam ty expr) env
522 = absEval anal expr env
523 absEval anal (App e1 e2) env
524 = absApply anal (absEval anal e1 env) (absEvalAtom anal e2 env)
525 absEval anal (CoTyApp expr ty) env
526 = absEval anal expr env
529 For primitive cases, just GLB the branches, then LUB with the expr part.
532 absEval anal (Case expr (PrimAlts alts deflt)) env
534 expr_val = absEval anal expr env
535 abs_alts = [ absEval anal rhs env | (_, rhs) <- alts ]
536 -- Don't bother to extend envt, because unbound vars
537 -- default to the conservative AbsTop
539 abs_deflt = absEvalDefault anal expr_val deflt env
541 combineCaseValues anal expr_val
542 (abs_deflt ++ abs_alts)
544 absEval anal (Case expr (AlgAlts alts deflt)) env
546 expr_val = absEval anal expr env
547 abs_alts = [ absEvalAlgAlt anal expr_val alt env | alt <- alts ]
548 abs_deflt = absEvalDefault anal expr_val deflt env
552 combineCaseValues anal expr_val
553 (abs_deflt ++ abs_alts)
558 _ -> 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)))
564 For @Lets@ we widen the value we get. This is nothing to
565 do with fixpointing. The reason is so that we don't get an explosion
566 in the amount of computation. For example, consider:
578 If we bind @f@ and @g@ to their exact abstract value, then we'll
579 ``execute'' one call to @f@ and {\em two} calls to @g@. This can blow
580 up exponentially. Widening cuts it off by making a fixed
581 approximation to @f@ and @g@, so that the bodies of @f@ and @g@ are
582 not evaluated again at all when they are called.
584 Of course, this can lose useful joint strictness, which is sad. An
585 alternative approach would be to try with a certain amount of ``fuel''
586 and be prepared to bale out.
589 absEval anal (Let (NonRec binder e1) e2) env
591 new_env = addOneToAbsValEnv env binder (widen anal (absEval anal e1 env))
593 -- The binder of a NonRec should *not* be of unboxed type,
594 -- hence no need to strictly evaluate the Rhs.
595 absEval anal e2 new_env
597 absEval anal (Let (Rec pairs) body) env
599 (binders,rhss) = unzip pairs
600 rhs_vals = cheapFixpoint anal binders rhss env -- Returns widened values
601 new_env = growAbsValEnvList env (binders `zip` rhs_vals)
603 absEval anal body new_env
605 absEval anal (SCC cc expr) env = absEval anal expr env
609 absEvalAlgAlt :: AnalysisKind -> AbsVal -> (Id,[Id],CoreExpr) -> AbsValEnv -> AbsVal
611 absEvalAlgAlt anal (AbsProd arg_vals) (con, args, rhs) env
612 = -- The scrutinee is a product value, so it must be of a single-constr
613 -- type; so the constructor in this alternative must be the right one
614 -- so we can go ahead and bind the constructor args to the components
615 -- of the product value.
616 ASSERT(length arg_vals == length args)
618 new_env = growAbsValEnvList env (args `zip` arg_vals)
620 absEval anal rhs new_env
622 absEvalAlgAlt anal other_scrutinee (con, args, rhs) env
623 = -- Scrutinised value is Top or Bot (it can't be a function!)
624 -- So just evaluate the rhs with all constr args bound to Top.
625 -- (If the scrutinee is Top we'll never evaluated this function
631 = case other_scrutinee of {
632 AbsTop -> True; -- i.e., OK
633 AbsBot -> True; -- ditto
634 _ -> False -- party over
638 absEvalDefault :: AnalysisKind
639 -> AbsVal -- Value of scrutinee
642 -> [AbsVal] -- Empty or singleton
644 absEvalDefault anal scrut_val NoDefault env = []
645 absEvalDefault anal scrut_val (BindDefault binder expr) env
646 = [absEval anal expr (addOneToAbsValEnv env binder scrut_val)]
649 %************************************************************************
651 \subsection[absApply]{Apply an abstract function to an abstract argument}
653 %************************************************************************
658 absApply :: AnalysisKind -> AbsVal -> AbsVal -> AbsVal
660 absApply anal AbsBot arg = AbsBot
661 -- AbsBot represents the abstract bottom *function* too
663 absApply StrAnal AbsTop arg = AbsTop
664 absApply AbsAnal AbsTop arg = if anyBot arg
667 -- To be conservative, we have to assume that a function about
668 -- which we know nothing (AbsTop) might look at some part of
672 An @AbsFun@ with only one more argument needed---bind it and eval the
673 result. A @Lam@ with two or more args: return another @AbsFun@ with
674 an augmented environment.
677 absApply anal (AbsFun [binder] body env) arg
678 = absEval anal body (addOneToAbsValEnv env binder arg)
680 absApply anal (AbsFun (binder:bs) body env) arg
681 = AbsFun bs body (addOneToAbsValEnv env binder arg)
685 absApply StrAnal (AbsApproxFun (arg1_demand:ds)) arg
686 = if evalStrictness arg1_demand arg
690 other -> AbsApproxFun ds
692 absApply AbsAnal (AbsApproxFun (arg1_demand:ds)) arg
693 = if evalAbsence arg1_demand arg
697 other -> AbsApproxFun ds
700 absApply anal (AbsApproxFun []) arg = panic ("absApply: Duff function: AbsApproxFun." ++ show anal)
701 absApply anal (AbsFun [] _ _) arg = panic ("absApply: Duff function: AbsFun." ++ show anal)
702 absApply anal (AbsProd _) arg = panic ("absApply: Duff function: AbsProd." ++ show anal)
709 %************************************************************************
711 \subsection[findStrictness]{Determine some binders' strictness}
713 %************************************************************************
715 @findStrictness@ applies the function \tr{\ ids -> expr} to
716 \tr{[bot,top,top,...]}, \tr{[top,bot,top,top,...]}, etc., (i.e., once
717 with @AbsBot@ in each argument position), and evaluates the resulting
718 abstract value; it returns a vector of @Demand@s saying whether the
719 result of doing this is guaranteed to be bottom. This tells the
720 strictness of the function in each of the arguments.
722 If an argument is of unboxed type, then we declare that function to be
723 strict in that argument.
725 We don't really have to make up all those lists of mostly-@AbsTops@;
726 unbound variables in an @AbsValEnv@ are implicitly mapped to that.
728 See notes on @addStrictnessInfoToId@.
731 findStrictness :: StrAnalFlags
732 -> [Type] -- Types of args in which strictness is wanted
733 -> AbsVal -- Abstract strictness value of function
734 -> AbsVal -- Abstract absence value of function
735 -> [Demand] -- Resulting strictness annotation
737 findStrictness strflags [] str_val abs_val = []
739 findStrictness strflags (ty:tys) str_val abs_val
741 demand = findRecDemand strflags [] str_fn abs_fn ty
742 str_fn val = absApply StrAnal str_val val
743 abs_fn val = absApply AbsAnal abs_val val
745 demands = findStrictness strflags tys
746 (absApply StrAnal str_val AbsTop)
747 (absApply AbsAnal abs_val AbsTop)
754 findDemandStrOnly str_env expr binder -- Only strictness environment available
755 = findRecDemand strflags [] str_fn abs_fn (idType binder)
757 str_fn val = absEval StrAnal expr (addOneToAbsValEnv str_env binder val)
758 abs_fn val = AbsBot -- Always says poison; so it looks as if
759 -- nothing is absent; safe
760 strflags = getStrAnalFlags str_env
762 findDemandAbsOnly abs_env expr binder -- Only absence environment available
763 = findRecDemand strflags [] str_fn abs_fn (idType binder)
765 str_fn val = AbsBot -- Always says non-termination;
766 -- that'll make findRecDemand peer into the
767 -- structure of the value.
768 abs_fn val = absEval AbsAnal expr (addOneToAbsValEnv abs_env binder val)
769 strflags = getStrAnalFlags abs_env
772 findDemand str_env abs_env expr binder
773 = findRecDemand strflags [] str_fn abs_fn (idType binder)
775 str_fn val = absEval StrAnal expr (addOneToAbsValEnv str_env binder val)
776 abs_fn val = absEval AbsAnal expr (addOneToAbsValEnv abs_env binder val)
777 strflags = getStrAnalFlags str_env
780 @findRecDemand@ is where we finally convert strictness/absence info
781 into ``Demands'' which we can pin on Ids (etc.).
783 NOTE: What do we do if something is {\em both} strict and absent?
784 Should \tr{f x y z = error "foo"} says that \tr{f}'s arguments are all
785 strict (because of bottoming effect of \tr{error}) or all absent
786 (because they're not used)?
788 Well, for practical reasons, we prefer absence over strictness. In
789 particular, it makes the ``default defaults'' for class methods (the
790 ones that say \tr{defm.foo dict = error "I don't exist"}) come out
791 nicely [saying ``the dict isn't used''], rather than saying it is
792 strict in every component of the dictionary [massive gratuitious
793 casing to take the dict apart].
795 But you could have examples where going for strictness would be better
796 than absence. Consider:
798 let x = something big
803 If \tr{x} is marked absent in \tr{f}, but not strict, and \tr{g} is
804 lazy, then the thunk for \tr{x} will be built. If \tr{f} was strict,
805 then we'd let-to-case it:
807 case something big of
813 findRecDemand :: StrAnalFlags
814 -> [TyCon] -- TyCons already seen; used to avoid
815 -- zooming into recursive types
816 -> (AbsVal -> AbsVal) -- The strictness function
817 -> (AbsVal -> AbsVal) -- The absence function
818 -> Type -- The type of the argument
821 findRecDemand strflags seen str_fn abs_fn ty
822 = if isPrimType ty then -- It's a primitive type!
825 else if not (anyBot (abs_fn AbsBot)) then -- It's absent
826 -- We prefer absence over strictness: see NOTE above.
829 else if not (all_strict ||
830 (num_strict && is_numeric_type ty) ||
831 (isBot (str_fn AbsBot))) then
832 WwLazy False -- It's not strict and we're not pretending
834 else -- It's strict (or we're pretending it is)!
836 case maybeDataTyCon ty of
840 Just (tycon,tycon_arg_tys,[data_con]) | tycon `not_elem` seen ->
841 -- Single constructor case, tycon not already seen higher up
843 (_,cmpnt_tys,_) = getInstantiatedDataConSig data_con tycon_arg_tys
844 prod_len = length cmpnt_tys
847 = [ findRecDemand strflags (tycon:seen)
849 str_fn (mkMainlyTopProd prod_len i cmpnt_val)
852 abs_fn (mkMainlyTopProd prod_len i cmpnt_val)
855 | (cmpnt_ty, i) <- cmpnt_tys `zip` [1..] ]
857 if null compt_strict_infos then
858 if isEnumerationTyCon tycon then wwEnum else wwStrict
860 wwUnpack compt_strict_infos
862 not_elem = isn'tIn "findRecDemand"
865 -- Multi-constr data types, *or* an abstract data
866 -- types, *or* things we don't have a way of conveying
867 -- the info over module boundaries (class ops,
868 -- superdict sels, dfns).
869 if isEnumerationTyCon tycon then
874 (all_strict, num_strict) = strflags
877 = case (maybeDataTyCon ty) of -- NB: duplicates stuff done above
881 [intTyCon, integerTyCon,
882 doubleTyCon, floatTyCon,
883 wordTyCon, addrTyCon]
885 _{-something else-} -> False
887 is_elem = isIn "is_numeric_type"
889 -- mkMainlyTopProd: make an AbsProd that is all AbsTops ("n"-1 of
890 -- them) except for a given value in the "i"th position.
892 mkMainlyTopProd :: Int -> Int -> AbsVal -> AbsVal
894 mkMainlyTopProd n i val
896 befores = nOfThem (i-1) AbsTop
897 afters = nOfThem (n-i) AbsTop
899 AbsProd (befores ++ (val : afters))
902 %************************************************************************
904 \subsection[fixpoint]{Fixpointer for the strictness analyser}
906 %************************************************************************
908 The @fixpoint@ functions take a list of \tr{(binder, expr)} pairs, an
909 environment, and returns the abstract value of each binder.
911 The @cheapFixpoint@ function makes a conservative approximation,
912 by binding each of the variables to Top in their own right hand sides.
913 That allows us to make rapid progress, at the cost of a less-than-wonderful
917 cheapFixpoint :: AnalysisKind -> [Id] -> [CoreExpr] -> AbsValEnv -> [AbsVal]
919 cheapFixpoint AbsAnal [id] [rhs] env
920 = [crudeAbsWiden (absEval AbsAnal rhs new_env)]
922 new_env = addOneToAbsValEnv env id AbsTop -- Unsafe starting point!
923 -- In the just-one-binding case, we guarantee to
924 -- find a fixed point in just one iteration,
925 -- because we are using only a two-point domain.
926 -- This improves matters in cases like:
928 -- f x y = letrec g = ...g...
931 -- Here, y isn't used at all, but if g is bound to
932 -- AbsBot we simply get AbsBot as the next
935 cheapFixpoint anal ids rhss env
936 = [widen anal (absEval anal rhs new_env) | rhs <- rhss]
937 -- We do just one iteration, starting from a safe
938 -- approximation. This won't do a good job in situations
940 -- \x -> letrec f = ...g...
944 -- Here, f will end up bound to Top after one iteration,
945 -- and hence we won't spot the strictness in x.
946 -- (A second iteration would solve this. ToDo: try the effect of
947 -- really searching for a fixed point.)
949 new_env = growAbsValEnvList env [(id,safe_val) | id <- ids]
952 = case anal of -- The safe starting point
958 mkLookupFun :: (key -> key -> Bool) -- Equality predicate
959 -> (key -> key -> Bool) -- Less-than predicate
960 -> [(key,val)] -- The assoc list
962 -> Maybe val -- The corresponding value
964 mkLookupFun eq lt alist s
965 = case [a | (s',a) <- alist, s' `eq` s] of
971 fixpoint :: AnalysisKind -> [Id] -> [CoreExpr] -> AbsValEnv -> [AbsVal]
973 fixpoint anal [] _ env = []
975 fixpoint anal ids rhss env
976 = fix_loop initial_vals
979 = case anal of -- The (unsafe) starting point
980 StrAnal -> if (returnsRealWorld (idType id))
981 then AbsTop -- this is a massively horrible hack (SLPJ 95/05)
985 initial_vals = [ initial_val id | id <- ids ]
987 fix_loop :: [AbsVal] -> [AbsVal]
989 fix_loop current_widened_vals
991 new_env = growAbsValEnvList env (ids `zip` current_widened_vals)
992 new_vals = [ absEval anal rhs new_env | rhs <- rhss ]
993 new_widened_vals = map (widen anal) new_vals
995 if (and (zipWith sameVal current_widened_vals new_widened_vals)) then
998 -- NB: I was too chicken to make that a zipWithEqual,
999 -- lest I jump into a black hole. WDP 96/02
1001 -- Return the widened values. We might get a slightly
1002 -- better value by returning new_vals (which we used to
1003 -- do, see below), but alas that means that whenever the
1004 -- function is called we have to re-execute it, which is
1009 -- Return the un-widened values which may be a bit better
1010 -- than the widened ones, and are guaranteed safe, since
1011 -- they are one iteration beyond current_widened_vals,
1012 -- which itself is a fixed point.
1014 fix_loop new_widened_vals
1017 For absence analysis, we make do with a very very simple approach:
1018 look for convergence in a two-point domain.
1020 We used to use just one iteration, starting with the variables bound
1021 to @AbsBot@, which is safe.
1023 Prior to that, we used one iteration starting from @AbsTop@ (which
1024 isn't safe). Why isn't @AbsTop@ safe? Consider:
1032 Here, if p is @AbsBot@, then we'd better {\em not} end up with a ``fixed
1033 point'' of @d@ being @(AbsTop, AbsTop)@! An @AbsBot@ initial value is
1034 safe because it gives poison more often than really necessary, and
1035 thus may miss some absence, but will never claim absence when it ain't
1038 Anyway, one iteration starting with everything bound to @AbsBot@ give
1043 Here, f would always end up bound to @AbsBot@, which ain't very
1044 clever, because then it would introduce poison whenever it was
1045 applied. Much better to start with f bound to @AbsTop@, and widen it
1046 to @AbsBot@ if any poison shows up. In effect we look for convergence
1047 in the two-point @AbsTop@/@AbsBot@ domain.
1049 What we miss (compared with the cleverer strictness analysis) is
1050 spotting that in this case
1052 f = \ x y -> ...y...(f x y')...
1054 \tr{x} is actually absent, since it is only passed round the loop, never
1055 used. But who cares about missing that?
1057 NB: despite only having a two-point domain, we may still have many
1058 iterations, because there are several variables involved at once.