2 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
4 \section[SaAbsInt]{Abstract interpreter for strictness analysis}
9 findDemand, findDemandAlts,
16 #include "HsVersions.h"
18 import CmdLineOpts ( opt_AllStrict, opt_NumbersStrict )
20 import CoreUnfold ( Unfolding(..) )
21 import PrimOp ( primOpStrictness )
22 import Id ( Id, idType, getIdStrictness, getIdUnfolding )
23 import Const ( Con(..) )
24 import DataCon ( dataConTyCon, dataConArgTys )
25 import IdInfo ( StrictnessInfo(..) )
26 import Demand ( Demand(..), wwPrim, wwStrict, wwEnum, wwUnpackData,
29 import TyCon ( isProductTyCon, isEnumerationTyCon, isNewTyCon )
30 import BasicTypes ( NewOrData(..) )
31 import Type ( splitAlgTyConApp_maybe,
32 isUnLiftedType, Type )
33 import TyCon ( tyConUnique )
34 import PrelInfo ( numericTyKeys )
35 import Util ( isIn, nOfThem, zipWithEqual )
38 returnsRealWorld x = False -- ToDo: panic "SaAbsInt.returnsRealWorld (ToDo)"
41 %************************************************************************
43 \subsection[AbsVal-ops]{Operations on @AbsVals@}
45 %************************************************************************
47 Least upper bound, greatest lower bound.
50 lub, glb :: AbsVal -> AbsVal -> AbsVal
52 lub val1 val2 | isBot val1 = val2 -- The isBot test includes the case where
53 lub val1 val2 | isBot val2 = val1 -- one of the val's is a function which
54 -- always returns bottom, such as \y.x,
55 -- when x is bound to bottom.
57 lub (AbsProd xs) (AbsProd ys) = AbsProd (zipWithEqual "lub" lub xs ys)
59 lub _ _ = AbsTop -- Crude, but conservative
60 -- The crudity only shows up if there
61 -- are functions involved
63 -- Slightly funny glb; for absence analysis only;
64 -- AbsBot is the safe answer.
66 -- Using anyBot rather than just testing for AbsBot is important.
71 -- g = \x y z -> case x of
75 -- Now, the abstract value of the branches of the case will be an
76 -- AbsFun, but when testing for z's absence we want to spot that it's
77 -- an AbsFun which can't possibly return AbsBot. So when glb'ing we
78 -- mustn't be too keen to bale out and return AbsBot; the anyBot test
79 -- spots that (f x) can't possibly return AbsBot.
81 -- We have also tripped over the following interesting case:
86 -- Now, suppose f is bound to AbsTop. Does this expression mention z?
87 -- Obviously not. But the case will take the glb of AbsTop (for f) and
88 -- an AbsFun (for \y->1). We should not bale out and give AbsBot, because
89 -- that would say that it *does* mention z (or anything else for that matter).
90 -- Nor can we always return AbsTop, because the AbsFun might be something
91 -- like (\y->z), which obviously does mention z. The point is that we're
92 -- glbing two functions, and AbsTop is not actually the top of the function
93 -- lattice. It is more like (\xyz -> x|y|z); that is, AbsTop returns
94 -- poison iff any of its arguments do.
96 -- Deal with functions specially, because AbsTop isn't the
97 -- top of their domain.
100 | is_fun v1 || is_fun v2
101 = if not (anyBot v1) && not (anyBot v2)
107 is_fun (AbsFun _ _ _) = True
108 is_fun (AbsApproxFun _ _) = True -- Not used, but the glb works ok
111 -- The non-functional cases are quite straightforward
113 glb (AbsProd xs) (AbsProd ys) = AbsProd (zipWithEqual "glb" glb xs ys)
118 glb _ _ = AbsBot -- Be pessimistic
121 @isBot@ returns True if its argument is (a representation of) bottom. The
122 ``representation'' part is because we need to detect the bottom {\em function}
123 too. To detect the bottom function, bind its args to top, and see if it
126 Used only in strictness analysis:
128 isBot :: AbsVal -> Bool
131 isBot other = False -- Functions aren't bottom any more
135 Used only in absence analysis:
137 anyBot :: AbsVal -> Bool
139 anyBot AbsBot = True -- poisoned!
140 anyBot AbsTop = False
141 anyBot (AbsProd vals) = any anyBot vals
142 anyBot (AbsFun bndr body env) = anyBot (absEval AbsAnal body (addOneToAbsValEnv env bndr AbsTop))
143 anyBot (AbsApproxFun _ val) = anyBot val
146 @widen@ takes an @AbsVal@, $val$, and returns and @AbsVal@ which is
147 approximated by $val$. Furthermore, the result has no @AbsFun@s in
148 it, so it can be compared for equality by @sameVal@.
151 widen :: AnalysisKind -> AbsVal -> AbsVal
153 -- Widening is complicated by the fact that funtions are lifted
154 widen StrAnal the_fn@(AbsFun bndr body env)
155 = case widened_body of
156 AbsApproxFun ds val -> AbsApproxFun (d : ds) val
158 d = findRecDemand str_fn abs_fn bndr_ty
159 str_fn val = foldl (absApply StrAnal) the_fn
160 (val : [AbsTop | d <- ds])
162 other -> AbsApproxFun [d] widened_body
164 d = findRecDemand str_fn abs_fn bndr_ty
165 str_fn val = absApply StrAnal the_fn val
167 bndr_ty = idType bndr
168 widened_body = widen StrAnal (absApply StrAnal the_fn AbsTop)
169 abs_fn val = AbsBot -- Always says poison; so it looks as if
170 -- nothing is absent; safe
173 This stuff is now instead handled neatly by the fact that AbsApproxFun
174 contains an AbsVal inside it. SLPJ Jan 97
176 | isBot abs_body = AbsBot
177 -- It's worth checking for a function which is unconditionally
180 -- f x y = let g y = case x of ...
181 -- in (g ..) + (g ..)
183 -- Here, when we are considering strictness of f in x, we'll
184 -- evaluate the body of f with x bound to bottom. The current
185 -- strategy is to bind g to its *widened* value; without the isBot
186 -- (...) test above, we'd bind g to an AbsApproxFun, and deliver
187 -- Top, not Bot as the value of f's rhs. The test spots the
188 -- unconditional bottom-ness of g when x is bottom. (Another
189 -- alternative here would be to bind g to its exact abstract
190 -- value, but that entails lots of potential re-computation, at
191 -- every application of g.)
194 widen StrAnal (AbsProd vals) = AbsProd (map (widen StrAnal) vals)
195 widen StrAnal other_val = other_val
198 widen AbsAnal the_fn@(AbsFun bndr body env)
199 | anyBot widened_body = AbsBot
200 -- In the absence-analysis case it's *essential* to check
201 -- that the function has no poison in its body. If it does,
202 -- anywhere, then the whole function is poisonous.
205 = case widened_body of
206 AbsApproxFun ds val -> AbsApproxFun (d : ds) val
208 d = findRecDemand str_fn abs_fn bndr_ty
209 abs_fn val = foldl (absApply AbsAnal) the_fn
210 (val : [AbsTop | d <- ds])
212 other -> AbsApproxFun [d] widened_body
214 d = findRecDemand str_fn abs_fn bndr_ty
215 abs_fn val = absApply AbsAnal the_fn val
217 bndr_ty = idType bndr
218 widened_body = widen AbsAnal (absApply AbsAnal the_fn AbsTop)
219 str_fn val = AbsBot -- Always says non-termination;
220 -- that'll make findRecDemand peer into the
221 -- structure of the value.
223 widen AbsAnal (AbsProd vals) = AbsProd (map (widen AbsAnal) vals)
225 -- It's desirable to do a good job of widening for product
229 -- in ...(case p of (x,y) -> x)...
231 -- Now, is y absent in this expression? Currently the
232 -- analyser widens p before looking at p's scope, to avoid
233 -- lots of recomputation in the case where p is a function.
234 -- So if widening doesn't have a case for products, we'll
235 -- widen p to AbsBot (since when searching for absence in y we
236 -- bind y to poison ie AbsBot), and now we are lost.
238 widen AbsAnal other_val = other_val
240 -- WAS: if anyBot val then AbsBot else AbsTop
241 -- Nowadays widen is doing a better job on functions for absence analysis.
244 @crudeAbsWiden@ is used just for absence analysis, and always
245 returns AbsTop or AbsBot, so it widens to a two-point domain
248 crudeAbsWiden :: AbsVal -> AbsVal
249 crudeAbsWiden val = if anyBot val then AbsBot else AbsTop
252 @sameVal@ compares two abstract values for equality. It can't deal with
253 @AbsFun@, but that should have been removed earlier in the day by @widen@.
256 sameVal :: AbsVal -> AbsVal -> Bool -- Can't handle AbsFun!
259 sameVal (AbsFun _ _ _) _ = panic "sameVal: AbsFun: arg1"
260 sameVal _ (AbsFun _ _ _) = panic "sameVal: AbsFun: arg2"
263 sameVal AbsBot AbsBot = True
264 sameVal AbsBot other = False -- widen has reduced AbsFun bots to AbsBot
266 sameVal AbsTop AbsTop = True
267 sameVal AbsTop other = False -- Right?
269 sameVal (AbsProd vals1) (AbsProd vals2) = and (zipWithEqual "sameVal" sameVal vals1 vals2)
270 sameVal (AbsProd _) AbsTop = False
271 sameVal (AbsProd _) AbsBot = False
273 sameVal (AbsApproxFun str1 v1) (AbsApproxFun str2 v2) = str1 == str2 && sameVal v1 v2
274 sameVal (AbsApproxFun _ _) AbsTop = False
275 sameVal (AbsApproxFun _ _) AbsBot = False
277 sameVal val1 val2 = panic "sameVal: type mismatch or AbsFun encountered"
281 @evalStrictness@ compares a @Demand@ with an abstract value, returning
282 @True@ iff the abstract value is {\em less defined} than the demand.
283 (@True@ is the exciting answer; @False@ is always safe.)
286 evalStrictness :: Demand
288 -> Bool -- True iff the value is sure
289 -- to be less defined than the Demand
291 evalStrictness (WwLazy _) _ = False
292 evalStrictness WwStrict val = isBot val
293 evalStrictness WwEnum val = isBot val
295 evalStrictness (WwUnpack NewType _ (demand:_)) val
296 = evalStrictness demand val
298 evalStrictness (WwUnpack DataType _ demand_info) val
302 AbsProd vals -> or (zipWithEqual "evalStrictness" evalStrictness demand_info vals)
303 _ -> pprTrace "evalStrictness?" empty False
305 evalStrictness WwPrim val
308 AbsBot -> True -- Can happen: consider f (g x), where g is a
309 -- recursive function returning an Int# that diverges
311 other -> pprPanic "evalStrictness: WwPrim:" (ppr other)
314 For absence analysis, we're interested in whether "poison" in the
315 argument (ie a bottom therein) can propagate to the result of the
316 function call; that is, whether the specified demand can {\em
317 possibly} hit poison.
320 evalAbsence (WwLazy True) _ = False -- Can't possibly hit poison
321 -- with Absent demand
323 evalAbsence (WwUnpack NewType _ (demand:_)) val
324 = evalAbsence demand val
326 evalAbsence (WwUnpack DataType _ demand_info) val
328 AbsTop -> False -- No poison in here
329 AbsBot -> True -- Pure poison
330 AbsProd vals -> or (zipWithEqual "evalAbsence" evalAbsence demand_info vals)
331 _ -> panic "evalAbsence: other"
333 evalAbsence other val = anyBot val
334 -- The demand is conservative; even "Lazy" *might* evaluate the
335 -- argument arbitrarily so we have to look everywhere for poison
338 %************************************************************************
340 \subsection[absEval]{Evaluate an expression in the abstract domain}
342 %************************************************************************
345 -- The isBottomingId stuf is now dealt with via the Id's strictness info
346 -- absId anal var env | isBottomingId var
348 -- StrAnal -> AbsBot -- See discussion below
349 -- AbsAnal -> AbsTop -- Just want to see if there's any poison in
353 = case (lookupAbsValEnv env var, getIdStrictness var, getIdUnfolding var) of
355 (Just abs_val, _, _) ->
356 abs_val -- Bound in the environment
358 (Nothing, NoStrictnessInfo, CoreUnfolding _ _ unfolding) ->
359 -- We have an unfolding for the expr
360 -- Assume the unfolding has no free variables since it
361 -- came from inside the Id
362 absEval anal unfolding env
363 -- Notice here that we only look in the unfolding if we don't
364 -- have strictness info (an unusual situation).
365 -- We could have chosen to look in the unfolding if it exists,
366 -- and only try the strictness info if it doesn't, and that would
367 -- give more accurate results, at the cost of re-abstract-interpreting
368 -- the unfolding every time.
369 -- We found only one place where the look-at-unfolding-first
370 -- method gave better results, which is in the definition of
371 -- showInt in the Prelude. In its defintion, fromIntegral is
372 -- not inlined (it's big) but ab-interp-ing its unfolding gave
373 -- a better result than looking at its strictness only.
374 -- showInt :: Integral a => a -> [Char] -> [Char]
375 -- ! {-# GHC_PRAGMA _A_ 1 _U_ 122 _S_
376 -- "U(U(U(U(SA)AAAAAAAAL)AA)AAAAASAAASA)" {...} _N_ _N_ #-}
378 -- showInt :: Integral a => a -> [Char] -> [Char]
379 -- ! {-# GHC_PRAGMA _A_ 1 _U_ 122 _S_
380 -- "U(U(U(U(SL)LLLLLLLLL)LL)LLLLLSLLLLL)" _N_ _N_ #-}
383 (Nothing, strictness_info, _) ->
384 -- Includes NoUnfolding
385 -- Try the strictness info
386 absValFromStrictness anal strictness_info
390 absEval :: AnalysisKind -> CoreExpr -> AbsValEnv -> AbsVal
392 absEval anal (Type ty) env = AbsTop
393 absEval anal (Var var) env = absId anal var env
396 Discussion about error (following/quoting Lennart): Any expression
397 'error e' is regarded as bottom (with HBC, with the -ffail-strict
400 Regarding it as bottom gives much better strictness properties for
404 f (x:xs) y = f xs (x+y)
406 f [] _ = error "no match"
408 f (x:xs) y = f xs (x+y)
410 is strict in y, which you really want. But, it may lead to
411 transformations that turn a call to \tr{error} into non-termination.
412 (The odds of this happening aren't good.)
414 Things are a little different for absence analysis, because we want
415 to make sure that any poison (?????)
418 absEval anal (Con (Literal _) args) env
419 = -- Literals terminate (strictness) and are not poison (absence)
422 absEval anal (Con (PrimOp op) args) env
423 = -- Not all PrimOps evaluate all their arguments
424 if or (zipWith (check_arg anal)
425 [absEval anal arg env | arg <- args, isValArg arg]
429 StrAnal | result_bot -> AbsBot
432 (arg_demands, result_bot) = primOpStrictness op
433 check_arg StrAnal arg dmd = evalStrictness dmd arg
434 check_arg AbsAnal arg dmd = evalAbsence dmd arg
436 absEval anal (Con (DataCon con) args) env
437 | isProductTyCon (dataConTyCon con)
438 = -- Products; filter out type arguments
439 AbsProd [absEval anal a env | a <- args, isValArg a]
441 | otherwise -- Not single-constructor
443 StrAnal -> -- Strictness case: it's easy: it certainly terminates
445 AbsAnal -> -- In the absence case we need to be more
446 -- careful: look to see if there's any
447 -- poison in the components
448 if any anyBot [absEval AbsAnal arg env | arg <- args]
454 absEval anal (Lam bndr body) env
455 | isTyVar bndr = absEval anal body env -- Type lambda
456 | otherwise = AbsFun bndr body env -- Value lambda
458 absEval anal (App expr (Type ty)) env
459 = absEval anal expr env -- Type appplication
460 absEval anal (App f val_arg) env
461 = absApply anal (absEval anal f env) -- Value applicationn
462 (absEval anal val_arg env)
466 absEval anal expr@(Case scrut case_bndr alts) env
468 scrut_val = absEval anal scrut env
469 alts_env = addOneToAbsValEnv env case_bndr scrut_val
471 case (scrut_val, alts) of
472 (AbsBot, _) -> AbsBot
474 (AbsProd arg_vals, [(con, bndrs, rhs)])
476 -- The scrutinee is a product value, so it must be of a single-constr
477 -- type; so the constructor in this alternative must be the right one
478 -- so we can go ahead and bind the constructor args to the components
479 -- of the product value.
480 ASSERT(length arg_vals == length val_bndrs)
481 absEval anal rhs rhs_env
483 val_bndrs = filter isId bndrs
484 rhs_env = growAbsValEnvList alts_env (val_bndrs `zip` arg_vals)
486 other -> absEvalAlts anal alts alts_env
489 For @Lets@ we widen the value we get. This is nothing to
490 do with fixpointing. The reason is so that we don't get an explosion
491 in the amount of computation. For example, consider:
503 If we bind @f@ and @g@ to their exact abstract value, then we'll
504 ``execute'' one call to @f@ and {\em two} calls to @g@. This can blow
505 up exponentially. Widening cuts it off by making a fixed
506 approximation to @f@ and @g@, so that the bodies of @f@ and @g@ are
507 not evaluated again at all when they are called.
509 Of course, this can lose useful joint strictness, which is sad. An
510 alternative approach would be to try with a certain amount of ``fuel''
511 and be prepared to bale out.
514 absEval anal (Let (NonRec binder e1) e2) env
516 new_env = addOneToAbsValEnv env binder (widen anal (absEval anal e1 env))
518 -- The binder of a NonRec should *not* be of unboxed type,
519 -- hence no need to strictly evaluate the Rhs.
520 absEval anal e2 new_env
522 absEval anal (Let (Rec pairs) body) env
524 (binders,rhss) = unzip pairs
525 rhs_vals = cheapFixpoint anal binders rhss env -- Returns widened values
526 new_env = growAbsValEnvList env (binders `zip` rhs_vals)
528 absEval anal body new_env
530 absEval anal (Note note expr) env = absEval anal expr env
534 absEvalAlts :: AnalysisKind -> [CoreAlt] -> AbsValEnv -> AbsVal
535 absEvalAlts anal alts env
536 = combine anal (map go alts)
538 combine StrAnal = foldr1 lub -- Diverge only if all diverge
539 combine AbsAnal = foldr1 glb -- Find any poison
542 = absEval anal rhs rhs_env
544 rhs_env = growAbsValEnvList env (filter isId bndrs `zip` repeat AbsTop)
547 %************************************************************************
549 \subsection[absApply]{Apply an abstract function to an abstract argument}
551 %************************************************************************
556 absApply :: AnalysisKind -> AbsVal -> AbsVal -> AbsVal
558 absApply anal AbsBot arg = AbsBot
559 -- AbsBot represents the abstract bottom *function* too
561 absApply StrAnal AbsTop arg = AbsTop
562 absApply AbsAnal AbsTop arg = if anyBot arg
565 -- To be conservative, we have to assume that a function about
566 -- which we know nothing (AbsTop) might look at some part of
570 An @AbsFun@ with only one more argument needed---bind it and eval the
571 result. A @Lam@ with two or more args: return another @AbsFun@ with
572 an augmented environment.
575 absApply anal (AbsFun binder body env) arg
576 = absEval anal body (addOneToAbsValEnv env binder arg)
580 absApply StrAnal (AbsApproxFun (d:ds) val) arg
583 other -> AbsApproxFun ds val' -- Result is non-bot if there are still args
585 val' | evalStrictness d arg = AbsBot
588 absApply AbsAnal (AbsApproxFun (d:ds) val) arg
589 = if evalAbsence d arg
590 then AbsBot -- Poison in arg means poison in the application
593 other -> AbsApproxFun ds val
596 absApply anal f@(AbsProd _) arg = pprPanic ("absApply: Duff function: AbsProd." ++ show anal) ((ppr f) <+> (ppr arg))
603 %************************************************************************
605 \subsection[findStrictness]{Determine some binders' strictness}
607 %************************************************************************
609 @findStrictness@ applies the function \tr{\ ids -> expr} to
610 \tr{[bot,top,top,...]}, \tr{[top,bot,top,top,...]}, etc., (i.e., once
611 with @AbsBot@ in each argument position), and evaluates the resulting
612 abstract value; it returns a vector of @Demand@s saying whether the
613 result of doing this is guaranteed to be bottom. This tells the
614 strictness of the function in each of the arguments.
616 If an argument is of unboxed type, then we declare that function to be
617 strict in that argument.
619 We don't really have to make up all those lists of mostly-@AbsTops@;
620 unbound variables in an @AbsValEnv@ are implicitly mapped to that.
622 See notes on @addStrictnessInfoToId@.
625 findStrictness :: [Type] -- Types of args in which strictness is wanted
626 -> AbsVal -- Abstract strictness value of function
627 -> AbsVal -- Abstract absence value of function
628 -> ([Demand], Bool) -- Resulting strictness annotation
630 findStrictness tys str_val abs_val
631 = (map find_str tys_w_index, isBot (foldl (absApply StrAnal) str_val all_tops))
633 tys_w_index = tys `zip` [(1::Int) ..]
635 find_str (ty,n) = -- let res =
636 -- in pprTrace "findStr" (ppr ty <+> int n <+> ppr res) res
637 findRecDemand str_fn abs_fn ty
639 str_fn val = foldl (absApply StrAnal) str_val
640 (map (mk_arg val n) tys_w_index)
642 abs_fn val = foldl (absApply AbsAnal) abs_val
643 (map (mk_arg val n) tys_w_index)
645 mk_arg val n (_,m) | m==n = val
648 all_tops = [AbsTop | _ <- tys]
653 findDemand str_env abs_env expr binder
654 = findRecDemand str_fn abs_fn (idType binder)
656 str_fn val = absEval StrAnal expr (addOneToAbsValEnv str_env binder val)
657 abs_fn val = absEval AbsAnal expr (addOneToAbsValEnv abs_env binder val)
659 findDemandAlts str_env abs_env alts binder
660 = findRecDemand str_fn abs_fn (idType binder)
662 str_fn val = absEvalAlts StrAnal alts (addOneToAbsValEnv str_env binder val)
663 abs_fn val = absEvalAlts AbsAnal alts (addOneToAbsValEnv abs_env binder val)
666 @findRecDemand@ is where we finally convert strictness/absence info
667 into ``Demands'' which we can pin on Ids (etc.).
669 NOTE: What do we do if something is {\em both} strict and absent?
670 Should \tr{f x y z = error "foo"} says that \tr{f}'s arguments are all
671 strict (because of bottoming effect of \tr{error}) or all absent
672 (because they're not used)?
674 Well, for practical reasons, we prefer absence over strictness. In
675 particular, it makes the ``default defaults'' for class methods (the
676 ones that say \tr{defm.foo dict = error "I don't exist"}) come out
677 nicely [saying ``the dict isn't used''], rather than saying it is
678 strict in every component of the dictionary [massive gratuitious
679 casing to take the dict apart].
681 But you could have examples where going for strictness would be better
682 than absence. Consider:
684 let x = something big
689 If \tr{x} is marked absent in \tr{f}, but not strict, and \tr{g} is
690 lazy, then the thunk for \tr{x} will be built. If \tr{f} was strict,
691 then we'd let-to-case it:
693 case something big of
699 findRecDemand :: (AbsVal -> AbsVal) -- The strictness function
700 -> (AbsVal -> AbsVal) -- The absence function
701 -> Type -- The type of the argument
704 findRecDemand str_fn abs_fn ty
705 = if isUnLiftedType ty then -- It's a primitive type!
708 else if not (anyBot (abs_fn AbsBot)) then -- It's absent
709 -- We prefer absence over strictness: see NOTE above.
712 else if not (opt_AllStrict ||
713 (opt_NumbersStrict && is_numeric_type ty) ||
714 (isBot (str_fn AbsBot))) then
715 WwLazy False -- It's not strict and we're not pretending
717 else -- It's strict (or we're pretending it is)!
719 case (splitAlgTyConApp_maybe ty) of
723 Just (tycon,tycon_arg_tys,[data_con]) | isProductTyCon tycon ->
724 -- Non-recursive, single constructor case
726 cmpnt_tys = dataConArgTys data_con tycon_arg_tys
727 prod_len = length cmpnt_tys
730 if isNewTyCon tycon then -- A newtype!
731 ASSERT( null (tail cmpnt_tys) )
733 demand = findRecDemand str_fn abs_fn (head cmpnt_tys)
741 str_fn (mkMainlyTopProd prod_len i cmpnt_val)
744 abs_fn (mkMainlyTopProd prod_len i cmpnt_val)
747 | (cmpnt_ty, i) <- cmpnt_tys `zip` [1..] ]
749 if null compt_strict_infos then
750 if isEnumerationTyCon tycon then wwEnum else wwStrict
752 wwUnpackData compt_strict_infos
755 -- Multi-constr data types, *or* an abstract data
756 -- types, *or* things we don't have a way of conveying
757 -- the info over module boundaries (class ops,
758 -- superdict sels, dfns).
759 if isEnumerationTyCon tycon then
765 = case (splitAlgTyConApp_maybe ty) of -- NB: duplicates stuff done above
768 | tyConUnique tycon `is_elem` numericTyKeys
770 _{-something else-} -> False
772 is_elem = isIn "is_numeric_type"
774 -- mkMainlyTopProd: make an AbsProd that is all AbsTops ("n"-1 of
775 -- them) except for a given value in the "i"th position.
777 mkMainlyTopProd :: Int -> Int -> AbsVal -> AbsVal
779 mkMainlyTopProd n i val
781 befores = nOfThem (i-1) AbsTop
782 afters = nOfThem (n-i) AbsTop
784 AbsProd (befores ++ (val : afters))
787 %************************************************************************
789 \subsection[fixpoint]{Fixpointer for the strictness analyser}
791 %************************************************************************
793 The @fixpoint@ functions take a list of \tr{(binder, expr)} pairs, an
794 environment, and returns the abstract value of each binder.
796 The @cheapFixpoint@ function makes a conservative approximation,
797 by binding each of the variables to Top in their own right hand sides.
798 That allows us to make rapid progress, at the cost of a less-than-wonderful
802 cheapFixpoint :: AnalysisKind -> [Id] -> [CoreExpr] -> AbsValEnv -> [AbsVal]
804 cheapFixpoint AbsAnal [id] [rhs] env
805 = [crudeAbsWiden (absEval AbsAnal rhs new_env)]
807 new_env = addOneToAbsValEnv env id AbsTop -- Unsafe starting point!
808 -- In the just-one-binding case, we guarantee to
809 -- find a fixed point in just one iteration,
810 -- because we are using only a two-point domain.
811 -- This improves matters in cases like:
813 -- f x y = letrec g = ...g...
816 -- Here, y isn't used at all, but if g is bound to
817 -- AbsBot we simply get AbsBot as the next
820 cheapFixpoint anal ids rhss env
821 = [widen anal (absEval anal rhs new_env) | rhs <- rhss]
822 -- We do just one iteration, starting from a safe
823 -- approximation. This won't do a good job in situations
825 -- \x -> letrec f = ...g...
829 -- Here, f will end up bound to Top after one iteration,
830 -- and hence we won't spot the strictness in x.
831 -- (A second iteration would solve this. ToDo: try the effect of
832 -- really searching for a fixed point.)
834 new_env = growAbsValEnvList env [(id,safe_val) | id <- ids]
837 = case anal of -- The safe starting point
843 mkLookupFun :: (key -> key -> Bool) -- Equality predicate
844 -> (key -> key -> Bool) -- Less-than predicate
845 -> [(key,val)] -- The assoc list
847 -> Maybe val -- The corresponding value
849 mkLookupFun eq lt alist s
850 = case [a | (s',a) <- alist, s' `eq` s] of
856 fixpoint :: AnalysisKind -> [Id] -> [CoreExpr] -> AbsValEnv -> [AbsVal]
858 fixpoint anal [] _ env = []
860 fixpoint anal ids rhss env
861 = fix_loop initial_vals
864 = case anal of -- The (unsafe) starting point
865 StrAnal -> if (returnsRealWorld (idType id))
866 then AbsTop -- this is a massively horrible hack (SLPJ 95/05)
870 initial_vals = [ initial_val id | id <- ids ]
872 fix_loop :: [AbsVal] -> [AbsVal]
874 fix_loop current_widened_vals
876 new_env = growAbsValEnvList env (ids `zip` current_widened_vals)
877 new_vals = [ absEval anal rhs new_env | rhs <- rhss ]
878 new_widened_vals = map (widen anal) new_vals
880 if (and (zipWith sameVal current_widened_vals new_widened_vals)) then
883 -- NB: I was too chicken to make that a zipWithEqual,
884 -- lest I jump into a black hole. WDP 96/02
886 -- Return the widened values. We might get a slightly
887 -- better value by returning new_vals (which we used to
888 -- do, see below), but alas that means that whenever the
889 -- function is called we have to re-execute it, which is
894 -- Return the un-widened values which may be a bit better
895 -- than the widened ones, and are guaranteed safe, since
896 -- they are one iteration beyond current_widened_vals,
897 -- which itself is a fixed point.
899 fix_loop new_widened_vals
902 For absence analysis, we make do with a very very simple approach:
903 look for convergence in a two-point domain.
905 We used to use just one iteration, starting with the variables bound
906 to @AbsBot@, which is safe.
908 Prior to that, we used one iteration starting from @AbsTop@ (which
909 isn't safe). Why isn't @AbsTop@ safe? Consider:
917 Here, if p is @AbsBot@, then we'd better {\em not} end up with a ``fixed
918 point'' of @d@ being @(AbsTop, AbsTop)@! An @AbsBot@ initial value is
919 safe because it gives poison more often than really necessary, and
920 thus may miss some absence, but will never claim absence when it ain't
923 Anyway, one iteration starting with everything bound to @AbsBot@ give
928 Here, f would always end up bound to @AbsBot@, which ain't very
929 clever, because then it would introduce poison whenever it was
930 applied. Much better to start with f bound to @AbsTop@, and widen it
931 to @AbsBot@ if any poison shows up. In effect we look for convergence
932 in the two-point @AbsTop@/@AbsBot@ domain.
934 What we miss (compared with the cleverer strictness analysis) is
935 spotting that in this case
937 f = \ x y -> ...y...(f x y')...
939 \tr{x} is actually absent, since it is only passed round the loop, never
940 used. But who cares about missing that?
942 NB: despite only having a two-point domain, we may still have many
943 iterations, because there are several variables involved at once.