This file is indexed.

/usr/share/doc/libghc-stm-chans-doc/html/src/Control-Concurrent-STM-TBChan.html is in libghc-stm-chans-doc 3.0.0.4-5build1.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
<?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://code.haskell.org/~malcolm/hscolour/ -->
<title>src/Control/Concurrent/STM/TBChan.hs</title>
<link type='text/css' rel='stylesheet' href='hscolour.css' />
</head>
<body>
<pre><a name="line-1"></a><span class='hs-comment'>{-# OPTIONS_GHC -Wall -fwarn-tabs #-}</span>
<a name="line-2"></a><span class='hs-comment'>{-# LANGUAGE CPP, DeriveDataTypeable #-}</span>
<a name="line-3"></a>
<a name="line-4"></a><span class='hs-comment'>-- HACK: in GHC 7.10, Haddock complains about Control.Monad.STM and</span>
<a name="line-5"></a><span class='hs-comment'>-- System.IO.Unsafe being imported but unused. However, if we use</span>
<a name="line-6"></a><span class='hs-comment'>-- CPP to avoid including them under Haddock, then it will fail to</span>
<a name="line-7"></a><span class='hs-comment'>-- compile!</span>
<a name="line-8"></a><span class='hs-cpp'>#ifdef __HADDOCK__</span>
<a name="line-9"></a><span class='hs-comment'>{-# OPTIONS_GHC -fno-warn-unused-imports #-}</span>
<a name="line-10"></a><span class='hs-cpp'>#endif</span>
<a name="line-11"></a>
<a name="line-12"></a><span class='hs-cpp'>#if __GLASGOW_HASKELL__ &gt;= 701</span>
<a name="line-13"></a><span class='hs-cpp'>#  ifdef __HADDOCK__</span>
<a name="line-14"></a><span class='hs-comment'>{-# LANGUAGE Trustworthy #-}</span>
<a name="line-15"></a><span class='hs-cpp'>#  else</span>
<a name="line-16"></a><span class='hs-comment'>{-# LANGUAGE Safe #-}</span>
<a name="line-17"></a><span class='hs-cpp'>#  endif</span>
<a name="line-18"></a><span class='hs-cpp'>#endif</span>
<a name="line-19"></a><span class='hs-comment'>----------------------------------------------------------------</span>
<a name="line-20"></a><span class='hs-comment'>--                                                    2015.03.29</span>
<a name="line-21"></a><span class='hs-comment'>-- |</span>
<a name="line-22"></a><span class='hs-comment'>-- Module      :  Control.Concurrent.STM.TBChan</span>
<a name="line-23"></a><span class='hs-comment'>-- Copyright   :  Copyright (c) 2011--2015 wren gayle romano</span>
<a name="line-24"></a><span class='hs-comment'>-- License     :  BSD</span>
<a name="line-25"></a><span class='hs-comment'>-- Maintainer  :  wren@community.haskell.org</span>
<a name="line-26"></a><span class='hs-comment'>-- Stability   :  provisional</span>
<a name="line-27"></a><span class='hs-comment'>-- Portability :  non-portable (GHC STM, DeriveDataTypeable)</span>
<a name="line-28"></a><span class='hs-comment'>--</span>
<a name="line-29"></a><span class='hs-comment'>-- A version of "Control.Concurrent.STM.TChan" where the queue is</span>
<a name="line-30"></a><span class='hs-comment'>-- bounded in length. This variant incorporates ideas from Thomas</span>
<a name="line-31"></a><span class='hs-comment'>-- M. DuBuisson's @bounded-tchan@ package in order to reduce</span>
<a name="line-32"></a><span class='hs-comment'>-- contention between readers and writers.</span>
<a name="line-33"></a><span class='hs-comment'>----------------------------------------------------------------</span>
<a name="line-34"></a><span class='hs-keyword'>module</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Concurrent</span><span class='hs-varop'>.</span><span class='hs-conid'>STM</span><span class='hs-varop'>.</span><span class='hs-conid'>TBChan</span>
<a name="line-35"></a>    <span class='hs-layout'>(</span>
<a name="line-36"></a>    <span class='hs-comment'>-- * The TBChan type</span>
<a name="line-37"></a>      <span class='hs-conid'>TBChan</span><span class='hs-conid'>()</span>
<a name="line-38"></a>    <span class='hs-comment'>-- ** Creating TBChans</span>
<a name="line-39"></a>    <span class='hs-layout'>,</span> <span class='hs-varid'>newTBChan</span>
<a name="line-40"></a>    <span class='hs-layout'>,</span> <span class='hs-varid'>newTBChanIO</span>
<a name="line-41"></a>    <span class='hs-comment'>-- I don't know how to define dupTBChan with the correct semantics</span>
<a name="line-42"></a>    <span class='hs-comment'>-- ** Reading from TBChans</span>
<a name="line-43"></a>    <span class='hs-layout'>,</span> <span class='hs-varid'>readTBChan</span>
<a name="line-44"></a>    <span class='hs-layout'>,</span> <span class='hs-varid'>tryReadTBChan</span>
<a name="line-45"></a>    <span class='hs-layout'>,</span> <span class='hs-varid'>peekTBChan</span>
<a name="line-46"></a>    <span class='hs-layout'>,</span> <span class='hs-varid'>tryPeekTBChan</span>
<a name="line-47"></a>    <span class='hs-comment'>-- ** Writing to TBChans</span>
<a name="line-48"></a>    <span class='hs-layout'>,</span> <span class='hs-varid'>writeTBChan</span>
<a name="line-49"></a>    <span class='hs-layout'>,</span> <span class='hs-varid'>tryWriteTBChan</span>
<a name="line-50"></a>    <span class='hs-layout'>,</span> <span class='hs-varid'>unGetTBChan</span>
<a name="line-51"></a>    <span class='hs-comment'>-- ** Predicates</span>
<a name="line-52"></a>    <span class='hs-layout'>,</span> <span class='hs-varid'>isEmptyTBChan</span>
<a name="line-53"></a>    <span class='hs-layout'>,</span> <span class='hs-varid'>isFullTBChan</span>
<a name="line-54"></a>    <span class='hs-comment'>-- ** Other functionality</span>
<a name="line-55"></a>    <span class='hs-layout'>,</span> <span class='hs-varid'>estimateFreeSlotsTBChan</span>
<a name="line-56"></a>    <span class='hs-layout'>,</span> <span class='hs-varid'>freeSlotsTBChan</span>
<a name="line-57"></a>    <span class='hs-layout'>)</span> <span class='hs-keyword'>where</span>
<a name="line-58"></a>
<a name="line-59"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Prelude</span>           <span class='hs-varid'>hiding</span> <span class='hs-layout'>(</span><span class='hs-varid'>reads</span><span class='hs-layout'>)</span>
<a name="line-60"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Typeable</span>     <span class='hs-layout'>(</span><span class='hs-conid'>Typeable</span><span class='hs-layout'>)</span>
<a name="line-61"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Monad</span><span class='hs-varop'>.</span><span class='hs-conid'>STM</span> <span class='hs-layout'>(</span><span class='hs-conid'>STM</span><span class='hs-layout'>,</span> <span class='hs-varid'>retry</span><span class='hs-layout'>)</span>
<a name="line-62"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Concurrent</span><span class='hs-varop'>.</span><span class='hs-conid'>STM</span><span class='hs-varop'>.</span><span class='hs-conid'>TVar</span>
<a name="line-63"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Concurrent</span><span class='hs-varop'>.</span><span class='hs-conid'>STM</span><span class='hs-varop'>.</span><span class='hs-conid'>TChan</span> <span class='hs-comment'>-- N.B., GHC only</span>
<a name="line-64"></a>
<a name="line-65"></a><span class='hs-comment'>-- N.B., we need a Custom cabal build-type for this to work.</span>
<a name="line-66"></a><span class='hs-cpp'>#ifdef __HADDOCK__</span>
<a name="line-67"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Monad</span><span class='hs-varop'>.</span><span class='hs-conid'>STM</span> <span class='hs-layout'>(</span><span class='hs-varid'>atomically</span><span class='hs-layout'>)</span>
<a name="line-68"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>System</span><span class='hs-varop'>.</span><span class='hs-conid'>IO</span><span class='hs-varop'>.</span><span class='hs-conid'>Unsafe</span>  <span class='hs-layout'>(</span><span class='hs-varid'>unsafePerformIO</span><span class='hs-layout'>)</span>
<a name="line-69"></a><span class='hs-cpp'>#endif</span>
<a name="line-70"></a><span class='hs-comment'>----------------------------------------------------------------</span>
<a name="line-71"></a>
<a name="line-72"></a><a name="TBChan"></a><span class='hs-comment'>-- | @TBChan@ is an abstract type representing a bounded FIFO</span>
<a name="line-73"></a><a name="TBChan"></a><span class='hs-comment'>-- channel.</span>
<a name="line-74"></a><a name="TBChan"></a><span class='hs-keyword'>data</span> <span class='hs-conid'>TBChan</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>TBChan</span>
<a name="line-75"></a>    <span class='hs-comment'>{-# UNPACK #-}</span> <span class='hs-varop'>!</span><span class='hs-layout'>(</span><span class='hs-conid'>TVar</span> <span class='hs-conid'>Int</span><span class='hs-layout'>)</span>
<a name="line-76"></a>    <span class='hs-comment'>{-# UNPACK #-}</span> <span class='hs-varop'>!</span><span class='hs-layout'>(</span><span class='hs-conid'>TVar</span> <span class='hs-conid'>Int</span><span class='hs-layout'>)</span>
<a name="line-77"></a>    <span class='hs-comment'>{-# UNPACK #-}</span> <span class='hs-varop'>!</span><span class='hs-layout'>(</span><span class='hs-conid'>TChan</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span>
<a name="line-78"></a>    <span class='hs-keyword'>deriving</span> <span class='hs-layout'>(</span><span class='hs-conid'>Typeable</span><span class='hs-layout'>)</span>
<a name="line-79"></a><span class='hs-comment'>-- The components are:</span>
<a name="line-80"></a><span class='hs-comment'>-- * How many free slots we /know/ we have available.</span>
<a name="line-81"></a><span class='hs-comment'>-- * How many slots have been freed up by successful reads since</span>
<a name="line-82"></a><span class='hs-comment'>--   the last time the slot count was synchronized by 'isFullTBChan'.</span>
<a name="line-83"></a><span class='hs-comment'>-- * The underlying TChan.</span>
<a name="line-84"></a>
<a name="line-85"></a>
<a name="line-86"></a><a name="newTBChan"></a><span class='hs-comment'>-- | Build and returns a new instance of @TBChan@ with the given</span>
<a name="line-87"></a><span class='hs-comment'>-- capacity. /N.B./, we do not verify the capacity is positive, but</span>
<a name="line-88"></a><span class='hs-comment'>-- if it is non-positive then 'writeTBChan' will always retry and</span>
<a name="line-89"></a><span class='hs-comment'>-- 'isFullTBChan' will always be true.</span>
<a name="line-90"></a><span class='hs-definition'>newTBChan</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Int</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>STM</span> <span class='hs-layout'>(</span><span class='hs-conid'>TBChan</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span>
<a name="line-91"></a><span class='hs-definition'>newTBChan</span> <span class='hs-varid'>n</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-92"></a>    <span class='hs-varid'>slots</span> <span class='hs-keyglyph'>&lt;-</span> <span class='hs-varid'>newTVar</span> <span class='hs-varid'>n</span>
<a name="line-93"></a>    <span class='hs-varid'>reads</span> <span class='hs-keyglyph'>&lt;-</span> <span class='hs-varid'>newTVar</span> <span class='hs-num'>0</span>
<a name="line-94"></a>    <span class='hs-varid'>chan</span>  <span class='hs-keyglyph'>&lt;-</span> <span class='hs-varid'>newTChan</span>
<a name="line-95"></a>    <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>TBChan</span> <span class='hs-varid'>slots</span> <span class='hs-varid'>reads</span> <span class='hs-varid'>chan</span><span class='hs-layout'>)</span>
<a name="line-96"></a>
<a name="line-97"></a>
<a name="line-98"></a><a name="newTBChanIO"></a><span class='hs-comment'>-- | @IO@ version of 'newTBChan'. This is useful for creating</span>
<a name="line-99"></a><span class='hs-comment'>-- top-level @TBChan@s using 'unsafePerformIO', because using</span>
<a name="line-100"></a><span class='hs-comment'>-- 'atomically' inside 'unsafePerformIO' isn't possible.</span>
<a name="line-101"></a><span class='hs-definition'>newTBChanIO</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Int</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>IO</span> <span class='hs-layout'>(</span><span class='hs-conid'>TBChan</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span>
<a name="line-102"></a><span class='hs-definition'>newTBChanIO</span> <span class='hs-varid'>n</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-103"></a>    <span class='hs-varid'>slots</span> <span class='hs-keyglyph'>&lt;-</span> <span class='hs-varid'>newTVarIO</span> <span class='hs-varid'>n</span>
<a name="line-104"></a>    <span class='hs-varid'>reads</span> <span class='hs-keyglyph'>&lt;-</span> <span class='hs-varid'>newTVarIO</span> <span class='hs-num'>0</span>
<a name="line-105"></a>    <span class='hs-varid'>chan</span>  <span class='hs-keyglyph'>&lt;-</span> <span class='hs-varid'>newTChanIO</span>
<a name="line-106"></a>    <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>TBChan</span> <span class='hs-varid'>slots</span> <span class='hs-varid'>reads</span> <span class='hs-varid'>chan</span><span class='hs-layout'>)</span>
<a name="line-107"></a>
<a name="line-108"></a>
<a name="line-109"></a><a name="readTBChan"></a><span class='hs-comment'>-- | Read the next value from the @TBChan@, retrying if the channel</span>
<a name="line-110"></a><span class='hs-comment'>-- is empty.</span>
<a name="line-111"></a><span class='hs-definition'>readTBChan</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TBChan</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>STM</span> <span class='hs-varid'>a</span>
<a name="line-112"></a><span class='hs-definition'>readTBChan</span> <span class='hs-layout'>(</span><span class='hs-conid'>TBChan</span> <span class='hs-sel'>_slots</span> <span class='hs-varid'>reads</span> <span class='hs-varid'>chan</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-113"></a>    <span class='hs-varid'>x</span> <span class='hs-keyglyph'>&lt;-</span> <span class='hs-varid'>readTChan</span> <span class='hs-varid'>chan</span>
<a name="line-114"></a>    <span class='hs-varid'>modifyTVar'</span> <span class='hs-varid'>reads</span> <span class='hs-layout'>(</span><span class='hs-num'>1</span> <span class='hs-varop'>+</span><span class='hs-layout'>)</span>
<a name="line-115"></a>    <span class='hs-varid'>return</span> <span class='hs-varid'>x</span>
<a name="line-116"></a>
<a name="line-117"></a>
<a name="line-118"></a><a name="tryReadTBChan"></a><span class='hs-comment'>-- | A version of 'readTBChan' which does not retry. Instead it</span>
<a name="line-119"></a><span class='hs-comment'>-- returns @Nothing@ if no value is available.</span>
<a name="line-120"></a><span class='hs-definition'>tryReadTBChan</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TBChan</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>STM</span> <span class='hs-layout'>(</span><span class='hs-conid'>Maybe</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span>
<a name="line-121"></a><span class='hs-definition'>tryReadTBChan</span> <span class='hs-layout'>(</span><span class='hs-conid'>TBChan</span> <span class='hs-sel'>_slots</span> <span class='hs-varid'>reads</span> <span class='hs-varid'>chan</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-122"></a>    <span class='hs-varid'>mx</span> <span class='hs-keyglyph'>&lt;-</span> <span class='hs-varid'>tryReadTChan</span> <span class='hs-varid'>chan</span>
<a name="line-123"></a>    <span class='hs-keyword'>case</span> <span class='hs-varid'>mx</span> <span class='hs-keyword'>of</span>
<a name="line-124"></a>        <span class='hs-conid'>Nothing</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-varid'>return</span> <span class='hs-conid'>Nothing</span>
<a name="line-125"></a>        <span class='hs-conid'>Just</span> <span class='hs-sel'>_x</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-keyword'>do</span>
<a name="line-126"></a>            <span class='hs-varid'>modifyTVar'</span> <span class='hs-varid'>reads</span> <span class='hs-layout'>(</span><span class='hs-num'>1</span> <span class='hs-varop'>+</span><span class='hs-layout'>)</span>
<a name="line-127"></a>            <span class='hs-varid'>return</span> <span class='hs-varid'>mx</span>
<a name="line-128"></a>
<a name="line-129"></a>
<a name="line-130"></a><a name="peekTBChan"></a><span class='hs-comment'>-- | Get the next value from the @TBChan@ without removing it,</span>
<a name="line-131"></a><span class='hs-comment'>-- retrying if the channel is empty.</span>
<a name="line-132"></a><span class='hs-definition'>peekTBChan</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TBChan</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>STM</span> <span class='hs-varid'>a</span>
<a name="line-133"></a><span class='hs-definition'>peekTBChan</span> <span class='hs-layout'>(</span><span class='hs-conid'>TBChan</span> <span class='hs-sel'>_slots</span> <span class='hs-sel'>_reads</span> <span class='hs-varid'>chan</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span>
<a name="line-134"></a>    <span class='hs-varid'>peekTChan</span> <span class='hs-varid'>chan</span>
<a name="line-135"></a>
<a name="line-136"></a>
<a name="line-137"></a><a name="tryPeekTBChan"></a><span class='hs-comment'>-- | A version of 'peekTBChan' which does not retry. Instead it</span>
<a name="line-138"></a><span class='hs-comment'>-- returns @Nothing@ if no value is available.</span>
<a name="line-139"></a><span class='hs-definition'>tryPeekTBChan</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TBChan</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>STM</span> <span class='hs-layout'>(</span><span class='hs-conid'>Maybe</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span>
<a name="line-140"></a><span class='hs-definition'>tryPeekTBChan</span> <span class='hs-layout'>(</span><span class='hs-conid'>TBChan</span> <span class='hs-sel'>_slots</span> <span class='hs-sel'>_reads</span> <span class='hs-varid'>chan</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span>
<a name="line-141"></a>    <span class='hs-varid'>tryPeekTChan</span> <span class='hs-varid'>chan</span>
<a name="line-142"></a>
<a name="line-143"></a>
<a name="line-144"></a><a name="writeTBChan"></a><span class='hs-comment'>-- | Write a value to a @TBChan@, retrying if the channel is full.</span>
<a name="line-145"></a><span class='hs-definition'>writeTBChan</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TBChan</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>STM</span> <span class='hs-conid'>()</span>
<a name="line-146"></a><span class='hs-definition'>writeTBChan</span> <span class='hs-varid'>self</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>TBChan</span> <span class='hs-varid'>slots</span> <span class='hs-sel'>_reads</span> <span class='hs-varid'>chan</span><span class='hs-layout'>)</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-147"></a>    <span class='hs-varid'>n</span> <span class='hs-keyglyph'>&lt;-</span> <span class='hs-varid'>estimateFreeSlotsTBChan</span> <span class='hs-varid'>self</span>
<a name="line-148"></a>    <span class='hs-keyword'>if</span> <span class='hs-varid'>n</span> <span class='hs-varop'>&lt;=</span> <span class='hs-num'>0</span>
<a name="line-149"></a>        <span class='hs-keyword'>then</span> <span class='hs-varid'>retry</span>
<a name="line-150"></a>        <span class='hs-keyword'>else</span> <span class='hs-keyword'>do</span>
<a name="line-151"></a>            <span class='hs-varid'>writeTVar</span> <span class='hs-varid'>slots</span> <span class='hs-varop'>$!</span> <span class='hs-varid'>n</span> <span class='hs-comment'>-</span> <span class='hs-num'>1</span>
<a name="line-152"></a>            <span class='hs-varid'>writeTChan</span> <span class='hs-varid'>chan</span> <span class='hs-varid'>x</span>
<a name="line-153"></a><span class='hs-comment'>{-
<a name="line-154"></a>-- The above comparison is unnecessary on one of the n&gt;0 branches
<a name="line-155"></a>-- coming from estimateFreeSlotsTBChan. But for some reason, trying
<a name="line-156"></a>-- to remove it can cause BlockedIndefinatelyOnSTM exceptions.
<a name="line-157"></a>
<a name="line-158"></a>-- The above saves one @readTVar slots@ compared to:
<a name="line-159"></a>writeTBChan self@(TBChan slots _reads chan) x = do
<a name="line-160"></a>    b &lt;- isFullTBChan self
<a name="line-161"></a>    if b
<a name="line-162"></a>        then retry
<a name="line-163"></a>        else do
<a name="line-164"></a>            modifyTVar' slots (subtract 1)
<a name="line-165"></a>            writeTChan chan x
<a name="line-166"></a>-}</span>
<a name="line-167"></a>
<a name="line-168"></a>
<a name="line-169"></a><a name="tryWriteTBChan"></a><span class='hs-comment'>-- | A version of 'writeTBChan' which does not retry. Returns @True@</span>
<a name="line-170"></a><span class='hs-comment'>-- if the value was successfully written, and @False@ otherwise.</span>
<a name="line-171"></a><span class='hs-definition'>tryWriteTBChan</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TBChan</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>STM</span> <span class='hs-conid'>Bool</span>
<a name="line-172"></a><span class='hs-definition'>tryWriteTBChan</span> <span class='hs-varid'>self</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>TBChan</span> <span class='hs-varid'>slots</span> <span class='hs-sel'>_reads</span> <span class='hs-varid'>chan</span><span class='hs-layout'>)</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-173"></a>    <span class='hs-varid'>n</span> <span class='hs-keyglyph'>&lt;-</span> <span class='hs-varid'>estimateFreeSlotsTBChan</span> <span class='hs-varid'>self</span>
<a name="line-174"></a>    <span class='hs-keyword'>if</span> <span class='hs-varid'>n</span> <span class='hs-varop'>&lt;=</span> <span class='hs-num'>0</span>
<a name="line-175"></a>        <span class='hs-keyword'>then</span> <span class='hs-varid'>return</span> <span class='hs-conid'>False</span>
<a name="line-176"></a>        <span class='hs-keyword'>else</span> <span class='hs-keyword'>do</span>
<a name="line-177"></a>            <span class='hs-varid'>writeTVar</span> <span class='hs-varid'>slots</span> <span class='hs-varop'>$!</span> <span class='hs-varid'>n</span> <span class='hs-comment'>-</span> <span class='hs-num'>1</span>
<a name="line-178"></a>            <span class='hs-varid'>writeTChan</span> <span class='hs-varid'>chan</span> <span class='hs-varid'>x</span>
<a name="line-179"></a>            <span class='hs-varid'>return</span> <span class='hs-conid'>True</span>
<a name="line-180"></a><span class='hs-comment'>{-
<a name="line-181"></a>-- The above comparison is unnecessary on one of the n&gt;0 branches
<a name="line-182"></a>-- coming from estimateFreeSlotsTBChan. But for some reason, trying
<a name="line-183"></a>-- to remove it can cause BlockedIndefinatelyOnSTM exceptions.
<a name="line-184"></a>
<a name="line-185"></a>-- The above saves one @readTVar slots@ compared to:
<a name="line-186"></a>tryWriteTBChan self@(TBChan slots _reads chan) x = do
<a name="line-187"></a>    b &lt;- isFullTBChan self
<a name="line-188"></a>    if b
<a name="line-189"></a>        then return False
<a name="line-190"></a>        else do
<a name="line-191"></a>            modifyTVar' slots (subtract 1)
<a name="line-192"></a>            writeTChan chan x
<a name="line-193"></a>            return True
<a name="line-194"></a>-}</span>
<a name="line-195"></a>
<a name="line-196"></a>
<a name="line-197"></a><a name="unGetTBChan"></a><span class='hs-comment'>-- | Put a data item back onto a channel, where it will be the next</span>
<a name="line-198"></a><span class='hs-comment'>-- item read. /N.B./, this could allow the channel to temporarily</span>
<a name="line-199"></a><span class='hs-comment'>-- become longer than the specified limit, which is necessary to</span>
<a name="line-200"></a><span class='hs-comment'>-- ensure that the item is indeed the next one read.</span>
<a name="line-201"></a><span class='hs-definition'>unGetTBChan</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TBChan</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>STM</span> <span class='hs-conid'>()</span>
<a name="line-202"></a><span class='hs-definition'>unGetTBChan</span> <span class='hs-layout'>(</span><span class='hs-conid'>TBChan</span> <span class='hs-varid'>slots</span> <span class='hs-sel'>_reads</span> <span class='hs-varid'>chan</span><span class='hs-layout'>)</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-203"></a>    <span class='hs-varid'>modifyTVar'</span> <span class='hs-varid'>slots</span> <span class='hs-layout'>(</span><span class='hs-varid'>subtract</span> <span class='hs-num'>1</span><span class='hs-layout'>)</span>
<a name="line-204"></a>    <span class='hs-varid'>unGetTChan</span> <span class='hs-varid'>chan</span> <span class='hs-varid'>x</span>
<a name="line-205"></a>
<a name="line-206"></a>
<a name="line-207"></a><a name="isEmptyTBChan"></a><span class='hs-comment'>-- | Returns @True@ if the supplied @TBChan@ is empty (i.e., has</span>
<a name="line-208"></a><span class='hs-comment'>-- no elements). /N.B./, a @TBChan@ can be both ``empty'' and</span>
<a name="line-209"></a><span class='hs-comment'>-- ``full'' at the same time, if the initial limit was non-positive.</span>
<a name="line-210"></a><span class='hs-definition'>isEmptyTBChan</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TBChan</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>STM</span> <span class='hs-conid'>Bool</span>
<a name="line-211"></a><span class='hs-definition'>isEmptyTBChan</span> <span class='hs-layout'>(</span><span class='hs-conid'>TBChan</span> <span class='hs-sel'>_slots</span> <span class='hs-sel'>_reads</span> <span class='hs-varid'>chan</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span>
<a name="line-212"></a>    <span class='hs-varid'>isEmptyTChan</span> <span class='hs-varid'>chan</span>
<a name="line-213"></a>
<a name="line-214"></a>
<a name="line-215"></a><a name="isFullTBChan"></a><span class='hs-comment'>-- | Returns @True@ if the supplied @TBChan@ is full (i.e., is over</span>
<a name="line-216"></a><span class='hs-comment'>-- its limit). /N.B./, a @TBChan@ can be both ``empty'' and ``full''</span>
<a name="line-217"></a><span class='hs-comment'>-- at the same time, if the initial limit was non-positive. /N.B./,</span>
<a name="line-218"></a><span class='hs-comment'>-- a @TBChan@ may still be full after reading, if 'unGetTBChan' was</span>
<a name="line-219"></a><span class='hs-comment'>-- used to go over the initial limit.</span>
<a name="line-220"></a><span class='hs-comment'>--</span>
<a name="line-221"></a><span class='hs-comment'>-- This is equivalent to: @liftM (&lt;= 0) estimateFreeSlotsTBMChan@</span>
<a name="line-222"></a><span class='hs-definition'>isFullTBChan</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TBChan</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>STM</span> <span class='hs-conid'>Bool</span>
<a name="line-223"></a><span class='hs-definition'>isFullTBChan</span> <span class='hs-layout'>(</span><span class='hs-conid'>TBChan</span> <span class='hs-varid'>slots</span> <span class='hs-varid'>reads</span> <span class='hs-sel'>_chan</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-224"></a>    <span class='hs-varid'>n</span> <span class='hs-keyglyph'>&lt;-</span> <span class='hs-varid'>readTVar</span> <span class='hs-varid'>slots</span>
<a name="line-225"></a>    <span class='hs-keyword'>if</span> <span class='hs-varid'>n</span> <span class='hs-varop'>&lt;=</span> <span class='hs-num'>0</span>
<a name="line-226"></a>        <span class='hs-keyword'>then</span> <span class='hs-keyword'>do</span>
<a name="line-227"></a>            <span class='hs-varid'>m</span> <span class='hs-keyglyph'>&lt;-</span> <span class='hs-varid'>readTVar</span> <span class='hs-varid'>reads</span>
<a name="line-228"></a>            <span class='hs-keyword'>let</span> <span class='hs-varid'>n'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>n</span> <span class='hs-varop'>+</span> <span class='hs-varid'>m</span>
<a name="line-229"></a>            <span class='hs-varid'>writeTVar</span> <span class='hs-varid'>slots</span> <span class='hs-varop'>$!</span> <span class='hs-varid'>n'</span>
<a name="line-230"></a>            <span class='hs-varid'>writeTVar</span> <span class='hs-varid'>reads</span> <span class='hs-num'>0</span>
<a name="line-231"></a>            <span class='hs-varid'>return</span> <span class='hs-varop'>$!</span> <span class='hs-varid'>n'</span> <span class='hs-varop'>&lt;=</span> <span class='hs-num'>0</span>
<a name="line-232"></a>        <span class='hs-keyword'>else</span> <span class='hs-varid'>return</span> <span class='hs-conid'>False</span>
<a name="line-233"></a><span class='hs-comment'>{-
<a name="line-234"></a>-- The above saves an extraneous comparison of n\/n' against 0
<a name="line-235"></a>-- compared to the more obvious:
<a name="line-236"></a>isFullTBChan self = do
<a name="line-237"></a>    n &lt;- estimateFreeSlotsTBChan self
<a name="line-238"></a>    return $! n &lt;= 0
<a name="line-239"></a>-}</span>
<a name="line-240"></a>
<a name="line-241"></a>
<a name="line-242"></a><a name="estimateFreeSlotsTBChan"></a><span class='hs-comment'>-- | Estimate the number of free slots. If the result is positive,</span>
<a name="line-243"></a><span class='hs-comment'>-- then it's a minimum bound; if it's non-positive then it's exact.</span>
<a name="line-244"></a><span class='hs-comment'>-- It will only be negative if the initial limit was negative or</span>
<a name="line-245"></a><span class='hs-comment'>-- if 'unGetTBChan' was used to go over the initial limit.</span>
<a name="line-246"></a><span class='hs-comment'>--</span>
<a name="line-247"></a><span class='hs-comment'>-- This function always contends with writers, but only contends</span>
<a name="line-248"></a><span class='hs-comment'>-- with readers when it has to; compare against 'freeSlotsTBChan'.</span>
<a name="line-249"></a><span class='hs-definition'>estimateFreeSlotsTBChan</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TBChan</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>STM</span> <span class='hs-conid'>Int</span>
<a name="line-250"></a><span class='hs-definition'>estimateFreeSlotsTBChan</span> <span class='hs-layout'>(</span><span class='hs-conid'>TBChan</span> <span class='hs-varid'>slots</span> <span class='hs-varid'>reads</span> <span class='hs-sel'>_chan</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-251"></a>    <span class='hs-varid'>n</span> <span class='hs-keyglyph'>&lt;-</span> <span class='hs-varid'>readTVar</span> <span class='hs-varid'>slots</span>
<a name="line-252"></a>    <span class='hs-keyword'>if</span> <span class='hs-varid'>n</span> <span class='hs-varop'>&gt;</span> <span class='hs-num'>0</span>
<a name="line-253"></a>        <span class='hs-keyword'>then</span> <span class='hs-varid'>return</span> <span class='hs-varid'>n</span>
<a name="line-254"></a>        <span class='hs-keyword'>else</span> <span class='hs-keyword'>do</span>
<a name="line-255"></a>            <span class='hs-varid'>m</span> <span class='hs-keyglyph'>&lt;-</span> <span class='hs-varid'>readTVar</span> <span class='hs-varid'>reads</span>
<a name="line-256"></a>            <span class='hs-keyword'>let</span> <span class='hs-varid'>n'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>n</span> <span class='hs-varop'>+</span> <span class='hs-varid'>m</span>
<a name="line-257"></a>            <span class='hs-varid'>writeTVar</span> <span class='hs-varid'>slots</span> <span class='hs-varop'>$!</span> <span class='hs-varid'>n'</span>
<a name="line-258"></a>            <span class='hs-varid'>writeTVar</span> <span class='hs-varid'>reads</span> <span class='hs-num'>0</span>
<a name="line-259"></a>            <span class='hs-varid'>return</span> <span class='hs-varid'>n'</span>
<a name="line-260"></a>
<a name="line-261"></a>
<a name="line-262"></a><a name="freeSlotsTBChan"></a><span class='hs-comment'>-- | Return the exact number of free slots. The result can be</span>
<a name="line-263"></a><span class='hs-comment'>-- negative if the initial limit was negative or if 'unGetTBChan'</span>
<a name="line-264"></a><span class='hs-comment'>-- was used to go over the initial limit.</span>
<a name="line-265"></a><span class='hs-comment'>--</span>
<a name="line-266"></a><span class='hs-comment'>-- This function always contends with both readers and writers;</span>
<a name="line-267"></a><span class='hs-comment'>-- compare against 'estimateFreeSlotsTBChan'.</span>
<a name="line-268"></a><span class='hs-definition'>freeSlotsTBChan</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TBChan</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>STM</span> <span class='hs-conid'>Int</span>
<a name="line-269"></a><span class='hs-definition'>freeSlotsTBChan</span> <span class='hs-layout'>(</span><span class='hs-conid'>TBChan</span> <span class='hs-varid'>slots</span> <span class='hs-varid'>reads</span> <span class='hs-sel'>_chan</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-270"></a>    <span class='hs-varid'>n</span> <span class='hs-keyglyph'>&lt;-</span> <span class='hs-varid'>readTVar</span> <span class='hs-varid'>slots</span>
<a name="line-271"></a>    <span class='hs-varid'>m</span> <span class='hs-keyglyph'>&lt;-</span> <span class='hs-varid'>readTVar</span> <span class='hs-varid'>reads</span>
<a name="line-272"></a>    <span class='hs-keyword'>let</span> <span class='hs-varid'>n'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>n</span> <span class='hs-varop'>+</span> <span class='hs-varid'>m</span>
<a name="line-273"></a>    <span class='hs-varid'>writeTVar</span> <span class='hs-varid'>slots</span> <span class='hs-varop'>$!</span> <span class='hs-varid'>n'</span>
<a name="line-274"></a>    <span class='hs-varid'>writeTVar</span> <span class='hs-varid'>reads</span> <span class='hs-num'>0</span>
<a name="line-275"></a>    <span class='hs-varid'>return</span> <span class='hs-varid'>n'</span>
<a name="line-276"></a>
<a name="line-277"></a><span class='hs-comment'>----------------------------------------------------------------</span>
<a name="line-278"></a><span class='hs-comment'>----------------------------------------------------------- fin.</span>
</pre></body>
</html>