<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html>
<head>
<!-- Generated by HsColour, http://www.cs.york.ac.uk/fp/darcs/hscolour/ -->
<title>stranal/SaAbsInt.lhs</title>
<link type='text/css' rel='stylesheet' href='hscolour.css' />
</head>
<body>
%
% (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
%
\section[SaAbsInt]{Abstract interpreter for strictness analysis}
\begin{code}
<pre><a name="line-1"></a><span class='hs-comment'>{-# OPTIONS -w #-}</span>
<a name="line-2"></a><span class='hs-comment'>-- The above warning supression flag is a temporary kludge.</span>
<a name="line-3"></a><span class='hs-comment'>-- While working on this module you are encouraged to remove it and fix</span>
<a name="line-4"></a><span class='hs-comment'>-- any warnings in the module. See</span>
<a name="line-5"></a><span class='hs-comment'>-- <a href="http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings">http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings</a></span>
<a name="line-6"></a><span class='hs-comment'>-- for details</span>
<a name="line-7"></a>
<a name="line-8"></a><span class='hs-cpp'>#ifndef OLD_STRICTNESS</span>
<a name="line-9"></a><span class='hs-comment'>-- If OLD_STRICTNESS is off, omit all exports </span>
<a name="line-10"></a><span class='hs-keyword'>module</span> <span class='hs-conid'>SaAbsInt</span> <span class='hs-conid'>()</span> <span class='hs-keyword'>where</span>
<a name="line-11"></a>
<a name="line-12"></a><span class='hs-cpp'>#else</span>
<a name="line-13"></a><span class='hs-keyword'>module</span> <span class='hs-conid'>SaAbsInt</span> <span class='hs-layout'>(</span>
<a name="line-14"></a> <span class='hs-varid'>findStrictness</span><span class='hs-layout'>,</span>
<a name="line-15"></a> <span class='hs-varid'>findDemand</span><span class='hs-layout'>,</span> <span class='hs-varid'>findDemandAlts</span><span class='hs-layout'>,</span>
<a name="line-16"></a> <span class='hs-varid'>absEval</span><span class='hs-layout'>,</span>
<a name="line-17"></a> <span class='hs-varid'>widen</span><span class='hs-layout'>,</span>
<a name="line-18"></a> <span class='hs-varid'>fixpoint</span><span class='hs-layout'>,</span>
<a name="line-19"></a> <span class='hs-varid'>isBot</span>
<a name="line-20"></a> <span class='hs-layout'>)</span> <span class='hs-keyword'>where</span>
<a name="line-21"></a>
<a name="line-22"></a><span class='hs-cpp'>#include "HsVersions.h"</span>
<a name="line-23"></a>
<a name="line-24"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>StaticFlags</span> <span class='hs-layout'>(</span> <span class='hs-varid'>opt_AllStrict</span><span class='hs-layout'>,</span> <span class='hs-varid'>opt_NumbersStrict</span> <span class='hs-layout'>)</span>
<a name="line-25"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>CoreSyn</span>
<a name="line-26"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>CoreUnfold</span> <span class='hs-layout'>(</span> <span class='hs-varid'>maybeUnfoldingTemplate</span> <span class='hs-layout'>)</span>
<a name="line-27"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Id</span> <span class='hs-layout'>(</span> <span class='hs-conid'>Id</span><span class='hs-layout'>,</span> <span class='hs-varid'>idType</span><span class='hs-layout'>,</span> <span class='hs-varid'>idUnfolding</span><span class='hs-layout'>,</span> <span class='hs-varid'>isDataConWorkId_maybe</span><span class='hs-layout'>,</span>
<a name="line-28"></a> <span class='hs-varid'>idStrictness</span><span class='hs-layout'>,</span>
<a name="line-29"></a> <span class='hs-layout'>)</span>
<a name="line-30"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>DataCon</span> <span class='hs-layout'>(</span> <span class='hs-varid'>dataConTyCon</span><span class='hs-layout'>,</span> <span class='hs-varid'>splitProductType_maybe</span><span class='hs-layout'>,</span> <span class='hs-varid'>dataConRepArgTys</span> <span class='hs-layout'>)</span>
<a name="line-31"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>IdInfo</span> <span class='hs-layout'>(</span> <span class='hs-conid'>StrictnessInfo</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span> <span class='hs-layout'>)</span>
<a name="line-32"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Demand</span> <span class='hs-layout'>(</span> <span class='hs-conid'>Demand</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-varid'>wwPrim</span><span class='hs-layout'>,</span> <span class='hs-varid'>wwStrict</span><span class='hs-layout'>,</span> <span class='hs-varid'>wwUnpack</span><span class='hs-layout'>,</span> <span class='hs-varid'>wwLazy</span><span class='hs-layout'>,</span>
<a name="line-33"></a> <span class='hs-varid'>mkStrictnessInfo</span><span class='hs-layout'>,</span> <span class='hs-varid'>isLazy</span>
<a name="line-34"></a> <span class='hs-layout'>)</span>
<a name="line-35"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>SaLib</span>
<a name="line-36"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>TyCon</span> <span class='hs-layout'>(</span> <span class='hs-varid'>isProductTyCon</span><span class='hs-layout'>,</span> <span class='hs-varid'>isRecursiveTyCon</span> <span class='hs-layout'>)</span>
<a name="line-37"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Type</span> <span class='hs-layout'>(</span> <span class='hs-varid'>splitTyConApp_maybe</span><span class='hs-layout'>,</span>
<a name="line-38"></a> <span class='hs-varid'>isUnLiftedType</span><span class='hs-layout'>,</span> <span class='hs-conid'>Type</span> <span class='hs-layout'>)</span>
<a name="line-39"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>TyCon</span> <span class='hs-layout'>(</span> <span class='hs-varid'>tyConUnique</span> <span class='hs-layout'>)</span>
<a name="line-40"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>PrelInfo</span> <span class='hs-layout'>(</span> <span class='hs-varid'>numericTyKeys</span> <span class='hs-layout'>)</span>
<a name="line-41"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Util</span> <span class='hs-layout'>(</span> <span class='hs-varid'>isIn</span><span class='hs-layout'>,</span> <span class='hs-varid'>nOfThem</span><span class='hs-layout'>,</span> <span class='hs-varid'>zipWithEqual</span><span class='hs-layout'>,</span> <span class='hs-varid'>equalLength</span> <span class='hs-layout'>)</span>
<a name="line-42"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Outputable</span>
</pre>\end{code}
%************************************************************************
%* *
\subsection[AbsVal-ops]{Operations on @AbsVals@}
%* *
%************************************************************************
Least upper bound, greatest lower bound.
\begin{code}
<pre><a name="line-1"></a><a name="lub"></a><span class='hs-definition'>lub</span><span class='hs-layout'>,</span> <span class='hs-varid'>glb</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>AbsVal</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>AbsVal</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>AbsVal</span>
<a name="line-2"></a>
<a name="line-3"></a><span class='hs-definition'>lub</span> <span class='hs-conid'>AbsBot</span> <span class='hs-varid'>val2</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>val2</span>
<a name="line-4"></a><span class='hs-definition'>lub</span> <span class='hs-varid'>val1</span> <span class='hs-conid'>AbsBot</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>val1</span>
<a name="line-5"></a>
<a name="line-6"></a><span class='hs-definition'>lub</span> <span class='hs-layout'>(</span><span class='hs-conid'>AbsProd</span> <span class='hs-varid'>xs</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>AbsProd</span> <span class='hs-varid'>ys</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>AbsProd</span> <span class='hs-layout'>(</span><span class='hs-varid'>zipWithEqual</span> <span class='hs-str'>"lub"</span> <span class='hs-varid'>lub</span> <span class='hs-varid'>xs</span> <span class='hs-varid'>ys</span><span class='hs-layout'>)</span>
<a name="line-7"></a>
<a name="line-8"></a><span class='hs-definition'>lub</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>AbsTop</span> <span class='hs-comment'>-- Crude, but conservative</span>
<a name="line-9"></a> <span class='hs-comment'>-- The crudity only shows up if there</span>
<a name="line-10"></a> <span class='hs-comment'>-- are functions involved</span>
<a name="line-11"></a>
<a name="line-12"></a><span class='hs-comment'>-- Slightly funny glb; for absence analysis only;</span>
<a name="line-13"></a><span class='hs-comment'>-- AbsBot is the safe answer.</span>
<a name="line-14"></a><span class='hs-comment'>--</span>
<a name="line-15"></a><span class='hs-comment'>-- Using anyBot rather than just testing for AbsBot is important.</span>
<a name="line-16"></a><span class='hs-comment'>-- Consider:</span>
<a name="line-17"></a><span class='hs-comment'>--</span>
<a name="line-18"></a><span class='hs-comment'>-- f = \a b -> ...</span>
<a name="line-19"></a><span class='hs-comment'>--</span>
<a name="line-20"></a><span class='hs-comment'>-- g = \x y z -> case x of</span>
<a name="line-21"></a><span class='hs-comment'>-- [] -> f x</span>
<a name="line-22"></a><span class='hs-comment'>-- (p:ps) -> f p</span>
<a name="line-23"></a><span class='hs-comment'>--</span>
<a name="line-24"></a><span class='hs-comment'>-- Now, the abstract value of the branches of the case will be an</span>
<a name="line-25"></a><span class='hs-comment'>-- AbsFun, but when testing for z's absence we want to spot that it's</span>
<a name="line-26"></a><span class='hs-comment'>-- an AbsFun which can't possibly return AbsBot. So when glb'ing we</span>
<a name="line-27"></a><span class='hs-comment'>-- mustn't be too keen to bale out and return AbsBot; the anyBot test</span>
<a name="line-28"></a><span class='hs-comment'>-- spots that (f x) can't possibly return AbsBot.</span>
<a name="line-29"></a>
<a name="line-30"></a><span class='hs-comment'>-- We have also tripped over the following interesting case:</span>
<a name="line-31"></a><span class='hs-comment'>-- case x of</span>
<a name="line-32"></a><span class='hs-comment'>-- [] -> \y -> 1</span>
<a name="line-33"></a><span class='hs-comment'>-- (p:ps) -> f</span>
<a name="line-34"></a><span class='hs-comment'>--</span>
<a name="line-35"></a><span class='hs-comment'>-- Now, suppose f is bound to AbsTop. Does this expression mention z?</span>
<a name="line-36"></a><span class='hs-comment'>-- Obviously not. But the case will take the glb of AbsTop (for f) and</span>
<a name="line-37"></a><span class='hs-comment'>-- an AbsFun (for \y->1). We should not bale out and give AbsBot, because</span>
<a name="line-38"></a><span class='hs-comment'>-- that would say that it *does* mention z (or anything else for that matter).</span>
<a name="line-39"></a><span class='hs-comment'>-- Nor can we always return AbsTop, because the AbsFun might be something</span>
<a name="line-40"></a><span class='hs-comment'>-- like (\y->z), which obviously does mention z. The point is that we're</span>
<a name="line-41"></a><span class='hs-comment'>-- glbing two functions, and AbsTop is not actually the top of the function</span>
<a name="line-42"></a><span class='hs-comment'>-- lattice. It is more like (\xyz -> x|y|z); that is, AbsTop returns</span>
<a name="line-43"></a><span class='hs-comment'>-- poison iff any of its arguments do.</span>
<a name="line-44"></a>
<a name="line-45"></a><span class='hs-comment'>-- Deal with functions specially, because AbsTop isn't the</span>
<a name="line-46"></a><span class='hs-comment'>-- top of their domain.</span>
<a name="line-47"></a>
<a name="line-48"></a><a name="glb"></a><span class='hs-definition'>glb</span> <span class='hs-varid'>v1</span> <span class='hs-varid'>v2</span>
<a name="line-49"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>is_fun</span> <span class='hs-varid'>v1</span> <span class='hs-varop'>||</span> <span class='hs-varid'>is_fun</span> <span class='hs-varid'>v2</span>
<a name="line-50"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>if</span> <span class='hs-varid'>not</span> <span class='hs-layout'>(</span><span class='hs-varid'>anyBot</span> <span class='hs-varid'>v1</span><span class='hs-layout'>)</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>not</span> <span class='hs-layout'>(</span><span class='hs-varid'>anyBot</span> <span class='hs-varid'>v2</span><span class='hs-layout'>)</span>
<a name="line-51"></a> <span class='hs-keyword'>then</span>
<a name="line-52"></a> <span class='hs-conid'>AbsTop</span>
<a name="line-53"></a> <span class='hs-keyword'>else</span>
<a name="line-54"></a> <span class='hs-conid'>AbsBot</span>
<a name="line-55"></a> <span class='hs-keyword'>where</span>
<a name="line-56"></a> <span class='hs-varid'>is_fun</span> <span class='hs-layout'>(</span><span class='hs-conid'>AbsFun</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>True</span>
<a name="line-57"></a> <span class='hs-varid'>is_fun</span> <span class='hs-layout'>(</span><span class='hs-conid'>AbsApproxFun</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>True</span> <span class='hs-comment'>-- Not used, but the glb works ok</span>
<a name="line-58"></a> <span class='hs-varid'>is_fun</span> <span class='hs-varid'>other</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>False</span>
<a name="line-59"></a>
<a name="line-60"></a><span class='hs-comment'>-- The non-functional cases are quite straightforward</span>
<a name="line-61"></a>
<a name="line-62"></a><span class='hs-definition'>glb</span> <span class='hs-layout'>(</span><span class='hs-conid'>AbsProd</span> <span class='hs-varid'>xs</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>AbsProd</span> <span class='hs-varid'>ys</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>AbsProd</span> <span class='hs-layout'>(</span><span class='hs-varid'>zipWithEqual</span> <span class='hs-str'>"glb"</span> <span class='hs-varid'>glb</span> <span class='hs-varid'>xs</span> <span class='hs-varid'>ys</span><span class='hs-layout'>)</span>
<a name="line-63"></a>
<a name="line-64"></a><span class='hs-definition'>glb</span> <span class='hs-conid'>AbsTop</span> <span class='hs-varid'>v2</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>v2</span>
<a name="line-65"></a><span class='hs-definition'>glb</span> <span class='hs-varid'>v1</span> <span class='hs-conid'>AbsTop</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>v1</span>
<a name="line-66"></a>
<a name="line-67"></a><span class='hs-definition'>glb</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>AbsBot</span> <span class='hs-comment'>-- Be pessimistic</span>
</pre>\end{code}
@isBot@ returns True if its argument is (a representation of) bottom. The
``representation'' part is because we need to detect the bottom {\em function}
too. To detect the bottom function, bind its args to top, and see if it
returns bottom.
Used only in strictness analysis:
\begin{code}
<pre><a name="line-1"></a><a name="isBot"></a><span class='hs-definition'>isBot</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>AbsVal</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bool</span>
<a name="line-2"></a>
<a name="line-3"></a><span class='hs-definition'>isBot</span> <span class='hs-conid'>AbsBot</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>True</span>
<a name="line-4"></a><span class='hs-definition'>isBot</span> <span class='hs-varid'>other</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>False</span> <span class='hs-comment'>-- Functions aren't bottom any more</span>
</pre>\end{code}
Used only in absence analysis:
\begin{code}
<pre><a name="line-1"></a><a name="anyBot"></a><span class='hs-definition'>anyBot</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>AbsVal</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bool</span>
<a name="line-2"></a>
<a name="line-3"></a><span class='hs-definition'>anyBot</span> <span class='hs-conid'>AbsBot</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>True</span> <span class='hs-comment'>-- poisoned!</span>
<a name="line-4"></a><span class='hs-definition'>anyBot</span> <span class='hs-conid'>AbsTop</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>False</span>
<a name="line-5"></a><span class='hs-definition'>anyBot</span> <span class='hs-layout'>(</span><span class='hs-conid'>AbsProd</span> <span class='hs-varid'>vals</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>any</span> <span class='hs-varid'>anyBot</span> <span class='hs-varid'>vals</span>
<a name="line-6"></a><span class='hs-definition'>anyBot</span> <span class='hs-layout'>(</span><span class='hs-conid'>AbsFun</span> <span class='hs-varid'>bndr_ty</span> <span class='hs-varid'>abs_fn</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>anyBot</span> <span class='hs-layout'>(</span><span class='hs-varid'>abs_fn</span> <span class='hs-conid'>AbsTop</span><span class='hs-layout'>)</span>
<a name="line-7"></a><span class='hs-definition'>anyBot</span> <span class='hs-layout'>(</span><span class='hs-conid'>AbsApproxFun</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>val</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>anyBot</span> <span class='hs-varid'>val</span>
</pre>\end{code}
@widen@ takes an @AbsVal@, $val$, and returns and @AbsVal@ which is
approximated by $val$. Furthermore, the result has no @AbsFun@s in
it, so it can be compared for equality by @sameVal@.
\begin{code}
<pre><a name="line-1"></a><a name="widen"></a><span class='hs-definition'>widen</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>AnalysisKind</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>AbsVal</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>AbsVal</span>
<a name="line-2"></a>
<a name="line-3"></a><span class='hs-comment'>-- Widening is complicated by the fact that funtions are lifted</span>
<a name="line-4"></a><span class='hs-definition'>widen</span> <span class='hs-conid'>StrAnal</span> <span class='hs-varid'>the_fn</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>AbsFun</span> <span class='hs-varid'>bndr_ty</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span>
<a name="line-5"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>widened_body</span> <span class='hs-keyword'>of</span>
<a name="line-6"></a> <span class='hs-conid'>AbsApproxFun</span> <span class='hs-varid'>ds</span> <span class='hs-varid'>val</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>AbsApproxFun</span> <span class='hs-layout'>(</span><span class='hs-varid'>d</span> <span class='hs-conop'>:</span> <span class='hs-varid'>ds</span><span class='hs-layout'>)</span> <span class='hs-varid'>val</span>
<a name="line-7"></a> <span class='hs-keyword'>where</span>
<a name="line-8"></a> <span class='hs-varid'>d</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>findRecDemand</span> <span class='hs-varid'>str_fn</span> <span class='hs-varid'>abs_fn</span> <span class='hs-varid'>bndr_ty</span>
<a name="line-9"></a> <span class='hs-varid'>str_fn</span> <span class='hs-varid'>val</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>isBot</span> <span class='hs-layout'>(</span><span class='hs-varid'>foldl</span> <span class='hs-layout'>(</span><span class='hs-varid'>absApply</span> <span class='hs-conid'>StrAnal</span><span class='hs-layout'>)</span> <span class='hs-varid'>the_fn</span>
<a name="line-10"></a> <span class='hs-layout'>(</span><span class='hs-varid'>val</span> <span class='hs-conop'>:</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>AbsTop</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>d</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>ds</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-11"></a>
<a name="line-12"></a> <span class='hs-varid'>other</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>AbsApproxFun</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>d</span><span class='hs-keyglyph'>]</span> <span class='hs-varid'>widened_body</span>
<a name="line-13"></a> <span class='hs-keyword'>where</span>
<a name="line-14"></a> <span class='hs-varid'>d</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>findRecDemand</span> <span class='hs-varid'>str_fn</span> <span class='hs-varid'>abs_fn</span> <span class='hs-varid'>bndr_ty</span>
<a name="line-15"></a> <span class='hs-varid'>str_fn</span> <span class='hs-varid'>val</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>isBot</span> <span class='hs-layout'>(</span><span class='hs-varid'>absApply</span> <span class='hs-conid'>StrAnal</span> <span class='hs-varid'>the_fn</span> <span class='hs-varid'>val</span><span class='hs-layout'>)</span>
<a name="line-16"></a> <span class='hs-keyword'>where</span>
<a name="line-17"></a> <span class='hs-varid'>widened_body</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>widen</span> <span class='hs-conid'>StrAnal</span> <span class='hs-layout'>(</span><span class='hs-varid'>absApply</span> <span class='hs-conid'>StrAnal</span> <span class='hs-varid'>the_fn</span> <span class='hs-conid'>AbsTop</span><span class='hs-layout'>)</span>
<a name="line-18"></a> <span class='hs-varid'>abs_fn</span> <span class='hs-varid'>val</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>False</span> <span class='hs-comment'>-- Always says poison; so it looks as if</span>
<a name="line-19"></a> <span class='hs-comment'>-- nothing is absent; safe</span>
<a name="line-20"></a>
<a name="line-21"></a><span class='hs-comment'>{- OLD comment...
<a name="line-22"></a> This stuff is now instead handled neatly by the fact that AbsApproxFun
<a name="line-23"></a> contains an AbsVal inside it. SLPJ Jan 97
<a name="line-24"></a>
<a name="line-25"></a> | isBot abs_body = AbsBot
<a name="line-26"></a> -- It's worth checking for a function which is unconditionally
<a name="line-27"></a> -- bottom. Consider
<a name="line-28"></a> --
<a name="line-29"></a> -- f x y = let g y = case x of ...
<a name="line-30"></a> -- in (g ..) + (g ..)
<a name="line-31"></a> --
<a name="line-32"></a> -- Here, when we are considering strictness of f in x, we'll
<a name="line-33"></a> -- evaluate the body of f with x bound to bottom. The current
<a name="line-34"></a> -- strategy is to bind g to its *widened* value; without the isBot
<a name="line-35"></a> -- (...) test above, we'd bind g to an AbsApproxFun, and deliver
<a name="line-36"></a> -- Top, not Bot as the value of f's rhs. The test spots the
<a name="line-37"></a> -- unconditional bottom-ness of g when x is bottom. (Another
<a name="line-38"></a> -- alternative here would be to bind g to its exact abstract
<a name="line-39"></a> -- value, but that entails lots of potential re-computation, at
<a name="line-40"></a> -- every application of g.)
<a name="line-41"></a>-}</span>
<a name="line-42"></a>
<a name="line-43"></a><span class='hs-definition'>widen</span> <span class='hs-conid'>StrAnal</span> <span class='hs-layout'>(</span><span class='hs-conid'>AbsProd</span> <span class='hs-varid'>vals</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>AbsProd</span> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-layout'>(</span><span class='hs-varid'>widen</span> <span class='hs-conid'>StrAnal</span><span class='hs-layout'>)</span> <span class='hs-varid'>vals</span><span class='hs-layout'>)</span>
<a name="line-44"></a><span class='hs-definition'>widen</span> <span class='hs-conid'>StrAnal</span> <span class='hs-varid'>other_val</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>other_val</span>
<a name="line-45"></a>
<a name="line-46"></a>
<a name="line-47"></a><span class='hs-definition'>widen</span> <span class='hs-conid'>AbsAnal</span> <span class='hs-varid'>the_fn</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>AbsFun</span> <span class='hs-varid'>bndr_ty</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span>
<a name="line-48"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>anyBot</span> <span class='hs-varid'>widened_body</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>AbsBot</span>
<a name="line-49"></a> <span class='hs-comment'>-- In the absence-analysis case it's *essential* to check</span>
<a name="line-50"></a> <span class='hs-comment'>-- that the function has no poison in its body. If it does,</span>
<a name="line-51"></a> <span class='hs-comment'>-- anywhere, then the whole function is poisonous.</span>
<a name="line-52"></a>
<a name="line-53"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span>
<a name="line-54"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>widened_body</span> <span class='hs-keyword'>of</span>
<a name="line-55"></a> <span class='hs-conid'>AbsApproxFun</span> <span class='hs-varid'>ds</span> <span class='hs-varid'>val</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>AbsApproxFun</span> <span class='hs-layout'>(</span><span class='hs-varid'>d</span> <span class='hs-conop'>:</span> <span class='hs-varid'>ds</span><span class='hs-layout'>)</span> <span class='hs-varid'>val</span>
<a name="line-56"></a> <span class='hs-keyword'>where</span>
<a name="line-57"></a> <span class='hs-varid'>d</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>findRecDemand</span> <span class='hs-varid'>str_fn</span> <span class='hs-varid'>abs_fn</span> <span class='hs-varid'>bndr_ty</span>
<a name="line-58"></a> <span class='hs-varid'>abs_fn</span> <span class='hs-varid'>val</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>not</span> <span class='hs-layout'>(</span><span class='hs-varid'>anyBot</span> <span class='hs-layout'>(</span><span class='hs-varid'>foldl</span> <span class='hs-layout'>(</span><span class='hs-varid'>absApply</span> <span class='hs-conid'>AbsAnal</span><span class='hs-layout'>)</span> <span class='hs-varid'>the_fn</span>
<a name="line-59"></a> <span class='hs-layout'>(</span><span class='hs-varid'>val</span> <span class='hs-conop'>:</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>AbsTop</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>d</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>ds</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-60"></a>
<a name="line-61"></a> <span class='hs-varid'>other</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>AbsApproxFun</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>d</span><span class='hs-keyglyph'>]</span> <span class='hs-varid'>widened_body</span>
<a name="line-62"></a> <span class='hs-keyword'>where</span>
<a name="line-63"></a> <span class='hs-varid'>d</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>findRecDemand</span> <span class='hs-varid'>str_fn</span> <span class='hs-varid'>abs_fn</span> <span class='hs-varid'>bndr_ty</span>
<a name="line-64"></a> <span class='hs-varid'>abs_fn</span> <span class='hs-varid'>val</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>not</span> <span class='hs-layout'>(</span><span class='hs-varid'>anyBot</span> <span class='hs-layout'>(</span><span class='hs-varid'>absApply</span> <span class='hs-conid'>AbsAnal</span> <span class='hs-varid'>the_fn</span> <span class='hs-varid'>val</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-65"></a> <span class='hs-keyword'>where</span>
<a name="line-66"></a> <span class='hs-varid'>widened_body</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>widen</span> <span class='hs-conid'>AbsAnal</span> <span class='hs-layout'>(</span><span class='hs-varid'>absApply</span> <span class='hs-conid'>AbsAnal</span> <span class='hs-varid'>the_fn</span> <span class='hs-conid'>AbsTop</span><span class='hs-layout'>)</span>
<a name="line-67"></a> <span class='hs-varid'>str_fn</span> <span class='hs-varid'>val</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>True</span> <span class='hs-comment'>-- Always says non-termination;</span>
<a name="line-68"></a> <span class='hs-comment'>-- that'll make findRecDemand peer into the</span>
<a name="line-69"></a> <span class='hs-comment'>-- structure of the value.</span>
<a name="line-70"></a>
<a name="line-71"></a><span class='hs-definition'>widen</span> <span class='hs-conid'>AbsAnal</span> <span class='hs-layout'>(</span><span class='hs-conid'>AbsProd</span> <span class='hs-varid'>vals</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>AbsProd</span> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-layout'>(</span><span class='hs-varid'>widen</span> <span class='hs-conid'>AbsAnal</span><span class='hs-layout'>)</span> <span class='hs-varid'>vals</span><span class='hs-layout'>)</span>
<a name="line-72"></a>
<a name="line-73"></a> <span class='hs-comment'>-- It's desirable to do a good job of widening for product</span>
<a name="line-74"></a> <span class='hs-comment'>-- values. Consider</span>
<a name="line-75"></a> <span class='hs-comment'>--</span>
<a name="line-76"></a> <span class='hs-comment'>-- let p = (x,y)</span>
<a name="line-77"></a> <span class='hs-comment'>-- in ...(case p of (x,y) -> x)...</span>
<a name="line-78"></a> <span class='hs-comment'>--</span>
<a name="line-79"></a> <span class='hs-comment'>-- Now, is y absent in this expression? Currently the</span>
<a name="line-80"></a> <span class='hs-comment'>-- analyser widens p before looking at p's scope, to avoid</span>
<a name="line-81"></a> <span class='hs-comment'>-- lots of recomputation in the case where p is a function.</span>
<a name="line-82"></a> <span class='hs-comment'>-- So if widening doesn't have a case for products, we'll</span>
<a name="line-83"></a> <span class='hs-comment'>-- widen p to AbsBot (since when searching for absence in y we</span>
<a name="line-84"></a> <span class='hs-comment'>-- bind y to poison ie AbsBot), and now we are lost.</span>
<a name="line-85"></a>
<a name="line-86"></a><span class='hs-definition'>widen</span> <span class='hs-conid'>AbsAnal</span> <span class='hs-varid'>other_val</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>other_val</span>
<a name="line-87"></a>
<a name="line-88"></a><span class='hs-comment'>-- WAS: if anyBot val then AbsBot else AbsTop</span>
<a name="line-89"></a><span class='hs-comment'>-- Nowadays widen is doing a better job on functions for absence analysis.</span>
</pre>\end{code}
@crudeAbsWiden@ is used just for absence analysis, and always
returns AbsTop or AbsBot, so it widens to a two-point domain
\begin{code}
<pre><a name="line-1"></a><a name="crudeAbsWiden"></a><span class='hs-definition'>crudeAbsWiden</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>AbsVal</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>AbsVal</span>
<a name="line-2"></a><span class='hs-definition'>crudeAbsWiden</span> <span class='hs-varid'>val</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>if</span> <span class='hs-varid'>anyBot</span> <span class='hs-varid'>val</span> <span class='hs-keyword'>then</span> <span class='hs-conid'>AbsBot</span> <span class='hs-keyword'>else</span> <span class='hs-conid'>AbsTop</span>
</pre>\end{code}
@sameVal@ compares two abstract values for equality. It can't deal with
@AbsFun@, but that should have been removed earlier in the day by @widen@.
\begin{code}
<pre><a name="line-1"></a><a name="sameVal"></a><span class='hs-definition'>sameVal</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>AbsVal</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>AbsVal</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bool</span> <span class='hs-comment'>-- Can't handle AbsFun!</span>
<a name="line-2"></a>
<a name="line-3"></a><span class='hs-cpp'>#ifdef DEBUG</span>
<a name="line-4"></a><span class='hs-definition'>sameVal</span> <span class='hs-layout'>(</span><span class='hs-conid'>AbsFun</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>panic</span> <span class='hs-str'>"sameVal: AbsFun: arg1"</span>
<a name="line-5"></a><span class='hs-definition'>sameVal</span> <span class='hs-keyword'>_</span> <span class='hs-layout'>(</span><span class='hs-conid'>AbsFun</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>panic</span> <span class='hs-str'>"sameVal: AbsFun: arg2"</span>
<a name="line-6"></a><span class='hs-cpp'>#endif</span>
<a name="line-7"></a>
<a name="line-8"></a><span class='hs-definition'>sameVal</span> <span class='hs-conid'>AbsBot</span> <span class='hs-conid'>AbsBot</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>True</span>
<a name="line-9"></a><span class='hs-definition'>sameVal</span> <span class='hs-conid'>AbsBot</span> <span class='hs-varid'>other</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>False</span> <span class='hs-comment'>-- widen has reduced AbsFun bots to AbsBot</span>
<a name="line-10"></a>
<a name="line-11"></a><span class='hs-definition'>sameVal</span> <span class='hs-conid'>AbsTop</span> <span class='hs-conid'>AbsTop</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>True</span>
<a name="line-12"></a><span class='hs-definition'>sameVal</span> <span class='hs-conid'>AbsTop</span> <span class='hs-varid'>other</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>False</span> <span class='hs-comment'>-- Right?</span>
<a name="line-13"></a>
<a name="line-14"></a><span class='hs-definition'>sameVal</span> <span class='hs-layout'>(</span><span class='hs-conid'>AbsProd</span> <span class='hs-varid'>vals1</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>AbsProd</span> <span class='hs-varid'>vals2</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>and</span> <span class='hs-layout'>(</span><span class='hs-varid'>zipWithEqual</span> <span class='hs-str'>"sameVal"</span> <span class='hs-varid'>sameVal</span> <span class='hs-varid'>vals1</span> <span class='hs-varid'>vals2</span><span class='hs-layout'>)</span>
<a name="line-15"></a><span class='hs-definition'>sameVal</span> <span class='hs-layout'>(</span><span class='hs-conid'>AbsProd</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-conid'>AbsTop</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>False</span>
<a name="line-16"></a><span class='hs-definition'>sameVal</span> <span class='hs-layout'>(</span><span class='hs-conid'>AbsProd</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-conid'>AbsBot</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>False</span>
<a name="line-17"></a>
<a name="line-18"></a><span class='hs-definition'>sameVal</span> <span class='hs-layout'>(</span><span class='hs-conid'>AbsApproxFun</span> <span class='hs-varid'>str1</span> <span class='hs-varid'>v1</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>AbsApproxFun</span> <span class='hs-varid'>str2</span> <span class='hs-varid'>v2</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>str1</span> <span class='hs-varop'>==</span> <span class='hs-varid'>str2</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>sameVal</span> <span class='hs-varid'>v1</span> <span class='hs-varid'>v2</span>
<a name="line-19"></a><span class='hs-definition'>sameVal</span> <span class='hs-layout'>(</span><span class='hs-conid'>AbsApproxFun</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-conid'>AbsTop</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>False</span>
<a name="line-20"></a><span class='hs-definition'>sameVal</span> <span class='hs-layout'>(</span><span class='hs-conid'>AbsApproxFun</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-conid'>AbsBot</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>False</span>
<a name="line-21"></a>
<a name="line-22"></a><span class='hs-definition'>sameVal</span> <span class='hs-varid'>val1</span> <span class='hs-varid'>val2</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>panic</span> <span class='hs-str'>"sameVal: type mismatch or AbsFun encountered"</span>
</pre>\end{code}
@evalStrictness@ compares a @Demand@ with an abstract value, returning
@True@ iff the abstract value is {\em less defined} than the demand.
(@True@ is the exciting answer; @False@ is always safe.)
\begin{code}
<pre><a name="line-1"></a><a name="evalStrictness"></a><span class='hs-definition'>evalStrictness</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Demand</span>
<a name="line-2"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>AbsVal</span>
<a name="line-3"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bool</span> <span class='hs-comment'>-- True iff the value is sure</span>
<a name="line-4"></a> <span class='hs-comment'>-- to be less defined than the Demand</span>
<a name="line-5"></a>
<a name="line-6"></a><span class='hs-definition'>evalStrictness</span> <span class='hs-layout'>(</span><span class='hs-conid'>WwLazy</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>False</span>
<a name="line-7"></a><span class='hs-definition'>evalStrictness</span> <span class='hs-conid'>WwStrict</span> <span class='hs-varid'>val</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>isBot</span> <span class='hs-varid'>val</span>
<a name="line-8"></a><span class='hs-definition'>evalStrictness</span> <span class='hs-conid'>WwEnum</span> <span class='hs-varid'>val</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>isBot</span> <span class='hs-varid'>val</span>
<a name="line-9"></a>
<a name="line-10"></a><span class='hs-definition'>evalStrictness</span> <span class='hs-layout'>(</span><span class='hs-conid'>WwUnpack</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>demand_info</span><span class='hs-layout'>)</span> <span class='hs-varid'>val</span>
<a name="line-11"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>val</span> <span class='hs-keyword'>of</span>
<a name="line-12"></a> <span class='hs-conid'>AbsTop</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>False</span>
<a name="line-13"></a> <span class='hs-conid'>AbsBot</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>True</span>
<a name="line-14"></a> <span class='hs-conid'>AbsProd</span> <span class='hs-varid'>vals</span>
<a name="line-15"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>not</span> <span class='hs-layout'>(</span><span class='hs-varid'>equalLength</span> <span class='hs-varid'>vals</span> <span class='hs-varid'>demand_info</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>pprTrace</span> <span class='hs-str'>"TELL SIMON: evalStrictness"</span> <span class='hs-layout'>(</span><span class='hs-varid'>ppr</span> <span class='hs-varid'>demand_info</span> <span class='hs-varop'>$$</span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>val</span><span class='hs-layout'>)</span>
<a name="line-16"></a> <span class='hs-conid'>False</span>
<a name="line-17"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>or</span> <span class='hs-layout'>(</span><span class='hs-varid'>zipWithEqual</span> <span class='hs-str'>"evalStrictness"</span> <span class='hs-varid'>evalStrictness</span> <span class='hs-varid'>demand_info</span> <span class='hs-varid'>vals</span><span class='hs-layout'>)</span>
<a name="line-18"></a>
<a name="line-19"></a> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>pprTrace</span> <span class='hs-str'>"evalStrictness?"</span> <span class='hs-varid'>empty</span> <span class='hs-conid'>False</span>
<a name="line-20"></a>
<a name="line-21"></a><span class='hs-definition'>evalStrictness</span> <span class='hs-conid'>WwPrim</span> <span class='hs-varid'>val</span>
<a name="line-22"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>val</span> <span class='hs-keyword'>of</span>
<a name="line-23"></a> <span class='hs-conid'>AbsTop</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>False</span>
<a name="line-24"></a> <span class='hs-conid'>AbsBot</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>True</span> <span class='hs-comment'>-- Can happen: consider f (g x), where g is a </span>
<a name="line-25"></a> <span class='hs-comment'>-- recursive function returning an Int# that diverges</span>
<a name="line-26"></a>
<a name="line-27"></a> <span class='hs-varid'>other</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>pprPanic</span> <span class='hs-str'>"evalStrictness: WwPrim:"</span> <span class='hs-layout'>(</span><span class='hs-varid'>ppr</span> <span class='hs-varid'>other</span><span class='hs-layout'>)</span>
</pre>\end{code}
For absence analysis, we're interested in whether "poison" in the
argument (ie a bottom therein) can propagate to the result of the
function call; that is, whether the specified demand can {\em
possibly} hit poison.
\begin{code}
<pre><a name="line-1"></a><a name="evalAbsence"></a><span class='hs-definition'>evalAbsence</span> <span class='hs-layout'>(</span><span class='hs-conid'>WwLazy</span> <span class='hs-conid'>True</span><span class='hs-layout'>)</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>False</span> <span class='hs-comment'>-- Can't possibly hit poison</span>
<a name="line-2"></a> <span class='hs-comment'>-- with Absent demand</span>
<a name="line-3"></a>
<a name="line-4"></a><span class='hs-definition'>evalAbsence</span> <span class='hs-layout'>(</span><span class='hs-conid'>WwUnpack</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>demand_info</span><span class='hs-layout'>)</span> <span class='hs-varid'>val</span>
<a name="line-5"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>val</span> <span class='hs-keyword'>of</span>
<a name="line-6"></a> <span class='hs-conid'>AbsTop</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>False</span> <span class='hs-comment'>-- No poison in here</span>
<a name="line-7"></a> <span class='hs-conid'>AbsBot</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>True</span> <span class='hs-comment'>-- Pure poison</span>
<a name="line-8"></a> <span class='hs-conid'>AbsProd</span> <span class='hs-varid'>vals</span>
<a name="line-9"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>not</span> <span class='hs-layout'>(</span><span class='hs-varid'>equalLength</span> <span class='hs-varid'>vals</span> <span class='hs-varid'>demand_info</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>pprTrace</span> <span class='hs-str'>"TELL SIMON: evalAbsence"</span> <span class='hs-layout'>(</span><span class='hs-varid'>ppr</span> <span class='hs-varid'>demand_info</span> <span class='hs-varop'>$$</span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>val</span><span class='hs-layout'>)</span>
<a name="line-10"></a> <span class='hs-conid'>True</span>
<a name="line-11"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>or</span> <span class='hs-layout'>(</span><span class='hs-varid'>zipWithEqual</span> <span class='hs-str'>"evalAbsence"</span> <span class='hs-varid'>evalAbsence</span> <span class='hs-varid'>demand_info</span> <span class='hs-varid'>vals</span><span class='hs-layout'>)</span>
<a name="line-12"></a> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>pprTrace</span> <span class='hs-str'>"TELL SIMON: evalAbsence"</span>
<a name="line-13"></a> <span class='hs-layout'>(</span><span class='hs-varid'>ppr</span> <span class='hs-varid'>demand_info</span> <span class='hs-varop'>$$</span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>val</span><span class='hs-layout'>)</span>
<a name="line-14"></a> <span class='hs-conid'>True</span>
<a name="line-15"></a>
<a name="line-16"></a><span class='hs-definition'>evalAbsence</span> <span class='hs-varid'>other</span> <span class='hs-varid'>val</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>anyBot</span> <span class='hs-varid'>val</span>
<a name="line-17"></a> <span class='hs-comment'>-- The demand is conservative; even "Lazy" *might* evaluate the</span>
<a name="line-18"></a> <span class='hs-comment'>-- argument arbitrarily so we have to look everywhere for poison</span>
</pre>\end{code}
%************************************************************************
%* *
\subsection[absEval]{Evaluate an expression in the abstract domain}
%* *
%************************************************************************
\begin{code}
<pre><a name="line-1"></a><span class='hs-comment'>-- The isBottomingId stuf is now dealt with via the Id's strictness info</span>
<a name="line-2"></a><span class='hs-comment'>-- absId anal var env | isBottomingId var</span>
<a name="line-3"></a><span class='hs-comment'>-- = case anal of</span>
<a name="line-4"></a><span class='hs-comment'>-- StrAnal -> AbsBot -- See discussion below</span>
<a name="line-5"></a><span class='hs-comment'>-- AbsAnal -> AbsTop -- Just want to see if there's any poison in</span>
<a name="line-6"></a> <span class='hs-comment'>-- error's arg</span>
<a name="line-7"></a>
<a name="line-8"></a><a name="absId"></a><span class='hs-definition'>absId</span> <span class='hs-varid'>anal</span> <span class='hs-varid'>var</span> <span class='hs-varid'>env</span>
<a name="line-9"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-layout'>(</span><span class='hs-varid'>lookupAbsValEnv</span> <span class='hs-varid'>env</span> <span class='hs-varid'>var</span><span class='hs-layout'>,</span>
<a name="line-10"></a> <span class='hs-varid'>isDataConWorkId_maybe</span> <span class='hs-varid'>var</span><span class='hs-layout'>,</span>
<a name="line-11"></a> <span class='hs-varid'>idStrictness</span> <span class='hs-varid'>var</span><span class='hs-layout'>,</span>
<a name="line-12"></a> <span class='hs-varid'>maybeUnfoldingTemplate</span> <span class='hs-layout'>(</span><span class='hs-varid'>idUnfolding</span> <span class='hs-varid'>var</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-keyword'>of</span>
<a name="line-13"></a>
<a name="line-14"></a> <span class='hs-layout'>(</span><span class='hs-conid'>Just</span> <span class='hs-varid'>abs_val</span><span class='hs-layout'>,</span> <span class='hs-keyword'>_</span><span class='hs-layout'>,</span> <span class='hs-keyword'>_</span><span class='hs-layout'>,</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span>
<a name="line-15"></a> <span class='hs-varid'>abs_val</span> <span class='hs-comment'>-- Bound in the environment</span>
<a name="line-16"></a>
<a name="line-17"></a> <span class='hs-layout'>(</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span> <span class='hs-conid'>Just</span> <span class='hs-varid'>data_con</span><span class='hs-layout'>,</span> <span class='hs-keyword'>_</span><span class='hs-layout'>,</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>isProductTyCon</span> <span class='hs-varid'>tycon</span> <span class='hs-varop'>&&</span>
<a name="line-18"></a> <span class='hs-varid'>not</span> <span class='hs-layout'>(</span><span class='hs-varid'>isRecursiveTyCon</span> <span class='hs-varid'>tycon</span><span class='hs-layout'>)</span>
<a name="line-19"></a> <span class='hs-keyglyph'>-></span> <span class='hs-comment'>-- A product. We get infinite loops if we don't</span>
<a name="line-20"></a> <span class='hs-comment'>-- check for recursive products!</span>
<a name="line-21"></a> <span class='hs-comment'>-- The strictness info on the constructor </span>
<a name="line-22"></a> <span class='hs-comment'>-- isn't expressive enough to contain its abstract value</span>
<a name="line-23"></a> <span class='hs-varid'>productAbsVal</span> <span class='hs-layout'>(</span><span class='hs-varid'>dataConRepArgTys</span> <span class='hs-varid'>data_con</span><span class='hs-layout'>)</span> <span class='hs-conid'>[]</span>
<a name="line-24"></a> <span class='hs-keyword'>where</span>
<a name="line-25"></a> <span class='hs-varid'>tycon</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>dataConTyCon</span> <span class='hs-varid'>data_con</span>
<a name="line-26"></a>
<a name="line-27"></a> <span class='hs-layout'>(</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span> <span class='hs-keyword'>_</span><span class='hs-layout'>,</span> <span class='hs-conid'>NoStrictnessInfo</span><span class='hs-layout'>,</span> <span class='hs-conid'>Just</span> <span class='hs-varid'>unfolding</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span>
<a name="line-28"></a> <span class='hs-comment'>-- We have an unfolding for the expr</span>
<a name="line-29"></a> <span class='hs-comment'>-- Assume the unfolding has no free variables since it</span>
<a name="line-30"></a> <span class='hs-comment'>-- came from inside the Id</span>
<a name="line-31"></a> <span class='hs-varid'>absEval</span> <span class='hs-varid'>anal</span> <span class='hs-varid'>unfolding</span> <span class='hs-varid'>env</span>
<a name="line-32"></a> <span class='hs-comment'>-- Notice here that we only look in the unfolding if we don't</span>
<a name="line-33"></a> <span class='hs-comment'>-- have strictness info (an unusual situation).</span>
<a name="line-34"></a> <span class='hs-comment'>-- We could have chosen to look in the unfolding if it exists,</span>
<a name="line-35"></a> <span class='hs-comment'>-- and only try the strictness info if it doesn't, and that would</span>
<a name="line-36"></a> <span class='hs-comment'>-- give more accurate results, at the cost of re-abstract-interpreting</span>
<a name="line-37"></a> <span class='hs-comment'>-- the unfolding every time.</span>
<a name="line-38"></a> <span class='hs-comment'>-- We found only one place where the look-at-unfolding-first</span>
<a name="line-39"></a> <span class='hs-comment'>-- method gave better results, which is in the definition of</span>
<a name="line-40"></a> <span class='hs-comment'>-- showInt in the Prelude. In its defintion, fromIntegral is</span>
<a name="line-41"></a> <span class='hs-comment'>-- not inlined (it's big) but ab-interp-ing its unfolding gave</span>
<a name="line-42"></a> <span class='hs-comment'>-- a better result than looking at its strictness only.</span>
<a name="line-43"></a> <span class='hs-comment'>-- showInt :: Integral a => a -> [Char] -> [Char]</span>
<a name="line-44"></a> <span class='hs-comment'>-- ! {-# GHC_PRAGMA _A_ 1 _U_ 122 _S_</span>
<a name="line-45"></a> <span class='hs-comment'>-- "U(U(U(U(SA)AAAAAAAAL)AA)AAAAASAAASA)" {...} _N_ _N_ #-}</span>
<a name="line-46"></a> <span class='hs-comment'>-- --- 42,44 ----</span>
<a name="line-47"></a> <span class='hs-comment'>-- showInt :: Integral a => a -> [Char] -> [Char]</span>
<a name="line-48"></a> <span class='hs-comment'>-- ! {-# GHC_PRAGMA _A_ 1 _U_ 122 _S_</span>
<a name="line-49"></a> <span class='hs-comment'>-- "U(U(U(U(SL)LLLLLLLLL)LL)LLLLLSLLLLL)" _N_ _N_ #-}</span>
<a name="line-50"></a>
<a name="line-51"></a>
<a name="line-52"></a> <span class='hs-layout'>(</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span> <span class='hs-keyword'>_</span><span class='hs-layout'>,</span> <span class='hs-varid'>strictness_info</span><span class='hs-layout'>,</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span>
<a name="line-53"></a> <span class='hs-comment'>-- Includes NoUnfolding</span>
<a name="line-54"></a> <span class='hs-comment'>-- Try the strictness info</span>
<a name="line-55"></a> <span class='hs-varid'>absValFromStrictness</span> <span class='hs-varid'>anal</span> <span class='hs-varid'>strictness_info</span>
<a name="line-56"></a>
<a name="line-57"></a><a name="productAbsVal"></a><span class='hs-definition'>productAbsVal</span> <span class='hs-conid'>[]</span> <span class='hs-varid'>rev_abs_args</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>AbsProd</span> <span class='hs-layout'>(</span><span class='hs-varid'>reverse</span> <span class='hs-varid'>rev_abs_args</span><span class='hs-layout'>)</span>
<a name="line-58"></a><span class='hs-definition'>productAbsVal</span> <span class='hs-layout'>(</span><span class='hs-varid'>arg_ty</span> <span class='hs-conop'>:</span> <span class='hs-varid'>arg_tys</span><span class='hs-layout'>)</span> <span class='hs-varid'>rev_abs_args</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>AbsFun</span> <span class='hs-varid'>arg_ty</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span> <span class='hs-varid'>abs_arg</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>productAbsVal</span> <span class='hs-varid'>arg_tys</span> <span class='hs-layout'>(</span><span class='hs-varid'>abs_arg</span> <span class='hs-conop'>:</span> <span class='hs-varid'>rev_abs_args</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
</pre>\end{code}
\begin{code}
<pre><a name="line-1"></a><a name="absEval"></a><span class='hs-definition'>absEval</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>AnalysisKind</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>CoreExpr</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>AbsValEnv</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>AbsVal</span>
<a name="line-2"></a>
<a name="line-3"></a><span class='hs-definition'>absEval</span> <span class='hs-varid'>anal</span> <span class='hs-layout'>(</span><span class='hs-conid'>Type</span> <span class='hs-varid'>ty</span><span class='hs-layout'>)</span> <span class='hs-varid'>env</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>AbsTop</span>
<a name="line-4"></a><span class='hs-definition'>absEval</span> <span class='hs-varid'>anal</span> <span class='hs-layout'>(</span><span class='hs-conid'>Var</span> <span class='hs-varid'>var</span><span class='hs-layout'>)</span> <span class='hs-varid'>env</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>absId</span> <span class='hs-varid'>anal</span> <span class='hs-varid'>var</span> <span class='hs-varid'>env</span>
</pre>\end{code}
Discussion about error (following/quoting Lennart): Any expression
'error e' is regarded as bottom (with HBC, with the -ffail-strict
flag, on with -O).
Regarding it as bottom gives much better strictness properties for
some functions. E.g.
f [x] y = x+y
f (x:xs) y = f xs (x+y)
i.e.
f [] _ = error "no match"
f [x] y = x+y
f (x:xs) y = f xs (x+y)
is strict in y, which you really want. But, it may lead to
transformations that turn a call to \tr{error} into non-termination.
(The odds of this happening aren't good.)
Things are a little different for absence analysis, because we want
to make sure that any poison (?????)
\begin{code}
<pre><a name="line-1"></a><a name="absEval"></a><span class='hs-definition'>absEval</span> <span class='hs-varid'>anal</span> <span class='hs-layout'>(</span><span class='hs-conid'>Lit</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-varid'>env</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>AbsTop</span>
<a name="line-2"></a> <span class='hs-comment'>-- Literals terminate (strictness) and are not poison (absence)</span>
</pre>\end{code}
\begin{code}
<pre><a name="line-1"></a><a name="absEval"></a><span class='hs-definition'>absEval</span> <span class='hs-varid'>anal</span> <span class='hs-layout'>(</span><span class='hs-conid'>Lam</span> <span class='hs-varid'>bndr</span> <span class='hs-varid'>body</span><span class='hs-layout'>)</span> <span class='hs-varid'>env</span>
<a name="line-2"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>isTyVar</span> <span class='hs-varid'>bndr</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>absEval</span> <span class='hs-varid'>anal</span> <span class='hs-varid'>body</span> <span class='hs-varid'>env</span> <span class='hs-comment'>-- Type lambda</span>
<a name="line-3"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>AbsFun</span> <span class='hs-layout'>(</span><span class='hs-varid'>idType</span> <span class='hs-varid'>bndr</span><span class='hs-layout'>)</span> <span class='hs-varid'>abs_fn</span> <span class='hs-comment'>-- Value lambda</span>
<a name="line-4"></a> <span class='hs-keyword'>where</span>
<a name="line-5"></a> <span class='hs-varid'>abs_fn</span> <span class='hs-varid'>arg</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>absEval</span> <span class='hs-varid'>anal</span> <span class='hs-varid'>body</span> <span class='hs-layout'>(</span><span class='hs-varid'>addOneToAbsValEnv</span> <span class='hs-varid'>env</span> <span class='hs-varid'>bndr</span> <span class='hs-varid'>arg</span><span class='hs-layout'>)</span>
<a name="line-6"></a>
<a name="line-7"></a><span class='hs-definition'>absEval</span> <span class='hs-varid'>anal</span> <span class='hs-layout'>(</span><span class='hs-conid'>App</span> <span class='hs-varid'>expr</span> <span class='hs-layout'>(</span><span class='hs-conid'>Type</span> <span class='hs-varid'>ty</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-varid'>env</span>
<a name="line-8"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>absEval</span> <span class='hs-varid'>anal</span> <span class='hs-varid'>expr</span> <span class='hs-varid'>env</span> <span class='hs-comment'>-- Type appplication</span>
<a name="line-9"></a><span class='hs-definition'>absEval</span> <span class='hs-varid'>anal</span> <span class='hs-layout'>(</span><span class='hs-conid'>App</span> <span class='hs-varid'>f</span> <span class='hs-varid'>val_arg</span><span class='hs-layout'>)</span> <span class='hs-varid'>env</span>
<a name="line-10"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>absApply</span> <span class='hs-varid'>anal</span> <span class='hs-layout'>(</span><span class='hs-varid'>absEval</span> <span class='hs-varid'>anal</span> <span class='hs-varid'>f</span> <span class='hs-varid'>env</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- Value applicationn</span>
<a name="line-11"></a> <span class='hs-layout'>(</span><span class='hs-varid'>absEval</span> <span class='hs-varid'>anal</span> <span class='hs-varid'>val_arg</span> <span class='hs-varid'>env</span><span class='hs-layout'>)</span>
</pre>\end{code}
\begin{code}
<pre><a name="line-1"></a><a name="absEval"></a><span class='hs-definition'>absEval</span> <span class='hs-varid'>anal</span> <span class='hs-varid'>expr</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>Case</span> <span class='hs-varid'>scrut</span> <span class='hs-varid'>case_bndr</span> <span class='hs-varid'>alts</span><span class='hs-layout'>)</span> <span class='hs-varid'>env</span>
<a name="line-2"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>let</span>
<a name="line-3"></a> <span class='hs-varid'>scrut_val</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>absEval</span> <span class='hs-varid'>anal</span> <span class='hs-varid'>scrut</span> <span class='hs-varid'>env</span>
<a name="line-4"></a> <span class='hs-varid'>alts_env</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>addOneToAbsValEnv</span> <span class='hs-varid'>env</span> <span class='hs-varid'>case_bndr</span> <span class='hs-varid'>scrut_val</span>
<a name="line-5"></a> <span class='hs-keyword'>in</span>
<a name="line-6"></a> <span class='hs-keyword'>case</span> <span class='hs-layout'>(</span><span class='hs-varid'>scrut_val</span><span class='hs-layout'>,</span> <span class='hs-varid'>alts</span><span class='hs-layout'>)</span> <span class='hs-keyword'>of</span>
<a name="line-7"></a> <span class='hs-layout'>(</span><span class='hs-conid'>AbsBot</span><span class='hs-layout'>,</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>AbsBot</span>
<a name="line-8"></a>
<a name="line-9"></a> <span class='hs-layout'>(</span><span class='hs-conid'>AbsProd</span> <span class='hs-varid'>arg_vals</span><span class='hs-layout'>,</span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-varid'>con</span><span class='hs-layout'>,</span> <span class='hs-varid'>bndrs</span><span class='hs-layout'>,</span> <span class='hs-varid'>rhs</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span>
<a name="line-10"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>con</span> <span class='hs-varop'>/=</span> <span class='hs-conid'>DEFAULT</span> <span class='hs-keyglyph'>-></span>
<a name="line-11"></a> <span class='hs-comment'>-- The scrutinee is a product value, so it must be of a single-constr</span>
<a name="line-12"></a> <span class='hs-comment'>-- type; so the constructor in this alternative must be the right one</span>
<a name="line-13"></a> <span class='hs-comment'>-- so we can go ahead and bind the constructor args to the components</span>
<a name="line-14"></a> <span class='hs-comment'>-- of the product value.</span>
<a name="line-15"></a> <span class='hs-conid'>ASSERT</span><span class='hs-layout'>(</span><span class='hs-varid'>equalLength</span> <span class='hs-varid'>arg_vals</span> <span class='hs-varid'>val_bndrs</span><span class='hs-layout'>)</span>
<a name="line-16"></a> <span class='hs-varid'>absEval</span> <span class='hs-varid'>anal</span> <span class='hs-varid'>rhs</span> <span class='hs-varid'>rhs_env</span>
<a name="line-17"></a> <span class='hs-keyword'>where</span>
<a name="line-18"></a> <span class='hs-varid'>val_bndrs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>filter</span> <span class='hs-varid'>isId</span> <span class='hs-varid'>bndrs</span>
<a name="line-19"></a> <span class='hs-varid'>rhs_env</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>growAbsValEnvList</span> <span class='hs-varid'>alts_env</span> <span class='hs-layout'>(</span><span class='hs-varid'>val_bndrs</span> <span class='hs-varop'>`zip`</span> <span class='hs-varid'>arg_vals</span><span class='hs-layout'>)</span>
<a name="line-20"></a>
<a name="line-21"></a> <span class='hs-varid'>other</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>absEvalAlts</span> <span class='hs-varid'>anal</span> <span class='hs-varid'>alts</span> <span class='hs-varid'>alts_env</span>
</pre>\end{code}
For @Lets@ we widen the value we get. This is nothing to
do with fixpointing. The reason is so that we don't get an explosion
in the amount of computation. For example, consider:
\begin{verbatim}
let
g a = case a of
q1 -> ...
q2 -> ...
f x = case x of
p1 -> ...g r...
p2 -> ...g s...
in
f e
\end{verbatim}
If we bind @f@ and @g@ to their exact abstract value, then we'll
``execute'' one call to @f@ and {\em two} calls to @g@. This can blow
up exponentially. Widening cuts it off by making a fixed
approximation to @f@ and @g@, so that the bodies of @f@ and @g@ are
not evaluated again at all when they are called.
Of course, this can lose useful joint strictness, which is sad. An
alternative approach would be to try with a certain amount of ``fuel''
and be prepared to bale out.
\begin{code}
<pre><a name="line-1"></a><a name="absEval"></a><span class='hs-definition'>absEval</span> <span class='hs-varid'>anal</span> <span class='hs-layout'>(</span><span class='hs-conid'>Let</span> <span class='hs-layout'>(</span><span class='hs-conid'>NonRec</span> <span class='hs-varid'>binder</span> <span class='hs-varid'>e1</span><span class='hs-layout'>)</span> <span class='hs-varid'>e2</span><span class='hs-layout'>)</span> <span class='hs-varid'>env</span>
<a name="line-2"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>let</span>
<a name="line-3"></a> <span class='hs-varid'>new_env</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>addOneToAbsValEnv</span> <span class='hs-varid'>env</span> <span class='hs-varid'>binder</span> <span class='hs-layout'>(</span><span class='hs-varid'>widen</span> <span class='hs-varid'>anal</span> <span class='hs-layout'>(</span><span class='hs-varid'>absEval</span> <span class='hs-varid'>anal</span> <span class='hs-varid'>e1</span> <span class='hs-varid'>env</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-4"></a> <span class='hs-keyword'>in</span>
<a name="line-5"></a> <span class='hs-comment'>-- The binder of a NonRec should *not* be of unboxed type,</span>
<a name="line-6"></a> <span class='hs-comment'>-- hence no need to strictly evaluate the Rhs.</span>
<a name="line-7"></a> <span class='hs-varid'>absEval</span> <span class='hs-varid'>anal</span> <span class='hs-varid'>e2</span> <span class='hs-varid'>new_env</span>
<a name="line-8"></a>
<a name="line-9"></a><span class='hs-definition'>absEval</span> <span class='hs-varid'>anal</span> <span class='hs-layout'>(</span><span class='hs-conid'>Let</span> <span class='hs-layout'>(</span><span class='hs-conid'>Rec</span> <span class='hs-varid'>pairs</span><span class='hs-layout'>)</span> <span class='hs-varid'>body</span><span class='hs-layout'>)</span> <span class='hs-varid'>env</span>
<a name="line-10"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>let</span>
<a name="line-11"></a> <span class='hs-layout'>(</span><span class='hs-varid'>binders</span><span class='hs-layout'>,</span><span class='hs-varid'>rhss</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>unzip</span> <span class='hs-varid'>pairs</span>
<a name="line-12"></a> <span class='hs-varid'>rhs_vals</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>cheapFixpoint</span> <span class='hs-varid'>anal</span> <span class='hs-varid'>binders</span> <span class='hs-varid'>rhss</span> <span class='hs-varid'>env</span> <span class='hs-comment'>-- Returns widened values</span>
<a name="line-13"></a> <span class='hs-varid'>new_env</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>growAbsValEnvList</span> <span class='hs-varid'>env</span> <span class='hs-layout'>(</span><span class='hs-varid'>binders</span> <span class='hs-varop'>`zip`</span> <span class='hs-varid'>rhs_vals</span><span class='hs-layout'>)</span>
<a name="line-14"></a> <span class='hs-keyword'>in</span>
<a name="line-15"></a> <span class='hs-varid'>absEval</span> <span class='hs-varid'>anal</span> <span class='hs-varid'>body</span> <span class='hs-varid'>new_env</span>
<a name="line-16"></a>
<a name="line-17"></a><span class='hs-definition'>absEval</span> <span class='hs-varid'>anal</span> <span class='hs-layout'>(</span><span class='hs-conid'>Note</span> <span class='hs-layout'>(</span><span class='hs-conid'>Coerce</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-varid'>expr</span><span class='hs-layout'>)</span> <span class='hs-varid'>env</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>AbsTop</span>
<a name="line-18"></a> <span class='hs-comment'>-- Don't look inside coerces, becuase they</span>
<a name="line-19"></a> <span class='hs-comment'>-- are usually recursive newtypes</span>
<a name="line-20"></a> <span class='hs-comment'>-- (Could improve, for the error case, but we're about</span>
<a name="line-21"></a> <span class='hs-comment'>-- to kill this analyser anyway.)</span>
<a name="line-22"></a><span class='hs-definition'>absEval</span> <span class='hs-varid'>anal</span> <span class='hs-layout'>(</span><span class='hs-conid'>Note</span> <span class='hs-varid'>note</span> <span class='hs-varid'>expr</span><span class='hs-layout'>)</span> <span class='hs-varid'>env</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>absEval</span> <span class='hs-varid'>anal</span> <span class='hs-varid'>expr</span> <span class='hs-varid'>env</span>
</pre>\end{code}
\begin{code}
<pre><a name="line-1"></a><a name="absEvalAlts"></a><span class='hs-definition'>absEvalAlts</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>AnalysisKind</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>CoreAlt</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>AbsValEnv</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>AbsVal</span>
<a name="line-2"></a><span class='hs-definition'>absEvalAlts</span> <span class='hs-varid'>anal</span> <span class='hs-varid'>alts</span> <span class='hs-varid'>env</span>
<a name="line-3"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>combine</span> <span class='hs-varid'>anal</span> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-varid'>go</span> <span class='hs-varid'>alts</span><span class='hs-layout'>)</span>
<a name="line-4"></a> <span class='hs-keyword'>where</span>
<a name="line-5"></a> <span class='hs-varid'>combine</span> <span class='hs-conid'>StrAnal</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>foldr1</span> <span class='hs-varid'>lub</span> <span class='hs-comment'>-- Diverge only if all diverge</span>
<a name="line-6"></a> <span class='hs-varid'>combine</span> <span class='hs-conid'>AbsAnal</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>foldr1</span> <span class='hs-varid'>glb</span> <span class='hs-comment'>-- Find any poison</span>
<a name="line-7"></a>
<a name="line-8"></a> <span class='hs-varid'>go</span> <span class='hs-layout'>(</span><span class='hs-varid'>con</span><span class='hs-layout'>,</span> <span class='hs-varid'>bndrs</span><span class='hs-layout'>,</span> <span class='hs-varid'>rhs</span><span class='hs-layout'>)</span>
<a name="line-9"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>absEval</span> <span class='hs-varid'>anal</span> <span class='hs-varid'>rhs</span> <span class='hs-varid'>rhs_env</span>
<a name="line-10"></a> <span class='hs-keyword'>where</span>
<a name="line-11"></a> <span class='hs-varid'>rhs_env</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>growAbsValEnvList</span> <span class='hs-varid'>env</span> <span class='hs-layout'>(</span><span class='hs-varid'>filter</span> <span class='hs-varid'>isId</span> <span class='hs-varid'>bndrs</span> <span class='hs-varop'>`zip`</span> <span class='hs-varid'>repeat</span> <span class='hs-conid'>AbsTop</span><span class='hs-layout'>)</span>
</pre>\end{code}
%************************************************************************
%* *
\subsection[absApply]{Apply an abstract function to an abstract argument}
%* *
%************************************************************************
Easy ones first:
\begin{code}
<pre><a name="line-1"></a><a name="absApply"></a><span class='hs-definition'>absApply</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>AnalysisKind</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>AbsVal</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>AbsVal</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>AbsVal</span>
<a name="line-2"></a>
<a name="line-3"></a><span class='hs-definition'>absApply</span> <span class='hs-varid'>anal</span> <span class='hs-conid'>AbsBot</span> <span class='hs-varid'>arg</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>AbsBot</span>
<a name="line-4"></a> <span class='hs-comment'>-- AbsBot represents the abstract bottom *function* too</span>
<a name="line-5"></a>
<a name="line-6"></a><span class='hs-definition'>absApply</span> <span class='hs-conid'>StrAnal</span> <span class='hs-conid'>AbsTop</span> <span class='hs-varid'>arg</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>AbsTop</span>
<a name="line-7"></a><span class='hs-definition'>absApply</span> <span class='hs-conid'>AbsAnal</span> <span class='hs-conid'>AbsTop</span> <span class='hs-varid'>arg</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>if</span> <span class='hs-varid'>anyBot</span> <span class='hs-varid'>arg</span>
<a name="line-8"></a> <span class='hs-keyword'>then</span> <span class='hs-conid'>AbsBot</span>
<a name="line-9"></a> <span class='hs-keyword'>else</span> <span class='hs-conid'>AbsTop</span>
<a name="line-10"></a> <span class='hs-comment'>-- To be conservative, we have to assume that a function about</span>
<a name="line-11"></a> <span class='hs-comment'>-- which we know nothing (AbsTop) might look at some part of</span>
<a name="line-12"></a> <span class='hs-comment'>-- its argument</span>
</pre>\end{code}
An @AbsFun@ with only one more argument needed---bind it and eval the
result. A @Lam@ with two or more args: return another @AbsFun@ with
an augmented environment.
\begin{code}
<pre><a name="line-1"></a><a name="absApply"></a><span class='hs-definition'>absApply</span> <span class='hs-varid'>anal</span> <span class='hs-layout'>(</span><span class='hs-conid'>AbsFun</span> <span class='hs-varid'>bndr_ty</span> <span class='hs-varid'>abs_fn</span><span class='hs-layout'>)</span> <span class='hs-varid'>arg</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>abs_fn</span> <span class='hs-varid'>arg</span>
</pre>\end{code}
\begin{code}
<pre><a name="line-1"></a><a name="absApply"></a><span class='hs-definition'>absApply</span> <span class='hs-conid'>StrAnal</span> <span class='hs-layout'>(</span><span class='hs-conid'>AbsApproxFun</span> <span class='hs-layout'>(</span><span class='hs-varid'>d</span><span class='hs-conop'>:</span><span class='hs-varid'>ds</span><span class='hs-layout'>)</span> <span class='hs-varid'>val</span><span class='hs-layout'>)</span> <span class='hs-varid'>arg</span>
<a name="line-2"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>ds</span> <span class='hs-keyword'>of</span>
<a name="line-3"></a> <span class='hs-conid'>[]</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>val'</span>
<a name="line-4"></a> <span class='hs-varid'>other</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>AbsApproxFun</span> <span class='hs-varid'>ds</span> <span class='hs-varid'>val'</span> <span class='hs-comment'>-- Result is non-bot if there are still args</span>
<a name="line-5"></a> <span class='hs-keyword'>where</span>
<a name="line-6"></a> <span class='hs-varid'>val'</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>evalStrictness</span> <span class='hs-varid'>d</span> <span class='hs-varid'>arg</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>AbsBot</span>
<a name="line-7"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>val</span>
<a name="line-8"></a>
<a name="line-9"></a><span class='hs-definition'>absApply</span> <span class='hs-conid'>AbsAnal</span> <span class='hs-layout'>(</span><span class='hs-conid'>AbsApproxFun</span> <span class='hs-layout'>(</span><span class='hs-varid'>d</span><span class='hs-conop'>:</span><span class='hs-varid'>ds</span><span class='hs-layout'>)</span> <span class='hs-varid'>val</span><span class='hs-layout'>)</span> <span class='hs-varid'>arg</span>
<a name="line-10"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>if</span> <span class='hs-varid'>evalAbsence</span> <span class='hs-varid'>d</span> <span class='hs-varid'>arg</span>
<a name="line-11"></a> <span class='hs-keyword'>then</span> <span class='hs-conid'>AbsBot</span> <span class='hs-comment'>-- Poison in arg means poison in the application</span>
<a name="line-12"></a> <span class='hs-keyword'>else</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>ds</span> <span class='hs-keyword'>of</span>
<a name="line-13"></a> <span class='hs-conid'>[]</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>val</span>
<a name="line-14"></a> <span class='hs-varid'>other</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>AbsApproxFun</span> <span class='hs-varid'>ds</span> <span class='hs-varid'>val</span>
<a name="line-15"></a>
<a name="line-16"></a><span class='hs-cpp'>#ifdef DEBUG</span>
<a name="line-17"></a><span class='hs-definition'>absApply</span> <span class='hs-varid'>anal</span> <span class='hs-varid'>f</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>AbsProd</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-varid'>arg</span>
<a name="line-18"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>pprPanic</span> <span class='hs-layout'>(</span><span class='hs-str'>"absApply: Duff function: AbsProd."</span> <span class='hs-varop'>++</span> <span class='hs-varid'>show</span> <span class='hs-varid'>anal</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-varid'>ppr</span> <span class='hs-varid'>f</span><span class='hs-layout'>)</span> <span class='hs-varop'><+></span> <span class='hs-layout'>(</span><span class='hs-varid'>ppr</span> <span class='hs-varid'>arg</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-19"></a><span class='hs-cpp'>#endif</span>
</pre>\end{code}
%************************************************************************
%* *
\subsection[findStrictness]{Determine some binders' strictness}
%* *
%************************************************************************
\begin{code}
<pre><a name="line-1"></a><a name="findStrictness"></a><span class='hs-definition'>findStrictness</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Id</span>
<a name="line-2"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>AbsVal</span> <span class='hs-comment'>-- Abstract strictness value of function</span>
<a name="line-3"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>AbsVal</span> <span class='hs-comment'>-- Abstract absence value of function</span>
<a name="line-4"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>StrictnessInfo</span> <span class='hs-comment'>-- Resulting strictness annotation</span>
<a name="line-5"></a>
<a name="line-6"></a><span class='hs-definition'>findStrictness</span> <span class='hs-varid'>id</span> <span class='hs-layout'>(</span><span class='hs-conid'>AbsApproxFun</span> <span class='hs-varid'>str_ds</span> <span class='hs-varid'>str_res</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>AbsApproxFun</span> <span class='hs-varid'>abs_ds</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span>
<a name="line-7"></a> <span class='hs-comment'>-- You might think there's really no point in describing detailed</span>
<a name="line-8"></a> <span class='hs-comment'>-- strictness for a divergent function; </span>
<a name="line-9"></a> <span class='hs-comment'>-- If it's fully applied we get bottom regardless of the</span>
<a name="line-10"></a> <span class='hs-comment'>-- argument. If it's not fully applied we don't get bottom.</span>
<a name="line-11"></a> <span class='hs-comment'>-- Finally, we don't want to regard the args of a divergent function</span>
<a name="line-12"></a> <span class='hs-comment'>-- as 'interesting' for inlining purposes (see Simplify.prepareArgs)</span>
<a name="line-13"></a> <span class='hs-comment'>--</span>
<a name="line-14"></a> <span class='hs-comment'>-- HOWEVER, if we make diverging functions appear lazy, they</span>
<a name="line-15"></a> <span class='hs-comment'>-- don't get wrappers, and then we get dreadful reboxing.</span>
<a name="line-16"></a> <span class='hs-comment'>-- See notes with WwLib.worthSplitting</span>
<a name="line-17"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>find_strictness</span> <span class='hs-varid'>id</span> <span class='hs-varid'>str_ds</span> <span class='hs-varid'>str_res</span> <span class='hs-varid'>abs_ds</span>
<a name="line-18"></a>
<a name="line-19"></a><span class='hs-definition'>findStrictness</span> <span class='hs-varid'>id</span> <span class='hs-varid'>str_val</span> <span class='hs-varid'>abs_val</span>
<a name="line-20"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>isBot</span> <span class='hs-varid'>str_val</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkStrictnessInfo</span> <span class='hs-layout'>(</span><span class='hs-conid'>[]</span><span class='hs-layout'>,</span> <span class='hs-conid'>True</span><span class='hs-layout'>)</span>
<a name="line-21"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>NoStrictnessInfo</span>
<a name="line-22"></a>
<a name="line-23"></a><span class='hs-comment'>-- The list of absence demands passed to combineDemands </span>
<a name="line-24"></a><span class='hs-comment'>-- can be shorter than the list of absence demands</span>
<a name="line-25"></a><span class='hs-comment'>--</span>
<a name="line-26"></a><span class='hs-comment'>-- lookup = \ dEq -> letrec {</span>
<a name="line-27"></a><span class='hs-comment'>-- lookup = \ key ds -> ...lookup...</span>
<a name="line-28"></a><span class='hs-comment'>-- }</span>
<a name="line-29"></a><span class='hs-comment'>-- in lookup</span>
<a name="line-30"></a><span class='hs-comment'>-- Here the strictness value takes three args, but the absence value</span>
<a name="line-31"></a><span class='hs-comment'>-- takes only one, for reasons I don't quite understand (see cheapFixpoint)</span>
<a name="line-32"></a>
<a name="line-33"></a><a name="find_strictness"></a><span class='hs-definition'>find_strictness</span> <span class='hs-varid'>id</span> <span class='hs-varid'>orig_str_ds</span> <span class='hs-varid'>orig_str_res</span> <span class='hs-varid'>orig_abs_ds</span>
<a name="line-34"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkStrictnessInfo</span> <span class='hs-layout'>(</span><span class='hs-varid'>go</span> <span class='hs-varid'>orig_str_ds</span> <span class='hs-varid'>orig_abs_ds</span><span class='hs-layout'>,</span> <span class='hs-varid'>res_bot</span><span class='hs-layout'>)</span>
<a name="line-35"></a> <span class='hs-keyword'>where</span>
<a name="line-36"></a> <span class='hs-varid'>res_bot</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>isBot</span> <span class='hs-varid'>orig_str_res</span>
<a name="line-37"></a>
<a name="line-38"></a> <span class='hs-varid'>go</span> <span class='hs-varid'>str_ds</span> <span class='hs-varid'>abs_ds</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>zipWith</span> <span class='hs-varid'>mk_dmd</span> <span class='hs-varid'>str_ds</span> <span class='hs-layout'>(</span><span class='hs-varid'>abs_ds</span> <span class='hs-varop'>++</span> <span class='hs-varid'>repeat</span> <span class='hs-varid'>wwLazy</span><span class='hs-layout'>)</span>
<a name="line-39"></a>
<a name="line-40"></a> <span class='hs-varid'>mk_dmd</span> <span class='hs-varid'>str_dmd</span> <span class='hs-layout'>(</span><span class='hs-conid'>WwLazy</span> <span class='hs-conid'>True</span><span class='hs-layout'>)</span>
<a name="line-41"></a> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>WARN</span><span class='hs-layout'>(</span> <span class='hs-varid'>not</span> <span class='hs-layout'>(</span><span class='hs-varid'>res_bot</span> <span class='hs-varop'>||</span> <span class='hs-varid'>isLazy</span> <span class='hs-varid'>str_dmd</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span>
<a name="line-42"></a> <span class='hs-varid'>ppr</span> <span class='hs-varid'>id</span> <span class='hs-varop'><+></span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>orig_str_ds</span> <span class='hs-varop'><+></span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>orig_abs_ds</span> <span class='hs-layout'>)</span>
<a name="line-43"></a> <span class='hs-comment'>-- If the arg isn't used we jolly well don't expect the function</span>
<a name="line-44"></a> <span class='hs-comment'>-- to be strict in it. Unless the function diverges.</span>
<a name="line-45"></a> <span class='hs-conid'>WwLazy</span> <span class='hs-conid'>True</span> <span class='hs-comment'>-- Best of all</span>
<a name="line-46"></a>
<a name="line-47"></a> <span class='hs-varid'>mk_dmd</span> <span class='hs-layout'>(</span><span class='hs-conid'>WwUnpack</span> <span class='hs-varid'>u</span> <span class='hs-varid'>str_ds</span><span class='hs-layout'>)</span>
<a name="line-48"></a> <span class='hs-layout'>(</span><span class='hs-conid'>WwUnpack</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>abs_ds</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>WwUnpack</span> <span class='hs-varid'>u</span> <span class='hs-layout'>(</span><span class='hs-varid'>go</span> <span class='hs-varid'>str_ds</span> <span class='hs-varid'>abs_ds</span><span class='hs-layout'>)</span>
<a name="line-49"></a>
<a name="line-50"></a> <span class='hs-varid'>mk_dmd</span> <span class='hs-varid'>str_dmd</span> <span class='hs-varid'>abs_dmd</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>str_dmd</span>
</pre>\end{code}
\begin{code}
<pre><a name="line-1"></a><a name="findDemand"></a><span class='hs-definition'>findDemand</span> <span class='hs-varid'>dmd</span> <span class='hs-varid'>str_env</span> <span class='hs-varid'>abs_env</span> <span class='hs-varid'>expr</span> <span class='hs-varid'>binder</span>
<a name="line-2"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>findRecDemand</span> <span class='hs-varid'>str_fn</span> <span class='hs-varid'>abs_fn</span> <span class='hs-layout'>(</span><span class='hs-varid'>idType</span> <span class='hs-varid'>binder</span><span class='hs-layout'>)</span>
<a name="line-3"></a> <span class='hs-keyword'>where</span>
<a name="line-4"></a> <span class='hs-varid'>str_fn</span> <span class='hs-varid'>val</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>evalStrictness</span> <span class='hs-varid'>dmd</span> <span class='hs-layout'>(</span><span class='hs-varid'>absEval</span> <span class='hs-conid'>StrAnal</span> <span class='hs-varid'>expr</span> <span class='hs-layout'>(</span><span class='hs-varid'>addOneToAbsValEnv</span> <span class='hs-varid'>str_env</span> <span class='hs-varid'>binder</span> <span class='hs-varid'>val</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-5"></a> <span class='hs-varid'>abs_fn</span> <span class='hs-varid'>val</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>not</span> <span class='hs-layout'>(</span><span class='hs-varid'>evalAbsence</span> <span class='hs-varid'>dmd</span> <span class='hs-layout'>(</span><span class='hs-varid'>absEval</span> <span class='hs-conid'>AbsAnal</span> <span class='hs-varid'>expr</span> <span class='hs-layout'>(</span><span class='hs-varid'>addOneToAbsValEnv</span> <span class='hs-varid'>abs_env</span> <span class='hs-varid'>binder</span> <span class='hs-varid'>val</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-6"></a>
<a name="line-7"></a><a name="findDemandAlts"></a><span class='hs-definition'>findDemandAlts</span> <span class='hs-varid'>dmd</span> <span class='hs-varid'>str_env</span> <span class='hs-varid'>abs_env</span> <span class='hs-varid'>alts</span> <span class='hs-varid'>binder</span>
<a name="line-8"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>findRecDemand</span> <span class='hs-varid'>str_fn</span> <span class='hs-varid'>abs_fn</span> <span class='hs-layout'>(</span><span class='hs-varid'>idType</span> <span class='hs-varid'>binder</span><span class='hs-layout'>)</span>
<a name="line-9"></a> <span class='hs-keyword'>where</span>
<a name="line-10"></a> <span class='hs-varid'>str_fn</span> <span class='hs-varid'>val</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>evalStrictness</span> <span class='hs-varid'>dmd</span> <span class='hs-layout'>(</span><span class='hs-varid'>absEvalAlts</span> <span class='hs-conid'>StrAnal</span> <span class='hs-varid'>alts</span> <span class='hs-layout'>(</span><span class='hs-varid'>addOneToAbsValEnv</span> <span class='hs-varid'>str_env</span> <span class='hs-varid'>binder</span> <span class='hs-varid'>val</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-11"></a> <span class='hs-varid'>abs_fn</span> <span class='hs-varid'>val</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>not</span> <span class='hs-layout'>(</span><span class='hs-varid'>evalAbsence</span> <span class='hs-varid'>dmd</span> <span class='hs-layout'>(</span><span class='hs-varid'>absEvalAlts</span> <span class='hs-conid'>AbsAnal</span> <span class='hs-varid'>alts</span> <span class='hs-layout'>(</span><span class='hs-varid'>addOneToAbsValEnv</span> <span class='hs-varid'>abs_env</span> <span class='hs-varid'>binder</span> <span class='hs-varid'>val</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
</pre>\end{code}
@findRecDemand@ is where we finally convert strictness/absence info
into ``Demands'' which we can pin on Ids (etc.).
NOTE: What do we do if something is {\em both} strict and absent?
Should \tr{f x y z = error "foo"} says that \tr{f}'s arguments are all
strict (because of bottoming effect of \tr{error}) or all absent
(because they're not used)?
Well, for practical reasons, we prefer absence over strictness. In
particular, it makes the ``default defaults'' for class methods (the
ones that say \tr{defm.foo dict = error "I don't exist"}) come out
nicely [saying ``the dict isn't used''], rather than saying it is
strict in every component of the dictionary [massive gratuitious
casing to take the dict apart].
But you could have examples where going for strictness would be better
than absence. Consider:
\begin{verbatim}
let x = something big
in
f x y z + g x
\end{verbatim}
If \tr{x} is marked absent in \tr{f}, but not strict, and \tr{g} is
lazy, then the thunk for \tr{x} will be built. If \tr{f} was strict,
then we'd let-to-case it:
\begin{verbatim}
case something big of
x -> f x y z + g x
\end{verbatim}
Ho hum.
\begin{code}
<pre><a name="line-1"></a><a name="findRecDemand"></a><span class='hs-definition'>findRecDemand</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>AbsVal</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bool</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- True => function applied to this value yields Bot</span>
<a name="line-2"></a> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-conid'>AbsVal</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bool</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- True => function applied to this value yields no poison</span>
<a name="line-3"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Type</span> <span class='hs-comment'>-- The type of the argument</span>
<a name="line-4"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Demand</span>
<a name="line-5"></a>
<a name="line-6"></a><span class='hs-definition'>findRecDemand</span> <span class='hs-varid'>str_fn</span> <span class='hs-varid'>abs_fn</span> <span class='hs-varid'>ty</span>
<a name="line-7"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>if</span> <span class='hs-varid'>isUnLiftedType</span> <span class='hs-varid'>ty</span> <span class='hs-keyword'>then</span> <span class='hs-comment'>-- It's a primitive type!</span>
<a name="line-8"></a> <span class='hs-varid'>wwPrim</span>
<a name="line-9"></a>
<a name="line-10"></a> <span class='hs-keyword'>else</span> <span class='hs-keyword'>if</span> <span class='hs-varid'>abs_fn</span> <span class='hs-conid'>AbsBot</span> <span class='hs-keyword'>then</span> <span class='hs-comment'>-- It's absent</span>
<a name="line-11"></a> <span class='hs-comment'>-- We prefer absence over strictness: see NOTE above.</span>
<a name="line-12"></a> <span class='hs-conid'>WwLazy</span> <span class='hs-conid'>True</span>
<a name="line-13"></a>
<a name="line-14"></a> <span class='hs-keyword'>else</span> <span class='hs-keyword'>if</span> <span class='hs-varid'>not</span> <span class='hs-layout'>(</span><span class='hs-varid'>opt_AllStrict</span> <span class='hs-varop'>||</span>
<a name="line-15"></a> <span class='hs-layout'>(</span><span class='hs-varid'>opt_NumbersStrict</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>is_numeric_type</span> <span class='hs-varid'>ty</span><span class='hs-layout'>)</span> <span class='hs-varop'>||</span>
<a name="line-16"></a> <span class='hs-varid'>str_fn</span> <span class='hs-conid'>AbsBot</span><span class='hs-layout'>)</span> <span class='hs-keyword'>then</span>
<a name="line-17"></a> <span class='hs-conid'>WwLazy</span> <span class='hs-conid'>False</span> <span class='hs-comment'>-- It's not strict and we're not pretending</span>
<a name="line-18"></a>
<a name="line-19"></a> <span class='hs-keyword'>else</span> <span class='hs-comment'>-- It's strict (or we're pretending it is)!</span>
<a name="line-20"></a>
<a name="line-21"></a> <span class='hs-keyword'>case</span> <span class='hs-varid'>splitProductType_maybe</span> <span class='hs-varid'>ty</span> <span class='hs-keyword'>of</span>
<a name="line-22"></a>
<a name="line-23"></a> <span class='hs-conid'>Nothing</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>wwStrict</span> <span class='hs-comment'>-- Could have a test for wwEnum, but</span>
<a name="line-24"></a> <span class='hs-comment'>-- we don't exploit it yet, so don't bother</span>
<a name="line-25"></a>
<a name="line-26"></a> <span class='hs-conid'>Just</span> <span class='hs-layout'>(</span><span class='hs-varid'>tycon</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span><span class='hs-varid'>data_con</span><span class='hs-layout'>,</span><span class='hs-varid'>cmpnt_tys</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- Single constructor case</span>
<a name="line-27"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>isRecursiveTyCon</span> <span class='hs-varid'>tycon</span> <span class='hs-comment'>-- Recursive data type; don't unpack</span>
<a name="line-28"></a> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>wwStrict</span> <span class='hs-comment'>-- (this applies to newtypes too:</span>
<a name="line-29"></a> <span class='hs-comment'>-- e.g. data Void = MkVoid Void)</span>
<a name="line-30"></a>
<a name="line-31"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>null</span> <span class='hs-varid'>compt_strict_infos</span> <span class='hs-comment'>-- A nullary data type</span>
<a name="line-32"></a> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>wwStrict</span>
<a name="line-33"></a>
<a name="line-34"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-comment'>-- Some other data type</span>
<a name="line-35"></a> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>wwUnpack</span> <span class='hs-varid'>compt_strict_infos</span>
<a name="line-36"></a>
<a name="line-37"></a> <span class='hs-keyword'>where</span>
<a name="line-38"></a> <span class='hs-varid'>prod_len</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>length</span> <span class='hs-varid'>cmpnt_tys</span>
<a name="line-39"></a> <span class='hs-varid'>compt_strict_infos</span>
<a name="line-40"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>[</span> <span class='hs-varid'>findRecDemand</span>
<a name="line-41"></a> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span> <span class='hs-varid'>cmpnt_val</span> <span class='hs-keyglyph'>-></span>
<a name="line-42"></a> <span class='hs-varid'>str_fn</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkMainlyTopProd</span> <span class='hs-varid'>prod_len</span> <span class='hs-varid'>i</span> <span class='hs-varid'>cmpnt_val</span><span class='hs-layout'>)</span>
<a name="line-43"></a> <span class='hs-layout'>)</span>
<a name="line-44"></a> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span> <span class='hs-varid'>cmpnt_val</span> <span class='hs-keyglyph'>-></span>
<a name="line-45"></a> <span class='hs-varid'>abs_fn</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkMainlyTopProd</span> <span class='hs-varid'>prod_len</span> <span class='hs-varid'>i</span> <span class='hs-varid'>cmpnt_val</span><span class='hs-layout'>)</span>
<a name="line-46"></a> <span class='hs-layout'>)</span>
<a name="line-47"></a> <span class='hs-varid'>cmpnt_ty</span>
<a name="line-48"></a> <span class='hs-keyglyph'>|</span> <span class='hs-layout'>(</span><span class='hs-varid'>cmpnt_ty</span><span class='hs-layout'>,</span> <span class='hs-varid'>i</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>cmpnt_tys</span> <span class='hs-varop'>`zip`</span> <span class='hs-keyglyph'>[</span><span class='hs-num'>1</span><span class='hs-keyglyph'>..</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>]</span>
<a name="line-49"></a>
<a name="line-50"></a> <span class='hs-keyword'>where</span>
<a name="line-51"></a> <span class='hs-varid'>is_numeric_type</span> <span class='hs-varid'>ty</span>
<a name="line-52"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-layout'>(</span><span class='hs-varid'>splitTyConApp_maybe</span> <span class='hs-varid'>ty</span><span class='hs-layout'>)</span> <span class='hs-keyword'>of</span> <span class='hs-comment'>-- NB: duplicates stuff done above</span>
<a name="line-53"></a> <span class='hs-conid'>Nothing</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>False</span>
<a name="line-54"></a> <span class='hs-conid'>Just</span> <span class='hs-layout'>(</span><span class='hs-varid'>tycon</span><span class='hs-layout'>,</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>tyConUnique</span> <span class='hs-varid'>tycon</span> <span class='hs-varop'>`is_elem`</span> <span class='hs-varid'>numericTyKeys</span>
<a name="line-55"></a> <span class='hs-keyword'>where</span>
<a name="line-56"></a> <span class='hs-varid'>is_elem</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>isIn</span> <span class='hs-str'>"is_numeric_type"</span>
<a name="line-57"></a>
<a name="line-58"></a> <span class='hs-comment'>-- mkMainlyTopProd: make an AbsProd that is all AbsTops ("n"-1 of</span>
<a name="line-59"></a> <span class='hs-comment'>-- them) except for a given value in the "i"th position.</span>
<a name="line-60"></a>
<a name="line-61"></a> <span class='hs-varid'>mkMainlyTopProd</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Int</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Int</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>AbsVal</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>AbsVal</span>
<a name="line-62"></a>
<a name="line-63"></a> <span class='hs-varid'>mkMainlyTopProd</span> <span class='hs-varid'>n</span> <span class='hs-varid'>i</span> <span class='hs-varid'>val</span>
<a name="line-64"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>let</span>
<a name="line-65"></a> <span class='hs-varid'>befores</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>nOfThem</span> <span class='hs-layout'>(</span><span class='hs-varid'>i</span><span class='hs-comment'>-</span><span class='hs-num'>1</span><span class='hs-layout'>)</span> <span class='hs-conid'>AbsTop</span>
<a name="line-66"></a> <span class='hs-varid'>afters</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>nOfThem</span> <span class='hs-layout'>(</span><span class='hs-varid'>n</span><span class='hs-comment'>-</span><span class='hs-varid'>i</span><span class='hs-layout'>)</span> <span class='hs-conid'>AbsTop</span>
<a name="line-67"></a> <span class='hs-keyword'>in</span>
<a name="line-68"></a> <span class='hs-conid'>AbsProd</span> <span class='hs-layout'>(</span><span class='hs-varid'>befores</span> <span class='hs-varop'>++</span> <span class='hs-layout'>(</span><span class='hs-varid'>val</span> <span class='hs-conop'>:</span> <span class='hs-varid'>afters</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
</pre>\end{code}
%************************************************************************
%* *
\subsection[fixpoint]{Fixpointer for the strictness analyser}
%* *
%************************************************************************
The @fixpoint@ functions take a list of \tr{(binder, expr)} pairs, an
environment, and returns the abstract value of each binder.
The @cheapFixpoint@ function makes a conservative approximation,
by binding each of the variables to Top in their own right hand sides.
That allows us to make rapid progress, at the cost of a less-than-wonderful
approximation.
\begin{code}
<pre><a name="line-1"></a><a name="cheapFixpoint"></a><span class='hs-definition'>cheapFixpoint</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>AnalysisKind</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Id</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>CoreExpr</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>AbsValEnv</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>AbsVal</span><span class='hs-keyglyph'>]</span>
<a name="line-2"></a>
<a name="line-3"></a><span class='hs-definition'>cheapFixpoint</span> <span class='hs-conid'>AbsAnal</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>id</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>rhs</span><span class='hs-keyglyph'>]</span> <span class='hs-varid'>env</span>
<a name="line-4"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>crudeAbsWiden</span> <span class='hs-layout'>(</span><span class='hs-varid'>absEval</span> <span class='hs-conid'>AbsAnal</span> <span class='hs-varid'>rhs</span> <span class='hs-varid'>new_env</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span>
<a name="line-5"></a> <span class='hs-keyword'>where</span>
<a name="line-6"></a> <span class='hs-varid'>new_env</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>addOneToAbsValEnv</span> <span class='hs-varid'>env</span> <span class='hs-varid'>id</span> <span class='hs-conid'>AbsTop</span> <span class='hs-comment'>-- Unsafe starting point!</span>
<a name="line-7"></a> <span class='hs-comment'>-- In the just-one-binding case, we guarantee to</span>
<a name="line-8"></a> <span class='hs-comment'>-- find a fixed point in just one iteration,</span>
<a name="line-9"></a> <span class='hs-comment'>-- because we are using only a two-point domain.</span>
<a name="line-10"></a> <span class='hs-comment'>-- This improves matters in cases like:</span>
<a name="line-11"></a> <span class='hs-comment'>--</span>
<a name="line-12"></a> <span class='hs-comment'>-- f x y = letrec g = ...g...</span>
<a name="line-13"></a> <span class='hs-comment'>-- in g x</span>
<a name="line-14"></a> <span class='hs-comment'>--</span>
<a name="line-15"></a> <span class='hs-comment'>-- Here, y isn't used at all, but if g is bound to</span>
<a name="line-16"></a> <span class='hs-comment'>-- AbsBot we simply get AbsBot as the next</span>
<a name="line-17"></a> <span class='hs-comment'>-- iteration too.</span>
<a name="line-18"></a>
<a name="line-19"></a><span class='hs-definition'>cheapFixpoint</span> <span class='hs-varid'>anal</span> <span class='hs-varid'>ids</span> <span class='hs-varid'>rhss</span> <span class='hs-varid'>env</span>
<a name="line-20"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>widen</span> <span class='hs-varid'>anal</span> <span class='hs-layout'>(</span><span class='hs-varid'>absEval</span> <span class='hs-varid'>anal</span> <span class='hs-varid'>rhs</span> <span class='hs-varid'>new_env</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>rhs</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>rhss</span><span class='hs-keyglyph'>]</span>
<a name="line-21"></a> <span class='hs-comment'>-- We do just one iteration, starting from a safe</span>
<a name="line-22"></a> <span class='hs-comment'>-- approximation. This won't do a good job in situations</span>
<a name="line-23"></a> <span class='hs-comment'>-- like:</span>
<a name="line-24"></a> <span class='hs-comment'>-- \x -> letrec f = ...g...</span>
<a name="line-25"></a> <span class='hs-comment'>-- g = ...f...x...</span>
<a name="line-26"></a> <span class='hs-comment'>-- in</span>
<a name="line-27"></a> <span class='hs-comment'>-- ...f...</span>
<a name="line-28"></a> <span class='hs-comment'>-- Here, f will end up bound to Top after one iteration,</span>
<a name="line-29"></a> <span class='hs-comment'>-- and hence we won't spot the strictness in x.</span>
<a name="line-30"></a> <span class='hs-comment'>-- (A second iteration would solve this. ToDo: try the effect of</span>
<a name="line-31"></a> <span class='hs-comment'>-- really searching for a fixed point.)</span>
<a name="line-32"></a> <span class='hs-keyword'>where</span>
<a name="line-33"></a> <span class='hs-varid'>new_env</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>growAbsValEnvList</span> <span class='hs-varid'>env</span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-varid'>id</span><span class='hs-layout'>,</span><span class='hs-varid'>safe_val</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>id</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>ids</span><span class='hs-keyglyph'>]</span>
<a name="line-34"></a>
<a name="line-35"></a> <span class='hs-varid'>safe_val</span>
<a name="line-36"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>anal</span> <span class='hs-keyword'>of</span> <span class='hs-comment'>-- The safe starting point</span>
<a name="line-37"></a> <span class='hs-conid'>StrAnal</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>AbsTop</span>
<a name="line-38"></a> <span class='hs-conid'>AbsAnal</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>AbsBot</span>
</pre>\end{code}
\begin{code}
<pre><a name="line-1"></a><a name="fixpoint"></a><span class='hs-definition'>fixpoint</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>AnalysisKind</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Id</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>CoreExpr</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>AbsValEnv</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>AbsVal</span><span class='hs-keyglyph'>]</span>
<a name="line-2"></a>
<a name="line-3"></a><span class='hs-definition'>fixpoint</span> <span class='hs-varid'>anal</span> <span class='hs-conid'>[]</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>env</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>[]</span>
<a name="line-4"></a>
<a name="line-5"></a><span class='hs-definition'>fixpoint</span> <span class='hs-varid'>anal</span> <span class='hs-varid'>ids</span> <span class='hs-varid'>rhss</span> <span class='hs-varid'>env</span>
<a name="line-6"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>fix_loop</span> <span class='hs-varid'>initial_vals</span>
<a name="line-7"></a> <span class='hs-keyword'>where</span>
<a name="line-8"></a> <span class='hs-varid'>initial_val</span> <span class='hs-varid'>id</span>
<a name="line-9"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>anal</span> <span class='hs-keyword'>of</span> <span class='hs-comment'>-- The (unsafe) starting point</span>
<a name="line-10"></a> <span class='hs-conid'>AbsAnal</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>AbsTop</span>
<a name="line-11"></a> <span class='hs-conid'>StrAnal</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>AbsBot</span>
<a name="line-12"></a> <span class='hs-comment'>-- At one stage for StrAnal we said:</span>
<a name="line-13"></a> <span class='hs-comment'>-- if (returnsRealWorld (idType id))</span>
<a name="line-14"></a> <span class='hs-comment'>-- then AbsTop -- this is a massively horrible hack (SLPJ 95/05)</span>
<a name="line-15"></a> <span class='hs-comment'>-- but no one has the foggiest idea what this hack did,</span>
<a name="line-16"></a> <span class='hs-comment'>-- and returnsRealWorld was a stub that always returned False</span>
<a name="line-17"></a> <span class='hs-comment'>-- So this comment is all that is left of the hack!</span>
<a name="line-18"></a>
<a name="line-19"></a> <span class='hs-varid'>initial_vals</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>[</span> <span class='hs-varid'>initial_val</span> <span class='hs-varid'>id</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>id</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>ids</span> <span class='hs-keyglyph'>]</span>
<a name="line-20"></a>
<a name="line-21"></a> <span class='hs-varid'>fix_loop</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>AbsVal</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>AbsVal</span><span class='hs-keyglyph'>]</span>
<a name="line-22"></a>
<a name="line-23"></a> <span class='hs-varid'>fix_loop</span> <span class='hs-varid'>current_widened_vals</span>
<a name="line-24"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>let</span>
<a name="line-25"></a> <span class='hs-varid'>new_env</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>growAbsValEnvList</span> <span class='hs-varid'>env</span> <span class='hs-layout'>(</span><span class='hs-varid'>ids</span> <span class='hs-varop'>`zip`</span> <span class='hs-varid'>current_widened_vals</span><span class='hs-layout'>)</span>
<a name="line-26"></a> <span class='hs-varid'>new_vals</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>[</span> <span class='hs-varid'>absEval</span> <span class='hs-varid'>anal</span> <span class='hs-varid'>rhs</span> <span class='hs-varid'>new_env</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>rhs</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>rhss</span> <span class='hs-keyglyph'>]</span>
<a name="line-27"></a> <span class='hs-varid'>new_widened_vals</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>map</span> <span class='hs-layout'>(</span><span class='hs-varid'>widen</span> <span class='hs-varid'>anal</span><span class='hs-layout'>)</span> <span class='hs-varid'>new_vals</span>
<a name="line-28"></a> <span class='hs-keyword'>in</span>
<a name="line-29"></a> <span class='hs-keyword'>if</span> <span class='hs-layout'>(</span><span class='hs-varid'>and</span> <span class='hs-layout'>(</span><span class='hs-varid'>zipWith</span> <span class='hs-varid'>sameVal</span> <span class='hs-varid'>current_widened_vals</span> <span class='hs-varid'>new_widened_vals</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-keyword'>then</span>
<a name="line-30"></a> <span class='hs-varid'>current_widened_vals</span>
<a name="line-31"></a>
<a name="line-32"></a> <span class='hs-comment'>-- NB: I was too chicken to make that a zipWithEqual,</span>
<a name="line-33"></a> <span class='hs-comment'>-- lest I jump into a black hole. WDP 96/02</span>
<a name="line-34"></a>
<a name="line-35"></a> <span class='hs-comment'>-- Return the widened values. We might get a slightly</span>
<a name="line-36"></a> <span class='hs-comment'>-- better value by returning new_vals (which we used to</span>
<a name="line-37"></a> <span class='hs-comment'>-- do, see below), but alas that means that whenever the</span>
<a name="line-38"></a> <span class='hs-comment'>-- function is called we have to re-execute it, which is</span>
<a name="line-39"></a> <span class='hs-comment'>-- expensive.</span>
<a name="line-40"></a>
<a name="line-41"></a> <span class='hs-comment'>-- OLD VERSION</span>
<a name="line-42"></a> <span class='hs-comment'>-- new_vals</span>
<a name="line-43"></a> <span class='hs-comment'>-- Return the un-widened values which may be a bit better</span>
<a name="line-44"></a> <span class='hs-comment'>-- than the widened ones, and are guaranteed safe, since</span>
<a name="line-45"></a> <span class='hs-comment'>-- they are one iteration beyond current_widened_vals,</span>
<a name="line-46"></a> <span class='hs-comment'>-- which itself is a fixed point.</span>
<a name="line-47"></a> <span class='hs-keyword'>else</span>
<a name="line-48"></a> <span class='hs-varid'>fix_loop</span> <span class='hs-varid'>new_widened_vals</span>
</pre>\end{code}
For absence analysis, we make do with a very very simple approach:
look for convergence in a two-point domain.
We used to use just one iteration, starting with the variables bound
to @AbsBot@, which is safe.
Prior to that, we used one iteration starting from @AbsTop@ (which
isn't safe). Why isn't @AbsTop@ safe? Consider:
\begin{verbatim}
letrec
x = ...p..d...
d = (x,y)
in
...
\end{verbatim}
Here, if p is @AbsBot@, then we'd better {\em not} end up with a ``fixed
point'' of @d@ being @(AbsTop, AbsTop)@! An @AbsBot@ initial value is
safe because it gives poison more often than really necessary, and
thus may miss some absence, but will never claim absence when it ain't
so.
Anyway, one iteration starting with everything bound to @AbsBot@ give
bad results for
f = \ x -> ...f...
Here, f would always end up bound to @AbsBot@, which ain't very
clever, because then it would introduce poison whenever it was
applied. Much better to start with f bound to @AbsTop@, and widen it
to @AbsBot@ if any poison shows up. In effect we look for convergence
in the two-point @AbsTop@/@AbsBot@ domain.
What we miss (compared with the cleverer strictness analysis) is
spotting that in this case
f = \ x y -> ...y...(f x y')...
\tr{x} is actually absent, since it is only passed round the loop, never
used. But who cares about missing that?
NB: despite only having a two-point domain, we may still have many
iterations, because there are several variables involved at once.
\begin{code}
<pre><a name="line-1"></a><span class='hs-cpp'>#</span><span class='hs-varid'>endif</span> <span class='hs-varop'>/*</span> <span class='hs-conid'>OLD_STRICTNESS</span> <span class='hs-varop'>*/</span>
</pre>\end{code}
</body>
</html>
