Sophie

Sophie

distrib > Fedora > 14 > x86_64 > by-pkgid > 8d1ef08c9e0d44c69764afc615a03d0d > files > 1786

ghc-ghc-devel-6.12.3-5.fc14.i686.rpm

<?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>basicTypes/NewDemand.lhs</title>
<link type='text/css' rel='stylesheet' href='hscolour.css' />
</head>
<body>
%
% (c) The University of Glasgow 2006
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
\section[Demand]{@Demand@: the amount of demand on a value}

\begin{code}
<pre><a name="line-1"></a><span class='hs-keyword'>module</span> <span class='hs-conid'>NewDemand</span><span class='hs-layout'>(</span>
<a name="line-2"></a>	<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> 
<a name="line-3"></a>	<span class='hs-varid'>topDmd</span><span class='hs-layout'>,</span> <span class='hs-varid'>lazyDmd</span><span class='hs-layout'>,</span> <span class='hs-varid'>seqDmd</span><span class='hs-layout'>,</span> <span class='hs-varid'>evalDmd</span><span class='hs-layout'>,</span> <span class='hs-varid'>errDmd</span><span class='hs-layout'>,</span> <span class='hs-varid'>isStrictDmd</span><span class='hs-layout'>,</span> 
<a name="line-4"></a>	<span class='hs-varid'>isTop</span><span class='hs-layout'>,</span> <span class='hs-varid'>isAbsent</span><span class='hs-layout'>,</span> <span class='hs-varid'>seqDemand</span><span class='hs-layout'>,</span>
<a name="line-5"></a>
<a name="line-6"></a>	<span class='hs-conid'>DmdType</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'>topDmdType</span><span class='hs-layout'>,</span> <span class='hs-varid'>botDmdType</span><span class='hs-layout'>,</span> <span class='hs-varid'>mkDmdType</span><span class='hs-layout'>,</span> <span class='hs-varid'>mkTopDmdType</span><span class='hs-layout'>,</span> 
<a name="line-7"></a>		<span class='hs-varid'>dmdTypeDepth</span><span class='hs-layout'>,</span> <span class='hs-varid'>seqDmdType</span><span class='hs-layout'>,</span>
<a name="line-8"></a>	<span class='hs-conid'>DmdEnv</span><span class='hs-layout'>,</span> <span class='hs-varid'>emptyDmdEnv</span><span class='hs-layout'>,</span>
<a name="line-9"></a>	<span class='hs-conid'>DmdResult</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'>retCPR</span><span class='hs-layout'>,</span> <span class='hs-varid'>isBotRes</span><span class='hs-layout'>,</span> <span class='hs-varid'>returnsCPR</span><span class='hs-layout'>,</span> <span class='hs-varid'>resTypeArgDmd</span><span class='hs-layout'>,</span>
<a name="line-10"></a>	
<a name="line-11"></a>	<span class='hs-conid'>Demands</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'>mapDmds</span><span class='hs-layout'>,</span> <span class='hs-varid'>zipWithDmds</span><span class='hs-layout'>,</span> <span class='hs-varid'>allTop</span><span class='hs-layout'>,</span> <span class='hs-varid'>seqDemands</span><span class='hs-layout'>,</span>
<a name="line-12"></a>
<a name="line-13"></a>	<span class='hs-conid'>StrictSig</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'>mkStrictSig</span><span class='hs-layout'>,</span> <span class='hs-varid'>topSig</span><span class='hs-layout'>,</span> <span class='hs-varid'>botSig</span><span class='hs-layout'>,</span> <span class='hs-varid'>cprSig</span><span class='hs-layout'>,</span>
<a name="line-14"></a>        <span class='hs-varid'>isTopSig</span><span class='hs-layout'>,</span>
<a name="line-15"></a>	<span class='hs-varid'>splitStrictSig</span><span class='hs-layout'>,</span> <span class='hs-varid'>increaseStrictSigArity</span><span class='hs-layout'>,</span>
<a name="line-16"></a>	<span class='hs-varid'>pprIfaceStrictSig</span><span class='hs-layout'>,</span> <span class='hs-varid'>appIsBottom</span><span class='hs-layout'>,</span> <span class='hs-varid'>isBottomingSig</span><span class='hs-layout'>,</span> <span class='hs-varid'>seqStrictSig</span><span class='hs-layout'>,</span>
<a name="line-17"></a>     <span class='hs-layout'>)</span> <span class='hs-keyword'>where</span>
<a name="line-18"></a>
<a name="line-19"></a><span class='hs-cpp'>#include "HsVersions.h"</span>
<a name="line-20"></a>
<a name="line-21"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>StaticFlags</span>
<a name="line-22"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>BasicTypes</span>
<a name="line-23"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>VarEnv</span>
<a name="line-24"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>UniqFM</span>
<a name="line-25"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Util</span>
<a name="line-26"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Outputable</span>
</pre>\end{code}


%************************************************************************
%*									*
\subsection{Demands}
%*									*
%************************************************************************

\begin{code}
<pre><a name="line-1"></a><a name="Demand"></a><span class='hs-keyword'>data</span> <span class='hs-conid'>Demand</span>
<a name="line-2"></a>  <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Top</span>			<span class='hs-comment'>-- T; used for unlifted types too, so that</span>
<a name="line-3"></a>			<span class='hs-comment'>--	A `lub` T = T</span>
<a name="line-4"></a>  <span class='hs-keyglyph'>|</span> <span class='hs-conid'>Abs</span>			<span class='hs-comment'>-- A</span>
<a name="line-5"></a>
<a name="line-6"></a>  <span class='hs-keyglyph'>|</span> <span class='hs-conid'>Call</span> <span class='hs-conid'>Demand</span>		<span class='hs-comment'>-- C(d)</span>
<a name="line-7"></a>
<a name="line-8"></a>  <span class='hs-keyglyph'>|</span> <span class='hs-conid'>Eval</span> <span class='hs-conid'>Demands</span>	<span class='hs-comment'>-- U(ds)</span>
<a name="line-9"></a>
<a name="line-10"></a>  <span class='hs-keyglyph'>|</span> <span class='hs-conid'>Defer</span> <span class='hs-conid'>Demands</span>	<span class='hs-comment'>-- D(ds)</span>
<a name="line-11"></a>
<a name="line-12"></a>  <span class='hs-keyglyph'>|</span> <span class='hs-conid'>Box</span> <span class='hs-conid'>Demand</span>		<span class='hs-comment'>-- B(d)</span>
<a name="line-13"></a>
<a name="line-14"></a>  <span class='hs-keyglyph'>|</span> <span class='hs-conid'>Bot</span>			<span class='hs-comment'>-- B</span>
<a name="line-15"></a>  <span class='hs-keyword'>deriving</span><span class='hs-layout'>(</span> <span class='hs-conid'>Eq</span> <span class='hs-layout'>)</span>
<a name="line-16"></a>	<span class='hs-comment'>-- Equality needed for fixpoints in DmdAnal</span>
<a name="line-17"></a>
<a name="line-18"></a><a name="Demands"></a><span class='hs-keyword'>data</span> <span class='hs-conid'>Demands</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Poly</span> <span class='hs-conid'>Demand</span>	<span class='hs-comment'>-- Polymorphic case</span>
<a name="line-19"></a>	     <span class='hs-keyglyph'>|</span> <span class='hs-conid'>Prod</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Demand</span><span class='hs-keyglyph'>]</span>	<span class='hs-comment'>-- Product case</span>
<a name="line-20"></a>	     <span class='hs-keyword'>deriving</span><span class='hs-layout'>(</span> <span class='hs-conid'>Eq</span> <span class='hs-layout'>)</span>
<a name="line-21"></a>
<a name="line-22"></a><a name="allTop"></a><span class='hs-definition'>allTop</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Demands</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>Bool</span>
<a name="line-23"></a><span class='hs-definition'>allTop</span> <span class='hs-layout'>(</span><span class='hs-conid'>Poly</span> <span class='hs-varid'>d</span><span class='hs-layout'>)</span>  <span class='hs-keyglyph'>=</span> <span class='hs-varid'>isTop</span> <span class='hs-varid'>d</span>
<a name="line-24"></a><span class='hs-definition'>allTop</span> <span class='hs-layout'>(</span><span class='hs-conid'>Prod</span> <span class='hs-varid'>ds</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>all</span> <span class='hs-varid'>isTop</span> <span class='hs-varid'>ds</span>
<a name="line-25"></a>
<a name="line-26"></a><a name="isTop"></a><span class='hs-definition'>isTop</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Demand</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>Bool</span>
<a name="line-27"></a><span class='hs-definition'>isTop</span> <span class='hs-conid'>Top</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>True</span>
<a name="line-28"></a><span class='hs-definition'>isTop</span> <span class='hs-keyword'>_</span>   <span class='hs-keyglyph'>=</span> <span class='hs-conid'>False</span> 
<a name="line-29"></a>
<a name="line-30"></a><a name="isAbsent"></a><span class='hs-definition'>isAbsent</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Demand</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>Bool</span>
<a name="line-31"></a><span class='hs-definition'>isAbsent</span> <span class='hs-conid'>Abs</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>True</span>
<a name="line-32"></a><span class='hs-definition'>isAbsent</span> <span class='hs-keyword'>_</span>   <span class='hs-keyglyph'>=</span> <span class='hs-conid'>False</span> 
<a name="line-33"></a>
<a name="line-34"></a><a name="mapDmds"></a><span class='hs-definition'>mapDmds</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>Demand</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>Demand</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>Demands</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>Demands</span>
<a name="line-35"></a><span class='hs-definition'>mapDmds</span> <span class='hs-varid'>f</span> <span class='hs-layout'>(</span><span class='hs-conid'>Poly</span> <span class='hs-varid'>d</span><span class='hs-layout'>)</span>  <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Poly</span> <span class='hs-layout'>(</span><span class='hs-varid'>f</span> <span class='hs-varid'>d</span><span class='hs-layout'>)</span>
<a name="line-36"></a><span class='hs-definition'>mapDmds</span> <span class='hs-varid'>f</span> <span class='hs-layout'>(</span><span class='hs-conid'>Prod</span> <span class='hs-varid'>ds</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Prod</span> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-varid'>f</span> <span class='hs-varid'>ds</span><span class='hs-layout'>)</span>
<a name="line-37"></a>
<a name="line-38"></a><a name="zipWithDmds"></a><span class='hs-definition'>zipWithDmds</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>Demand</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>Demand</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>Demand</span><span class='hs-layout'>)</span>
<a name="line-39"></a>	    <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>Demands</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>Demands</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>Demands</span>
<a name="line-40"></a><span class='hs-definition'>zipWithDmds</span> <span class='hs-varid'>f</span> <span class='hs-layout'>(</span><span class='hs-conid'>Poly</span> <span class='hs-varid'>d1</span><span class='hs-layout'>)</span>  <span class='hs-layout'>(</span><span class='hs-conid'>Poly</span> <span class='hs-varid'>d2</span><span class='hs-layout'>)</span>  <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Poly</span> <span class='hs-layout'>(</span><span class='hs-varid'>d1</span> <span class='hs-varop'>`f`</span> <span class='hs-varid'>d2</span><span class='hs-layout'>)</span>
<a name="line-41"></a><span class='hs-definition'>zipWithDmds</span> <span class='hs-varid'>f</span> <span class='hs-layout'>(</span><span class='hs-conid'>Prod</span> <span class='hs-varid'>ds1</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>Poly</span> <span class='hs-varid'>d2</span><span class='hs-layout'>)</span>  <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Prod</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>d1</span> <span class='hs-varop'>`f`</span> <span class='hs-varid'>d2</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>d1</span> <span class='hs-keyglyph'>&lt;-</span> <span class='hs-varid'>ds1</span><span class='hs-keyglyph'>]</span>
<a name="line-42"></a><span class='hs-definition'>zipWithDmds</span> <span class='hs-varid'>f</span> <span class='hs-layout'>(</span><span class='hs-conid'>Poly</span> <span class='hs-varid'>d1</span><span class='hs-layout'>)</span>  <span class='hs-layout'>(</span><span class='hs-conid'>Prod</span> <span class='hs-varid'>ds2</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Prod</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>d1</span> <span class='hs-varop'>`f`</span> <span class='hs-varid'>d2</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>d2</span> <span class='hs-keyglyph'>&lt;-</span> <span class='hs-varid'>ds2</span><span class='hs-keyglyph'>]</span>
<a name="line-43"></a><span class='hs-definition'>zipWithDmds</span> <span class='hs-varid'>f</span> <span class='hs-layout'>(</span><span class='hs-conid'>Prod</span> <span class='hs-varid'>ds1</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>Prod</span> <span class='hs-varid'>ds2</span><span class='hs-layout'>)</span> 
<a name="line-44"></a>  <span class='hs-keyglyph'>|</span> <span class='hs-varid'>length</span> <span class='hs-varid'>ds1</span> <span class='hs-varop'>==</span> <span class='hs-varid'>length</span> <span class='hs-varid'>ds2</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Prod</span> <span class='hs-layout'>(</span><span class='hs-varid'>zipWithEqual</span> <span class='hs-str'>"zipWithDmds"</span> <span class='hs-varid'>f</span> <span class='hs-varid'>ds1</span> <span class='hs-varid'>ds2</span><span class='hs-layout'>)</span>
<a name="line-45"></a>  <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span>		     <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Poly</span> <span class='hs-varid'>topDmd</span>
<a name="line-46"></a>	<span class='hs-comment'>-- This really can happen with polymorphism</span>
<a name="line-47"></a>	<span class='hs-comment'>-- \f. case f x of (a,b) -&gt; ...</span>
<a name="line-48"></a>	<span class='hs-comment'>--     case f y of (a,b,c) -&gt; ...</span>
<a name="line-49"></a>	<span class='hs-comment'>-- Here the two demands on f are C(LL) and C(LLL)!</span>
<a name="line-50"></a>
<a name="line-51"></a><a name="topDmd"></a><span class='hs-definition'>topDmd</span><span class='hs-layout'>,</span> <span class='hs-varid'>lazyDmd</span><span class='hs-layout'>,</span> <span class='hs-varid'>seqDmd</span><span class='hs-layout'>,</span> <span class='hs-varid'>evalDmd</span><span class='hs-layout'>,</span> <span class='hs-varid'>errDmd</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Demand</span>
<a name="line-52"></a><span class='hs-definition'>topDmd</span>  <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Top</span>			<span class='hs-comment'>-- The most uninformative demand</span>
<a name="line-53"></a><a name="lazyDmd"></a><span class='hs-definition'>lazyDmd</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Box</span> <span class='hs-conid'>Abs</span>
<a name="line-54"></a><a name="seqDmd"></a><span class='hs-definition'>seqDmd</span>  <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Eval</span> <span class='hs-layout'>(</span><span class='hs-conid'>Poly</span> <span class='hs-conid'>Abs</span><span class='hs-layout'>)</span>	<span class='hs-comment'>-- Polymorphic seq demand</span>
<a name="line-55"></a><a name="evalDmd"></a><span class='hs-definition'>evalDmd</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Box</span> <span class='hs-varid'>seqDmd</span>		<span class='hs-comment'>-- Evaluate and return</span>
<a name="line-56"></a><a name="errDmd"></a><span class='hs-definition'>errDmd</span>  <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Box</span> <span class='hs-conid'>Bot</span>		<span class='hs-comment'>-- This used to be called X</span>
<a name="line-57"></a>
<a name="line-58"></a><a name="isStrictDmd"></a><span class='hs-definition'>isStrictDmd</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Demand</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>Bool</span>
<a name="line-59"></a><span class='hs-definition'>isStrictDmd</span> <span class='hs-conid'>Bot</span>      <span class='hs-keyglyph'>=</span> <span class='hs-conid'>True</span>
<a name="line-60"></a><span class='hs-definition'>isStrictDmd</span> <span class='hs-layout'>(</span><span class='hs-conid'>Eval</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-61"></a><span class='hs-definition'>isStrictDmd</span> <span class='hs-layout'>(</span><span class='hs-conid'>Call</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-62"></a><span class='hs-definition'>isStrictDmd</span> <span class='hs-layout'>(</span><span class='hs-conid'>Box</span> <span class='hs-varid'>d</span><span class='hs-layout'>)</span>  <span class='hs-keyglyph'>=</span> <span class='hs-varid'>isStrictDmd</span> <span class='hs-varid'>d</span>
<a name="line-63"></a><span class='hs-definition'>isStrictDmd</span> <span class='hs-keyword'>_</span>        <span class='hs-keyglyph'>=</span> <span class='hs-conid'>False</span>
<a name="line-64"></a>
<a name="line-65"></a><a name="seqDemand"></a><span class='hs-definition'>seqDemand</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Demand</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>()</span>
<a name="line-66"></a><span class='hs-definition'>seqDemand</span> <span class='hs-layout'>(</span><span class='hs-conid'>Call</span> <span class='hs-varid'>d</span><span class='hs-layout'>)</span>   <span class='hs-keyglyph'>=</span> <span class='hs-varid'>seqDemand</span> <span class='hs-varid'>d</span>
<a name="line-67"></a><span class='hs-definition'>seqDemand</span> <span class='hs-layout'>(</span><span class='hs-conid'>Eval</span> <span class='hs-varid'>ds</span><span class='hs-layout'>)</span>  <span class='hs-keyglyph'>=</span> <span class='hs-varid'>seqDemands</span> <span class='hs-varid'>ds</span>
<a name="line-68"></a><span class='hs-definition'>seqDemand</span> <span class='hs-layout'>(</span><span class='hs-conid'>Defer</span> <span class='hs-varid'>ds</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>seqDemands</span> <span class='hs-varid'>ds</span>
<a name="line-69"></a><span class='hs-definition'>seqDemand</span> <span class='hs-layout'>(</span><span class='hs-conid'>Box</span> <span class='hs-varid'>d</span><span class='hs-layout'>)</span>    <span class='hs-keyglyph'>=</span> <span class='hs-varid'>seqDemand</span> <span class='hs-varid'>d</span>
<a name="line-70"></a><span class='hs-definition'>seqDemand</span> <span class='hs-keyword'>_</span>          <span class='hs-keyglyph'>=</span> <span class='hs-conid'>()</span>
<a name="line-71"></a>
<a name="line-72"></a><a name="seqDemands"></a><span class='hs-definition'>seqDemands</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Demands</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>()</span>
<a name="line-73"></a><span class='hs-definition'>seqDemands</span> <span class='hs-layout'>(</span><span class='hs-conid'>Poly</span> <span class='hs-varid'>d</span><span class='hs-layout'>)</span>  <span class='hs-keyglyph'>=</span> <span class='hs-varid'>seqDemand</span> <span class='hs-varid'>d</span>
<a name="line-74"></a><span class='hs-definition'>seqDemands</span> <span class='hs-layout'>(</span><span class='hs-conid'>Prod</span> <span class='hs-varid'>ds</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>seqDemandList</span> <span class='hs-varid'>ds</span>
<a name="line-75"></a>
<a name="line-76"></a><a name="seqDemandList"></a><span class='hs-definition'>seqDemandList</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Demand</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>()</span>
<a name="line-77"></a><span class='hs-definition'>seqDemandList</span> <span class='hs-conid'>[]</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>()</span>
<a name="line-78"></a><span class='hs-definition'>seqDemandList</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-keyglyph'>=</span> <span class='hs-varid'>seqDemand</span> <span class='hs-varid'>d</span> <span class='hs-varop'>`seq`</span> <span class='hs-varid'>seqDemandList</span> <span class='hs-varid'>ds</span>
<a name="line-79"></a>
<a name="line-80"></a><span class='hs-keyword'>instance</span> <span class='hs-conid'>Outputable</span> <span class='hs-conid'>Demand</span> <span class='hs-keyword'>where</span>
<a name="line-81"></a>    <span class='hs-varid'>ppr</span> <span class='hs-conid'>Top</span>  <span class='hs-keyglyph'>=</span> <span class='hs-varid'>char</span> <span class='hs-chr'>'T'</span>
<a name="line-82"></a>    <span class='hs-varid'>ppr</span> <span class='hs-conid'>Abs</span>  <span class='hs-keyglyph'>=</span> <span class='hs-varid'>char</span> <span class='hs-chr'>'A'</span>
<a name="line-83"></a>    <span class='hs-varid'>ppr</span> <span class='hs-conid'>Bot</span>  <span class='hs-keyglyph'>=</span> <span class='hs-varid'>char</span> <span class='hs-chr'>'B'</span>
<a name="line-84"></a>
<a name="line-85"></a>    <span class='hs-varid'>ppr</span> <span class='hs-layout'>(</span><span class='hs-conid'>Defer</span> <span class='hs-varid'>ds</span><span class='hs-layout'>)</span>      <span class='hs-keyglyph'>=</span> <span class='hs-varid'>char</span> <span class='hs-chr'>'D'</span> <span class='hs-varop'>&lt;&gt;</span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>ds</span>
<a name="line-86"></a>    <span class='hs-varid'>ppr</span> <span class='hs-layout'>(</span><span class='hs-conid'>Eval</span> <span class='hs-varid'>ds</span><span class='hs-layout'>)</span>       <span class='hs-keyglyph'>=</span> <span class='hs-varid'>char</span> <span class='hs-chr'>'U'</span> <span class='hs-varop'>&lt;&gt;</span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>ds</span>
<a name="line-87"></a>				      
<a name="line-88"></a>    <span class='hs-varid'>ppr</span> <span class='hs-layout'>(</span><span class='hs-conid'>Box</span> <span class='hs-layout'>(</span><span class='hs-conid'>Eval</span> <span class='hs-varid'>ds</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>char</span> <span class='hs-chr'>'S'</span> <span class='hs-varop'>&lt;&gt;</span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>ds</span>
<a name="line-89"></a>    <span class='hs-varid'>ppr</span> <span class='hs-layout'>(</span><span class='hs-conid'>Box</span> <span class='hs-conid'>Abs</span><span class='hs-layout'>)</span>	<span class='hs-keyglyph'>=</span> <span class='hs-varid'>char</span> <span class='hs-chr'>'L'</span>
<a name="line-90"></a>    <span class='hs-varid'>ppr</span> <span class='hs-layout'>(</span><span class='hs-conid'>Box</span> <span class='hs-conid'>Bot</span><span class='hs-layout'>)</span>	<span class='hs-keyglyph'>=</span> <span class='hs-varid'>char</span> <span class='hs-chr'>'X'</span>
<a name="line-91"></a>    <span class='hs-varid'>ppr</span> <span class='hs-varid'>d</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>Box</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span>	<span class='hs-keyglyph'>=</span> <span class='hs-varid'>pprPanic</span> <span class='hs-str'>"ppr: Bad boxed demand"</span> <span class='hs-layout'>(</span><span class='hs-varid'>ppr</span> <span class='hs-varid'>d</span><span class='hs-layout'>)</span>
<a name="line-92"></a>
<a name="line-93"></a>    <span class='hs-varid'>ppr</span> <span class='hs-layout'>(</span><span class='hs-conid'>Call</span> <span class='hs-varid'>d</span><span class='hs-layout'>)</span>	<span class='hs-keyglyph'>=</span> <span class='hs-varid'>char</span> <span class='hs-chr'>'C'</span> <span class='hs-varop'>&lt;&gt;</span> <span class='hs-varid'>parens</span> <span class='hs-layout'>(</span><span class='hs-varid'>ppr</span> <span class='hs-varid'>d</span><span class='hs-layout'>)</span>
<a name="line-94"></a>
<a name="line-95"></a>
<a name="line-96"></a><span class='hs-keyword'>instance</span> <span class='hs-conid'>Outputable</span> <span class='hs-conid'>Demands</span> <span class='hs-keyword'>where</span>
<a name="line-97"></a>    <span class='hs-varid'>ppr</span> <span class='hs-layout'>(</span><span class='hs-conid'>Poly</span> <span class='hs-conid'>Abs</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>empty</span>
<a name="line-98"></a>    <span class='hs-varid'>ppr</span> <span class='hs-layout'>(</span><span class='hs-conid'>Poly</span> <span class='hs-varid'>d</span><span class='hs-layout'>)</span>   <span class='hs-keyglyph'>=</span> <span class='hs-varid'>parens</span> <span class='hs-layout'>(</span><span class='hs-varid'>ppr</span> <span class='hs-varid'>d</span> <span class='hs-varop'>&lt;&gt;</span> <span class='hs-varid'>char</span> <span class='hs-chr'>'*'</span><span class='hs-layout'>)</span>
<a name="line-99"></a>    <span class='hs-varid'>ppr</span> <span class='hs-layout'>(</span><span class='hs-conid'>Prod</span> <span class='hs-varid'>ds</span><span class='hs-layout'>)</span>  <span class='hs-keyglyph'>=</span> <span class='hs-varid'>parens</span> <span class='hs-layout'>(</span><span class='hs-varid'>hcat</span> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>ds</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-100"></a>	<span class='hs-comment'>-- At one time I printed U(AAA) as U, but that</span>
<a name="line-101"></a>	<span class='hs-comment'>-- confuses (Poly Abs) with (Prod AAA), and the</span>
<a name="line-102"></a>	<span class='hs-comment'>-- worker/wrapper generation differs slightly for these two</span>
<a name="line-103"></a>	<span class='hs-comment'>-- [Reason: in the latter case we can avoid passing the arg;</span>
<a name="line-104"></a>	<span class='hs-comment'>--  see notes with WwLib.mkWWstr_one.]</span>
</pre>\end{code}


%************************************************************************
%*									*
\subsection{Demand types}
%*									*
%************************************************************************

\begin{code}
<pre><a name="line-1"></a><a name="DmdType"></a><span class='hs-keyword'>data</span> <span class='hs-conid'>DmdType</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>DmdType</span> 
<a name="line-2"></a>		    <span class='hs-conid'>DmdEnv</span>	<span class='hs-comment'>-- Demand on explicitly-mentioned </span>
<a name="line-3"></a>				<span class='hs-comment'>--	free variables</span>
<a name="line-4"></a>		    <span class='hs-keyglyph'>[</span><span class='hs-conid'>Demand</span><span class='hs-keyglyph'>]</span>	<span class='hs-comment'>-- Demand on arguments</span>
<a name="line-5"></a>		    <span class='hs-conid'>DmdResult</span>	<span class='hs-comment'>-- Nature of result</span>
<a name="line-6"></a>
<a name="line-7"></a>	<span class='hs-comment'>-- 		IMPORTANT INVARIANT</span>
<a name="line-8"></a>	<span class='hs-comment'>-- The default demand on free variables not in the DmdEnv is:</span>
<a name="line-9"></a>	<span class='hs-comment'>-- DmdResult = BotRes        &lt;=&gt;  Bot</span>
<a name="line-10"></a>	<span class='hs-comment'>-- DmdResult = TopRes/ResCPR &lt;=&gt;  Abs</span>
<a name="line-11"></a>
<a name="line-12"></a>	<span class='hs-comment'>-- 		ANOTHER IMPORTANT INVARIANT</span>
<a name="line-13"></a>	<span class='hs-comment'>-- The Demands in the argument list are never</span>
<a name="line-14"></a>	<span class='hs-comment'>--	Bot, Defer d</span>
<a name="line-15"></a>	<span class='hs-comment'>-- Handwavey reason: these don't correspond to calling conventions</span>
<a name="line-16"></a>	<span class='hs-comment'>-- See DmdAnal.funArgDemand for details</span>
<a name="line-17"></a>
<a name="line-18"></a>
<a name="line-19"></a><a name="retCPR"></a><span class='hs-comment'>-- This guy lets us switch off CPR analysis</span>
<a name="line-20"></a><span class='hs-comment'>-- by making sure that everything uses TopRes instead of RetCPR</span>
<a name="line-21"></a><span class='hs-comment'>-- Assuming, of course, that they don't mention RetCPR by name.</span>
<a name="line-22"></a><span class='hs-comment'>-- They should onlyu use retCPR</span>
<a name="line-23"></a><span class='hs-definition'>retCPR</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>DmdResult</span>
<a name="line-24"></a><span class='hs-definition'>retCPR</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>opt_CprOff</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>TopRes</span>
<a name="line-25"></a>       <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span>  <span class='hs-keyglyph'>=</span> <span class='hs-conid'>RetCPR</span>
<a name="line-26"></a>
<a name="line-27"></a><a name="seqDmdType"></a><span class='hs-definition'>seqDmdType</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>DmdType</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>()</span>
<a name="line-28"></a><span class='hs-definition'>seqDmdType</span> <span class='hs-layout'>(</span><span class='hs-conid'>DmdType</span> <span class='hs-sel'>_env</span> <span class='hs-varid'>ds</span> <span class='hs-varid'>res</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> 
<a name="line-29"></a>  <span class='hs-comment'>{- ??? env `seq` -}</span> <span class='hs-varid'>seqDemandList</span> <span class='hs-varid'>ds</span> <span class='hs-varop'>`seq`</span> <span class='hs-varid'>res</span> <span class='hs-varop'>`seq`</span> <span class='hs-conid'>()</span>
<a name="line-30"></a>
<a name="line-31"></a><a name="DmdEnv"></a><span class='hs-keyword'>type</span> <span class='hs-conid'>DmdEnv</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>VarEnv</span> <span class='hs-conid'>Demand</span>
<a name="line-32"></a>
<a name="line-33"></a><a name="DmdResult"></a><span class='hs-keyword'>data</span> <span class='hs-conid'>DmdResult</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>TopRes</span>	<span class='hs-comment'>-- Nothing known	</span>
<a name="line-34"></a>	       <span class='hs-keyglyph'>|</span> <span class='hs-conid'>RetCPR</span>	<span class='hs-comment'>-- Returns a constructed product</span>
<a name="line-35"></a>	       <span class='hs-keyglyph'>|</span> <span class='hs-conid'>BotRes</span>	<span class='hs-comment'>-- Diverges or errors</span>
<a name="line-36"></a>	       <span class='hs-keyword'>deriving</span><span class='hs-layout'>(</span> <span class='hs-conid'>Eq</span><span class='hs-layout'>,</span> <span class='hs-conid'>Show</span> <span class='hs-layout'>)</span>
<a name="line-37"></a>	<span class='hs-comment'>-- Equality for fixpoints</span>
<a name="line-38"></a>	<span class='hs-comment'>-- Show needed for Show in Lex.Token (sigh)</span>
<a name="line-39"></a>
<a name="line-40"></a><span class='hs-comment'>-- Equality needed for fixpoints in DmdAnal</span>
<a name="line-41"></a><span class='hs-keyword'>instance</span> <span class='hs-conid'>Eq</span> <span class='hs-conid'>DmdType</span> <span class='hs-keyword'>where</span>
<a name="line-42"></a>  <span class='hs-layout'>(</span><span class='hs-varop'>==</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>DmdType</span> <span class='hs-varid'>fv1</span> <span class='hs-varid'>ds1</span> <span class='hs-varid'>res1</span><span class='hs-layout'>)</span>
<a name="line-43"></a>       <span class='hs-layout'>(</span><span class='hs-conid'>DmdType</span> <span class='hs-varid'>fv2</span> <span class='hs-varid'>ds2</span> <span class='hs-varid'>res2</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span>  <span class='hs-varid'>ufmToList</span> <span class='hs-varid'>fv1</span> <span class='hs-varop'>==</span> <span class='hs-varid'>ufmToList</span> <span class='hs-varid'>fv2</span>
<a name="line-44"></a>			      <span class='hs-varop'>&amp;&amp;</span> <span class='hs-varid'>ds1</span> <span class='hs-varop'>==</span> <span class='hs-varid'>ds2</span> <span class='hs-varop'>&amp;&amp;</span> <span class='hs-varid'>res1</span> <span class='hs-varop'>==</span> <span class='hs-varid'>res2</span>
<a name="line-45"></a>
<a name="line-46"></a><span class='hs-keyword'>instance</span> <span class='hs-conid'>Outputable</span> <span class='hs-conid'>DmdType</span> <span class='hs-keyword'>where</span>
<a name="line-47"></a>  <span class='hs-varid'>ppr</span> <span class='hs-layout'>(</span><span class='hs-conid'>DmdType</span> <span class='hs-varid'>fv</span> <span class='hs-varid'>ds</span> <span class='hs-varid'>res</span><span class='hs-layout'>)</span> 
<a name="line-48"></a>    <span class='hs-keyglyph'>=</span> <span class='hs-varid'>hsep</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>text</span> <span class='hs-str'>"DmdType"</span><span class='hs-layout'>,</span>
<a name="line-49"></a>	    <span class='hs-varid'>hcat</span> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>ds</span><span class='hs-layout'>)</span> <span class='hs-varop'>&lt;&gt;</span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>res</span><span class='hs-layout'>,</span>
<a name="line-50"></a>	    <span class='hs-keyword'>if</span> <span class='hs-varid'>null</span> <span class='hs-varid'>fv_elts</span> <span class='hs-keyword'>then</span> <span class='hs-varid'>empty</span>
<a name="line-51"></a>	    <span class='hs-keyword'>else</span> <span class='hs-varid'>braces</span> <span class='hs-layout'>(</span><span class='hs-varid'>fsep</span> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-varid'>pp_elt</span> <span class='hs-varid'>fv_elts</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span>
<a name="line-52"></a>    <span class='hs-keyword'>where</span>
<a name="line-53"></a>      <span class='hs-varid'>pp_elt</span> <span class='hs-layout'>(</span><span class='hs-varid'>uniq</span><span class='hs-layout'>,</span> <span class='hs-varid'>dmd</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>uniq</span> <span class='hs-varop'>&lt;&gt;</span> <span class='hs-varid'>text</span> <span class='hs-str'>"-&gt;"</span> <span class='hs-varop'>&lt;&gt;</span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>dmd</span>
<a name="line-54"></a>      <span class='hs-varid'>fv_elts</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ufmToList</span> <span class='hs-varid'>fv</span>
<a name="line-55"></a>
<a name="line-56"></a><span class='hs-keyword'>instance</span> <span class='hs-conid'>Outputable</span> <span class='hs-conid'>DmdResult</span> <span class='hs-keyword'>where</span>
<a name="line-57"></a>  <span class='hs-varid'>ppr</span> <span class='hs-conid'>TopRes</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>empty</span>	  <span class='hs-comment'>-- Keep these distinct from Demand letters</span>
<a name="line-58"></a>  <span class='hs-varid'>ppr</span> <span class='hs-conid'>RetCPR</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>char</span> <span class='hs-chr'>'m'</span>	  <span class='hs-comment'>-- so that we can print strictness sigs as</span>
<a name="line-59"></a>  <span class='hs-varid'>ppr</span> <span class='hs-conid'>BotRes</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>char</span> <span class='hs-chr'>'b'</span>   <span class='hs-comment'>--    dddr</span>
<a name="line-60"></a>			  <span class='hs-comment'>-- without ambiguity</span>
<a name="line-61"></a>
<a name="line-62"></a><a name="emptyDmdEnv"></a><span class='hs-definition'>emptyDmdEnv</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>VarEnv</span> <span class='hs-conid'>Demand</span>
<a name="line-63"></a><span class='hs-definition'>emptyDmdEnv</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>emptyVarEnv</span>
<a name="line-64"></a>
<a name="line-65"></a><a name="topDmdType"></a><span class='hs-definition'>topDmdType</span><span class='hs-layout'>,</span> <span class='hs-varid'>botDmdType</span><span class='hs-layout'>,</span> <span class='hs-varid'>cprDmdType</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>DmdType</span>
<a name="line-66"></a><span class='hs-definition'>topDmdType</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>DmdType</span> <span class='hs-varid'>emptyDmdEnv</span> <span class='hs-conid'>[]</span> <span class='hs-conid'>TopRes</span>
<a name="line-67"></a><a name="botDmdType"></a><span class='hs-definition'>botDmdType</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>DmdType</span> <span class='hs-varid'>emptyDmdEnv</span> <span class='hs-conid'>[]</span> <span class='hs-conid'>BotRes</span>
<a name="line-68"></a><a name="cprDmdType"></a><span class='hs-definition'>cprDmdType</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>DmdType</span> <span class='hs-varid'>emptyVarEnv</span> <span class='hs-conid'>[]</span> <span class='hs-varid'>retCPR</span>
<a name="line-69"></a>
<a name="line-70"></a><a name="isTopDmdType"></a><span class='hs-definition'>isTopDmdType</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>DmdType</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>Bool</span>
<a name="line-71"></a><span class='hs-comment'>-- Only used on top-level types, hence the assert</span>
<a name="line-72"></a><span class='hs-definition'>isTopDmdType</span> <span class='hs-layout'>(</span><span class='hs-conid'>DmdType</span> <span class='hs-varid'>env</span> <span class='hs-conid'>[]</span> <span class='hs-conid'>TopRes</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>ASSERT</span><span class='hs-layout'>(</span> <span class='hs-varid'>isEmptyVarEnv</span> <span class='hs-varid'>env</span><span class='hs-layout'>)</span> <span class='hs-conid'>True</span>	
<a name="line-73"></a><span class='hs-definition'>isTopDmdType</span> <span class='hs-keyword'>_</span>                       <span class='hs-keyglyph'>=</span> <span class='hs-conid'>False</span>
<a name="line-74"></a>
<a name="line-75"></a><a name="isBotRes"></a><span class='hs-definition'>isBotRes</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>DmdResult</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>Bool</span>
<a name="line-76"></a><span class='hs-definition'>isBotRes</span> <span class='hs-conid'>BotRes</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>True</span>
<a name="line-77"></a><span class='hs-definition'>isBotRes</span> <span class='hs-keyword'>_</span>      <span class='hs-keyglyph'>=</span> <span class='hs-conid'>False</span>
<a name="line-78"></a>
<a name="line-79"></a><a name="resTypeArgDmd"></a><span class='hs-definition'>resTypeArgDmd</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>DmdResult</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>Demand</span>
<a name="line-80"></a><span class='hs-comment'>-- TopRes and BotRes are polymorphic, so that</span>
<a name="line-81"></a><span class='hs-comment'>--	BotRes = Bot -&gt; BotRes</span>
<a name="line-82"></a><span class='hs-comment'>--	TopRes = Top -&gt; TopRes</span>
<a name="line-83"></a><span class='hs-comment'>-- This function makes that concrete</span>
<a name="line-84"></a><span class='hs-comment'>-- We can get a RetCPR, because of the way in which we are (now)</span>
<a name="line-85"></a><span class='hs-comment'>-- giving CPR info to strict arguments.  On the first pass, when</span>
<a name="line-86"></a><span class='hs-comment'>-- nothing has demand info, we optimistically give CPR info or RetCPR to all args</span>
<a name="line-87"></a><span class='hs-definition'>resTypeArgDmd</span> <span class='hs-conid'>TopRes</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Top</span>
<a name="line-88"></a><span class='hs-definition'>resTypeArgDmd</span> <span class='hs-conid'>RetCPR</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Top</span>
<a name="line-89"></a><span class='hs-definition'>resTypeArgDmd</span> <span class='hs-conid'>BotRes</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Bot</span>
<a name="line-90"></a>
<a name="line-91"></a><a name="returnsCPR"></a><span class='hs-definition'>returnsCPR</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>DmdResult</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>Bool</span>
<a name="line-92"></a><span class='hs-definition'>returnsCPR</span> <span class='hs-conid'>RetCPR</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>True</span>
<a name="line-93"></a><span class='hs-definition'>returnsCPR</span> <span class='hs-keyword'>_</span>      <span class='hs-keyglyph'>=</span> <span class='hs-conid'>False</span>
<a name="line-94"></a>
<a name="line-95"></a><a name="mkDmdType"></a><span class='hs-definition'>mkDmdType</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>DmdEnv</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Demand</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>DmdResult</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>DmdType</span>
<a name="line-96"></a><span class='hs-definition'>mkDmdType</span> <span class='hs-varid'>fv</span> <span class='hs-varid'>ds</span> <span class='hs-varid'>res</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>DmdType</span> <span class='hs-varid'>fv</span> <span class='hs-varid'>ds</span> <span class='hs-varid'>res</span>
<a name="line-97"></a>
<a name="line-98"></a><a name="mkTopDmdType"></a><span class='hs-definition'>mkTopDmdType</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Demand</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>DmdResult</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>DmdType</span>
<a name="line-99"></a><span class='hs-definition'>mkTopDmdType</span> <span class='hs-varid'>ds</span> <span class='hs-varid'>res</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>DmdType</span> <span class='hs-varid'>emptyDmdEnv</span> <span class='hs-varid'>ds</span> <span class='hs-varid'>res</span>
<a name="line-100"></a>
<a name="line-101"></a><a name="dmdTypeDepth"></a><span class='hs-definition'>dmdTypeDepth</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>DmdType</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>Arity</span>
<a name="line-102"></a><span class='hs-definition'>dmdTypeDepth</span> <span class='hs-layout'>(</span><span class='hs-conid'>DmdType</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>ds</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>length</span> <span class='hs-varid'>ds</span>
</pre>\end{code}


%************************************************************************
%*									*
\subsection{Strictness signature
%*									*
%************************************************************************

In a let-bound Id we record its strictness info.  
In principle, this strictness info is a demand transformer, mapping
a demand on the Id into a DmdType, which gives
	a) the free vars of the Id's value
	b) the Id's arguments
	c) an indication of the result of applying 
	   the Id to its arguments

However, in fact we store in the Id an extremely emascuated demand transfomer,
namely 
		a single DmdType
(Nevertheless we dignify StrictSig as a distinct type.)

This DmdType gives the demands unleashed by the Id when it is applied
to as many arguments as are given in by the arg demands in the DmdType.

For example, the demand transformer described by the DmdType
		DmdType {x -> U(LL)} [V,A] Top
says that when the function is applied to two arguments, it
unleashes demand U(LL) on the free var x, V on the first arg,
and A on the second.  

If this same function is applied to one arg, all we can say is
that it uses x with U*(LL), and its arg with demand L.

\begin{code}
<pre><a name="line-1"></a><a name="StrictSig"></a><span class='hs-keyword'>newtype</span> <span class='hs-conid'>StrictSig</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>StrictSig</span> <span class='hs-conid'>DmdType</span>
<a name="line-2"></a>		  <span class='hs-keyword'>deriving</span><span class='hs-layout'>(</span> <span class='hs-conid'>Eq</span> <span class='hs-layout'>)</span>
<a name="line-3"></a>
<a name="line-4"></a><span class='hs-keyword'>instance</span> <span class='hs-conid'>Outputable</span> <span class='hs-conid'>StrictSig</span> <span class='hs-keyword'>where</span>
<a name="line-5"></a>   <span class='hs-varid'>ppr</span> <span class='hs-layout'>(</span><span class='hs-conid'>StrictSig</span> <span class='hs-varid'>ty</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>ty</span>
<a name="line-6"></a>
<a name="line-7"></a><span class='hs-keyword'>instance</span> <span class='hs-conid'>Show</span> <span class='hs-conid'>StrictSig</span> <span class='hs-keyword'>where</span>
<a name="line-8"></a>   <span class='hs-varid'>show</span> <span class='hs-layout'>(</span><span class='hs-conid'>StrictSig</span> <span class='hs-varid'>ty</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>showSDoc</span> <span class='hs-layout'>(</span><span class='hs-varid'>ppr</span> <span class='hs-varid'>ty</span><span class='hs-layout'>)</span>
<a name="line-9"></a>
<a name="line-10"></a><a name="mkStrictSig"></a><span class='hs-definition'>mkStrictSig</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>DmdType</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>StrictSig</span>
<a name="line-11"></a><span class='hs-definition'>mkStrictSig</span> <span class='hs-varid'>dmd_ty</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>StrictSig</span> <span class='hs-varid'>dmd_ty</span>
<a name="line-12"></a>
<a name="line-13"></a><a name="splitStrictSig"></a><span class='hs-definition'>splitStrictSig</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>StrictSig</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>[</span><span class='hs-conid'>Demand</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>,</span> <span class='hs-conid'>DmdResult</span><span class='hs-layout'>)</span>
<a name="line-14"></a><span class='hs-definition'>splitStrictSig</span> <span class='hs-layout'>(</span><span class='hs-conid'>StrictSig</span> <span class='hs-layout'>(</span><span class='hs-conid'>DmdType</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>dmds</span> <span class='hs-varid'>res</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>dmds</span><span class='hs-layout'>,</span> <span class='hs-varid'>res</span><span class='hs-layout'>)</span>
<a name="line-15"></a>
<a name="line-16"></a><a name="increaseStrictSigArity"></a><span class='hs-definition'>increaseStrictSigArity</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Int</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>StrictSig</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>StrictSig</span>
<a name="line-17"></a><span class='hs-comment'>-- Add extra arguments to a strictness signature</span>
<a name="line-18"></a><span class='hs-definition'>increaseStrictSigArity</span> <span class='hs-varid'>arity_increase</span> <span class='hs-layout'>(</span><span class='hs-conid'>StrictSig</span> <span class='hs-layout'>(</span><span class='hs-conid'>DmdType</span> <span class='hs-varid'>env</span> <span class='hs-varid'>dmds</span> <span class='hs-varid'>res</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-19"></a>  <span class='hs-keyglyph'>=</span> <span class='hs-conid'>StrictSig</span> <span class='hs-layout'>(</span><span class='hs-conid'>DmdType</span> <span class='hs-varid'>env</span> <span class='hs-layout'>(</span><span class='hs-varid'>replicate</span> <span class='hs-varid'>arity_increase</span> <span class='hs-varid'>topDmd</span> <span class='hs-varop'>++</span> <span class='hs-varid'>dmds</span><span class='hs-layout'>)</span> <span class='hs-varid'>res</span><span class='hs-layout'>)</span>
<a name="line-20"></a>
<a name="line-21"></a><a name="isTopSig"></a><span class='hs-definition'>isTopSig</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>StrictSig</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>Bool</span>
<a name="line-22"></a><span class='hs-definition'>isTopSig</span> <span class='hs-layout'>(</span><span class='hs-conid'>StrictSig</span> <span class='hs-varid'>ty</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>isTopDmdType</span> <span class='hs-varid'>ty</span>
<a name="line-23"></a>
<a name="line-24"></a><a name="topSig"></a><span class='hs-definition'>topSig</span><span class='hs-layout'>,</span> <span class='hs-varid'>botSig</span><span class='hs-layout'>,</span> <span class='hs-varid'>cprSig</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>StrictSig</span>
<a name="line-25"></a><span class='hs-definition'>topSig</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>StrictSig</span> <span class='hs-varid'>topDmdType</span>
<a name="line-26"></a><a name="botSig"></a><span class='hs-definition'>botSig</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>StrictSig</span> <span class='hs-varid'>botDmdType</span>
<a name="line-27"></a><a name="cprSig"></a><span class='hs-definition'>cprSig</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>StrictSig</span> <span class='hs-varid'>cprDmdType</span>
<a name="line-28"></a>	
<a name="line-29"></a>
<a name="line-30"></a><a name="appIsBottom"></a><span class='hs-comment'>-- appIsBottom returns true if an application to n args would diverge</span>
<a name="line-31"></a><span class='hs-definition'>appIsBottom</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>StrictSig</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>Int</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>Bool</span>
<a name="line-32"></a><span class='hs-definition'>appIsBottom</span> <span class='hs-layout'>(</span><span class='hs-conid'>StrictSig</span> <span class='hs-layout'>(</span><span class='hs-conid'>DmdType</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>ds</span> <span class='hs-conid'>BotRes</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-varid'>n</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>listLengthCmp</span> <span class='hs-varid'>ds</span> <span class='hs-varid'>n</span> <span class='hs-varop'>/=</span> <span class='hs-conid'>GT</span>
<a name="line-33"></a><span class='hs-definition'>appIsBottom</span> <span class='hs-keyword'>_</span>				      <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>False</span>
<a name="line-34"></a>
<a name="line-35"></a><a name="isBottomingSig"></a><span class='hs-definition'>isBottomingSig</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>StrictSig</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>Bool</span>
<a name="line-36"></a><span class='hs-definition'>isBottomingSig</span> <span class='hs-layout'>(</span><span class='hs-conid'>StrictSig</span> <span class='hs-layout'>(</span><span class='hs-conid'>DmdType</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-conid'>BotRes</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>True</span>
<a name="line-37"></a><span class='hs-definition'>isBottomingSig</span> <span class='hs-keyword'>_</span>				<span class='hs-keyglyph'>=</span> <span class='hs-conid'>False</span>
<a name="line-38"></a>
<a name="line-39"></a><a name="seqStrictSig"></a><span class='hs-definition'>seqStrictSig</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>StrictSig</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>()</span>
<a name="line-40"></a><span class='hs-definition'>seqStrictSig</span> <span class='hs-layout'>(</span><span class='hs-conid'>StrictSig</span> <span class='hs-varid'>ty</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>seqDmdType</span> <span class='hs-varid'>ty</span>
<a name="line-41"></a>
<a name="line-42"></a><a name="pprIfaceStrictSig"></a><span class='hs-definition'>pprIfaceStrictSig</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>StrictSig</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>SDoc</span>
<a name="line-43"></a><span class='hs-comment'>-- Used for printing top-level strictness pragmas in interface files</span>
<a name="line-44"></a><span class='hs-definition'>pprIfaceStrictSig</span> <span class='hs-layout'>(</span><span class='hs-conid'>StrictSig</span> <span class='hs-layout'>(</span><span class='hs-conid'>DmdType</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>dmds</span> <span class='hs-varid'>res</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-45"></a>  <span class='hs-keyglyph'>=</span> <span class='hs-varid'>hcat</span> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>dmds</span><span class='hs-layout'>)</span> <span class='hs-varop'>&lt;&gt;</span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>res</span>
</pre>\end{code}
    

</body>
</html>

Perl :: Catalyst :: PostgreSQL :: RPM Valid HTML 4.01 Transitional