Here is a slightly nicer version using the Codensity monad of STM.<div><br></div><div>Thanks go to Andrea Vezzosi for figuring out an annoying hanging bug I was having.</div><div><br></div><div>-Edward Kmett<br><div><br></div>
<div><span class="Apple-style-span" style="font-family: sans-serif; font-size: 14px; -webkit-border-horizontal-spacing: 2px; -webkit-border-vertical-spacing: 2px; "><pre style="overflow-x: auto; overflow-y: auto; padding-left: 5px; ">
<span id="li-5969-1"><span class="cm" style="color: rgb(128, 128, 128); ">{-# LANGUAGE Rank2Types, GeneralizedNewtypeDeriving, DeriveFunctor #-}</span>
</span><span id="li-5969-2"><span class="kr" style="color: rgb(0, 128, 0); font-weight: bold; ">module</span> <span class="nn" style="color: rgb(14, 132, 181); font-weight: bold; ">STMOracle</span>
</span><span id="li-5969-3">    <span class="p">(</span> <span class="kt" style="color: rgb(48, 48, 144); font-weight: bold; ">Oracle</span><span class="p">,</span> <span class="kt" style="color: rgb(48, 48, 144); font-weight: bold; ">Ref</span>
</span><span id="li-5969-4">    <span class="p">,</span> <span class="nf" style="color: rgb(0, 96, 176); font-weight: bold; ">newRef</span><span class="p">,</span> <span class="nf" style="color: rgb(0, 96, 176); font-weight: bold; ">readRef</span><span class="p">,</span> <span class="nf" style="color: rgb(0, 96, 176); font-weight: bold; ">writeRef</span><span class="p">,</span> <span class="nf" style="color: rgb(0, 96, 176); font-weight: bold; ">modifyRef</span><span class="p">,</span> <span class="nf" style="color: rgb(0, 96, 176); font-weight: bold; ">needRef</span>
</span><span id="li-5969-5">    <span class="p">)</span> <span class="kr" style="color: rgb(0, 128, 0); font-weight: bold; ">where</span>
</span><span id="li-5969-6">
</span><span id="li-5969-7"><span class="kr" style="color: rgb(0, 128, 0); font-weight: bold; ">import</span> <span class="nn" style="color: rgb(14, 132, 181); font-weight: bold; ">Control.Applicative</span>
</span><span id="li-5969-8"><span class="kr" style="color: rgb(0, 128, 0); font-weight: bold; ">import</span> <span class="nn" style="color: rgb(14, 132, 181); font-weight: bold; ">Control.Monad</span>
</span><span id="li-5969-9"><span class="kr" style="color: rgb(0, 128, 0); font-weight: bold; ">import</span> <span class="nn" style="color: rgb(14, 132, 181); font-weight: bold; ">Control.Concurrent.STM</span>
</span><span id="li-5969-10">
</span><span id="li-5969-11"><span class="kr" style="color: rgb(0, 128, 0); font-weight: bold; ">instance</span> <span class="kt" style="color: rgb(48, 48, 144); font-weight: bold; ">Applicative</span> <span class="kt" style="color: rgb(48, 48, 144); font-weight: bold; ">STM</span> <span class="kr" style="color: rgb(0, 128, 0); font-weight: bold; ">where</span>
</span><span id="li-5969-12">    <span class="n">pure</span> <span class="ow" style="color: rgb(0, 0, 0); font-weight: bold; ">=</span> <span class="n">return</span>
</span><span id="li-5969-13">    <span class="p">(</span><span class="o" style="color: rgb(48, 48, 48); ">&lt;*&gt;</span><span class="p">)</span> <span class="ow" style="color: rgb(0, 0, 0); font-weight: bold; ">=</span> <span class="n">ap</span>
</span><span id="li-5969-14">
</span><span id="li-5969-15"><span class="kr" style="color: rgb(0, 128, 0); font-weight: bold; ">newtype</span> <span class="kt" style="color: rgb(48, 48, 144); font-weight: bold; ">Ref</span> <span class="n">s</span> <span class="n">a</span> <span class="ow" style="color: rgb(0, 0, 0); font-weight: bold; ">=</span> <span class="kt" style="color: rgb(48, 48, 144); font-weight: bold; ">Ref</span> <span class="p">(</span><span class="kt" style="color: rgb(48, 48, 144); font-weight: bold; ">TVar</span> <span class="p">(</span><span class="kt" style="color: rgb(48, 48, 144); font-weight: bold; ">Maybe</span> <span class="n">a</span><span class="p">))</span>
</span><span id="li-5969-16"><span class="kr" style="color: rgb(0, 128, 0); font-weight: bold; ">newtype</span> <span class="kt" style="color: rgb(48, 48, 144); font-weight: bold; ">Oracle</span> <span class="n">s</span> <span class="n">a</span> <span class="ow" style="color: rgb(0, 0, 0); font-weight: bold; ">=</span> <span class="kt" style="color: rgb(48, 48, 144); font-weight: bold; ">Oracle</span> <span class="p">{</span> <span class="n">unOracle</span> <span class="ow" style="color: rgb(0, 0, 0); font-weight: bold; ">::</span> <span class="n">forall</span> <span class="n">r</span><span class="o" style="color: rgb(48, 48, 48); ">.</span> <span class="p">(</span><span class="n">a</span> <span class="ow" style="color: rgb(0, 0, 0); font-weight: bold; ">-&gt;</span> <span class="kt" style="color: rgb(48, 48, 144); font-weight: bold; ">STM</span> <span class="n">r</span><span class="p">)</span> <span class="ow" style="color: rgb(0, 0, 0); font-weight: bold; ">-&gt;</span> <span class="kt" style="color: rgb(48, 48, 144); font-weight: bold; ">STM</span> <span class="n">r</span> <span class="p">}</span> <span class="kr" style="color: rgb(0, 128, 0); font-weight: bold; ">deriving</span> <span class="p">(</span><span class="kt" style="color: rgb(48, 48, 144); font-weight: bold; ">Functor</span><span class="p">)</span>
</span><span id="li-5969-17">
</span><span id="li-5969-18"><span class="kr" style="color: rgb(0, 128, 0); font-weight: bold; ">instance</span> <span class="kt" style="color: rgb(48, 48, 144); font-weight: bold; ">Monad</span> <span class="p">(</span><span class="kt" style="color: rgb(48, 48, 144); font-weight: bold; ">Oracle</span> <span class="n">s</span><span class="p">)</span> <span class="kr" style="color: rgb(0, 128, 0); font-weight: bold; ">where</span>
</span><span id="li-5969-19">  <span class="n">return</span> <span class="n">x</span> <span class="ow" style="color: rgb(0, 0, 0); font-weight: bold; ">=</span> <span class="kt" style="color: rgb(48, 48, 144); font-weight: bold; ">Oracle</span> <span class="p">(</span><span class="nf" style="color: rgb(0, 96, 176); font-weight: bold; ">\</span><span class="n">k</span> <span class="ow" style="color: rgb(0, 0, 0); font-weight: bold; ">-&gt;</span> <span class="n">k</span> <span class="n">x</span><span class="p">)</span>
</span><span id="li-5969-20">  <span class="kt" style="color: rgb(48, 48, 144); font-weight: bold; ">Oracle</span> <span class="n">m</span> <span class="o" style="color: rgb(48, 48, 48); ">&gt;&gt;=</span> <span class="n">f</span> <span class="ow" style="color: rgb(0, 0, 0); font-weight: bold; ">=</span> <span class="kt" style="color: rgb(48, 48, 144); font-weight: bold; ">Oracle</span> <span class="p">(</span><span class="nf" style="color: rgb(0, 96, 176); font-weight: bold; ">\</span><span class="n">k</span> <span class="ow" style="color: rgb(0, 0, 0); font-weight: bold; ">-&gt;</span> <span class="n">m</span> <span class="p">(</span><span class="nf" style="color: rgb(0, 96, 176); font-weight: bold; ">\</span><span class="n">a</span> <span class="ow" style="color: rgb(0, 0, 0); font-weight: bold; ">-&gt;</span> <span class="n">unOracle</span> <span class="p">(</span><span class="n">f</span> <span class="n">a</span><span class="p">)</span> <span class="n">k</span><span class="p">))</span>
</span><span id="li-5969-21">
</span><span id="li-5969-22"><span class="nf" style="color: rgb(0, 96, 176); font-weight: bold; ">mkOracle</span> <span class="n">m</span> <span class="ow" style="color: rgb(0, 0, 0); font-weight: bold; ">=</span> <span class="kt" style="color: rgb(48, 48, 144); font-weight: bold; ">Oracle</span> <span class="p">(</span><span class="n">m</span> <span class="o" style="color: rgb(48, 48, 48); ">&gt;&gt;=</span><span class="p">)</span>
</span><span id="li-5969-23">
</span><span id="li-5969-24"><span class="nf" style="color: rgb(0, 96, 176); font-weight: bold; ">runOracle</span> <span class="ow" style="color: rgb(0, 0, 0); font-weight: bold; ">::</span> <span class="p">(</span><span class="n">forall</span> <span class="n">s</span><span class="o" style="color: rgb(48, 48, 48); ">.</span> <span class="kt" style="color: rgb(48, 48, 144); font-weight: bold; ">Oracle</span> <span class="n">s</span> <span class="n">a</span><span class="p">)</span> <span class="ow" style="color: rgb(0, 0, 0); font-weight: bold; ">-&gt;</span> <span class="kt" style="color: rgb(48, 48, 144); font-weight: bold; ">IO</span> <span class="n">a</span>
</span><span id="li-5969-25"><span class="nf" style="color: rgb(0, 96, 176); font-weight: bold; ">runOracle</span> <span class="n">t</span> <span class="ow" style="color: rgb(0, 0, 0); font-weight: bold; ">=</span> <span class="n">atomically</span> <span class="p">(</span><span class="n">unOracle</span> <span class="n">t</span> <span class="n">return</span><span class="p">)</span>
</span><span id="li-5969-26">
</span><span id="li-5969-27"><span class="nf" style="color: rgb(0, 96, 176); font-weight: bold; ">newRef</span> <span class="ow" style="color: rgb(0, 0, 0); font-weight: bold; ">::</span> <span class="n">a</span> <span class="ow" style="color: rgb(0, 0, 0); font-weight: bold; ">-&gt;</span> <span class="kt" style="color: rgb(48, 48, 144); font-weight: bold; ">Oracle</span> <span class="n">s</span> <span class="p">(</span><span class="kt" style="color: rgb(48, 48, 144); font-weight: bold; ">Ref</span> <span class="n">s</span> <span class="n">a</span><span class="p">)</span>
</span><span id="li-5969-28"><span class="nf" style="color: rgb(0, 96, 176); font-weight: bold; ">newRef</span> <span class="n">a</span> <span class="ow" style="color: rgb(0, 0, 0); font-weight: bold; ">=</span> <span class="n">mkOracle</span> <span class="o" style="color: rgb(48, 48, 48); ">$</span> <span class="kt" style="color: rgb(48, 48, 144); font-weight: bold; ">Ref</span> <span class="o" style="color: rgb(48, 48, 48); ">&lt;$&gt;</span> <span class="n">newTVar</span> <span class="p">(</span><span class="kt" style="color: rgb(48, 48, 144); font-weight: bold; ">Just</span> <span class="n">a</span><span class="p">)</span>
</span><span id="li-5969-29">
</span><span id="li-5969-30"><span class="nf" style="color: rgb(0, 96, 176); font-weight: bold; ">readRef</span> <span class="ow" style="color: rgb(0, 0, 0); font-weight: bold; ">::</span> <span class="kt" style="color: rgb(48, 48, 144); font-weight: bold; ">Ref</span> <span class="n">s</span> <span class="n">a</span> <span class="ow" style="color: rgb(0, 0, 0); font-weight: bold; ">-&gt;</span> <span class="kt" style="color: rgb(48, 48, 144); font-weight: bold; ">Oracle</span> <span class="n">s</span> <span class="n">a</span>
</span><span id="li-5969-31"><span class="nf" style="color: rgb(0, 96, 176); font-weight: bold; ">readRef</span> <span class="p">(</span><span class="kt" style="color: rgb(48, 48, 144); font-weight: bold; ">Ref</span> <span class="n">r</span><span class="p">)</span> <span class="ow" style="color: rgb(0, 0, 0); font-weight: bold; ">=</span> <span class="n">mkOracle</span> <span class="o" style="color: rgb(48, 48, 48); ">$</span> <span class="kr" style="color: rgb(0, 128, 0); font-weight: bold; ">do</span>
</span><span id="li-5969-32">    <span class="n">m</span> <span class="ow" style="color: rgb(0, 0, 0); font-weight: bold; ">&lt;-</span> <span class="n">readTVar</span> <span class="n">r</span>
</span><span id="li-5969-33">    <span class="n">maybe</span> <span class="n">retry</span> <span class="n">return</span> <span class="n">m</span>
</span><span id="li-5969-34">
</span><span id="li-5969-35"><span class="nf" style="color: rgb(0, 96, 176); font-weight: bold; ">writeRef</span> <span class="ow" style="color: rgb(0, 0, 0); font-weight: bold; ">::</span> <span class="n">a</span> <span class="ow" style="color: rgb(0, 0, 0); font-weight: bold; ">-&gt;</span> <span class="kt" style="color: rgb(48, 48, 144); font-weight: bold; ">Ref</span> <span class="n">s</span> <span class="n">a</span> <span class="ow" style="color: rgb(0, 0, 0); font-weight: bold; ">-&gt;</span> <span class="kt" style="color: rgb(48, 48, 144); font-weight: bold; ">Oracle</span> <span class="n">s</span> <span class="n">a</span>
</span><span id="li-5969-36"><span class="nf" style="color: rgb(0, 96, 176); font-weight: bold; ">writeRef</span> <span class="n">a</span> <span class="p">(</span><span class="kt" style="color: rgb(48, 48, 144); font-weight: bold; ">Ref</span> <span class="n">r</span><span class="p">)</span> <span class="ow" style="color: rgb(0, 0, 0); font-weight: bold; ">=</span> <span class="n">mkOracle</span> <span class="o" style="color: rgb(48, 48, 48); ">$</span> <span class="kr" style="color: rgb(0, 128, 0); font-weight: bold; ">do</span>
</span><span id="li-5969-37">    <span class="n">writeTVar</span> <span class="n">r</span> <span class="p">(</span><span class="kt" style="color: rgb(48, 48, 144); font-weight: bold; ">Just</span> <span class="n">a</span><span class="p">)</span>
</span><span id="li-5969-38">    <span class="n">return</span> <span class="n">a</span>
</span><span id="li-5969-39">
</span><span id="li-5969-40"><span class="nf" style="color: rgb(0, 96, 176); font-weight: bold; ">modifyRef</span> <span class="ow" style="color: rgb(0, 0, 0); font-weight: bold; ">::</span> <span class="p">(</span><span class="n">a</span> <span class="ow" style="color: rgb(0, 0, 0); font-weight: bold; ">-&gt;</span> <span class="n">a</span><span class="p">)</span> <span class="ow" style="color: rgb(0, 0, 0); font-weight: bold; ">-&gt;</span> <span class="kt" style="color: rgb(48, 48, 144); font-weight: bold; ">Ref</span> <span class="n">s</span> <span class="n">a</span> <span class="ow" style="color: rgb(0, 0, 0); font-weight: bold; ">-&gt;</span> <span class="kt" style="color: rgb(48, 48, 144); font-weight: bold; ">Oracle</span> <span class="n">s</span> <span class="n">a</span>
</span><span id="li-5969-41"><span class="nf" style="color: rgb(0, 96, 176); font-weight: bold; ">modifyRef</span> <span class="n">f</span> <span class="n">r</span> <span class="ow" style="color: rgb(0, 0, 0); font-weight: bold; ">=</span> <span class="kr" style="color: rgb(0, 128, 0); font-weight: bold; ">do</span>
</span><span id="li-5969-42">    <span class="n">a</span> <span class="ow" style="color: rgb(0, 0, 0); font-weight: bold; ">&lt;-</span> <span class="n">readRef</span> <span class="n">r</span>
</span><span id="li-5969-43">    <span class="n">writeRef</span> <span class="p">(</span><span class="n">f</span> <span class="n">a</span><span class="p">)</span> <span class="n">r</span>
</span><span id="li-5969-44">
</span><span id="li-5969-45"><span class="nf" style="color: rgb(0, 96, 176); font-weight: bold; ">needRef</span> <span class="ow" style="color: rgb(0, 0, 0); font-weight: bold; ">::</span> <span class="kt" style="color: rgb(48, 48, 144); font-weight: bold; ">Ref</span> <span class="n">s</span> <span class="n">a</span> <span class="ow" style="color: rgb(0, 0, 0); font-weight: bold; ">-&gt;</span> <span class="kt" style="color: rgb(48, 48, 144); font-weight: bold; ">Oracle</span> <span class="n">s</span> <span class="kt" style="color: rgb(48, 48, 144); font-weight: bold; ">Bool</span>
</span><span id="li-5969-46"><span class="nf" style="color: rgb(0, 96, 176); font-weight: bold; ">needRef</span> <span class="p">(</span><span class="kt" style="color: rgb(48, 48, 144); font-weight: bold; ">Ref</span> <span class="n">slot</span><span class="p">)</span> <span class="ow" style="color: rgb(0, 0, 0); font-weight: bold; ">=</span> <span class="kt" style="color: rgb(48, 48, 144); font-weight: bold; ">Oracle</span> <span class="o" style="color: rgb(48, 48, 48); ">$</span> <span class="nf" style="color: rgb(0, 96, 176); font-weight: bold; ">\</span><span class="n">k</span> <span class="ow" style="color: rgb(0, 0, 0); font-weight: bold; ">-&gt;</span>
</span><span id="li-5969-47">             <span class="p">(</span><span class="n">writeTVar</span> <span class="n">slot</span> <span class="kt" style="color: rgb(48, 48, 144); font-weight: bold; ">Nothing</span> <span class="o" style="color: rgb(48, 48, 48); ">&gt;&gt;</span> <span class="n">k</span> <span class="kt" style="color: rgb(48, 48, 144); font-weight: bold; ">False</span><span class="p">)</span>
</span><span id="li-5969-48">    <span class="p">`</span><span class="n">orElse</span><span class="p">`</span> <span class="n">k</span> <span class="kt" style="color: rgb(48, 48, 144); font-weight: bold; ">True</span>
</span><span id="li-5969-49">
</span><span id="li-5969-50"><span class="c1" style="color: rgb(128, 128, 128); ">-- test case:                                                                                                                                </span>
</span><span id="li-5969-51"><span class="nf" style="color: rgb(0, 96, 176); font-weight: bold; ">refMaybe</span> <span class="n">b</span> <span class="n">dflt</span> <span class="n">ref</span> <span class="ow" style="color: rgb(0, 0, 0); font-weight: bold; ">=</span> <span class="kr" style="color: rgb(0, 128, 0); font-weight: bold; ">if</span> <span class="n">b</span> <span class="kr" style="color: rgb(0, 128, 0); font-weight: bold; ">then</span> <span class="n">readRef</span> <span class="n">ref</span> <span class="kr" style="color: rgb(0, 128, 0); font-weight: bold; ">else</span> <span class="n">return</span> <span class="n">dflt</span>
</span><span id="li-5969-52"><span class="nf" style="color: rgb(0, 96, 176); font-weight: bold; ">refIgnore</span> <span class="n">ref</span> <span class="ow" style="color: rgb(0, 0, 0); font-weight: bold; ">=</span> <span class="n">return</span> <span class="s" style="color: rgb(151, 134, 160); ">&quot;blablabla&quot;</span>
</span><span id="li-5969-53"><span class="nf" style="color: rgb(0, 96, 176); font-weight: bold; ">refFst</span> <span class="n">ref</span> <span class="ow" style="color: rgb(0, 0, 0); font-weight: bold; ">=</span> <span class="n">fst</span> <span class="p">`</span><span class="n">fmap</span><span class="p">`</span> <span class="n">readRef</span> <span class="n">ref</span>
</span><span id="li-5969-54"><span class="nf" style="color: rgb(0, 96, 176); font-weight: bold; ">test</span> <span class="ow" style="color: rgb(0, 0, 0); font-weight: bold; ">=</span> <span class="kr" style="color: rgb(0, 128, 0); font-weight: bold; ">do</span>
</span><span id="li-5969-55">     <span class="n">a</span> <span class="ow" style="color: rgb(0, 0, 0); font-weight: bold; ">&lt;-</span> <span class="n">newRef</span> <span class="s" style="color: rgb(151, 134, 160); ">&quot;x&quot;</span>
</span><span id="li-5969-56">     <span class="n">b</span> <span class="ow" style="color: rgb(0, 0, 0); font-weight: bold; ">&lt;-</span> <span class="n">newRef</span> <span class="mi" style="color: rgb(0, 0, 208); font-weight: bold; ">1</span>
</span><span id="li-5969-57">     <span class="n">c</span> <span class="ow" style="color: rgb(0, 0, 0); font-weight: bold; ">&lt;-</span> <span class="n">newRef</span> <span class="p">(</span><span class="sc" style="color: rgb(0, 64, 208); ">&#39;z&#39;</span><span class="p">,</span> <span class="kt" style="color: rgb(48, 48, 144); font-weight: bold; ">Just</span> <span class="mi" style="color: rgb(0, 0, 208); font-weight: bold; ">0</span><span class="p">)</span>
</span><span id="li-5969-58">     <span class="c1" style="color: rgb(128, 128, 128); ">-- no performLocalGC required                                                                                                           </span>
</span><span id="li-5969-59">     <span class="n">x</span> <span class="ow" style="color: rgb(0, 0, 0); font-weight: bold; ">&lt;-</span> <span class="n">needRef</span> <span class="n">a</span>
</span><span id="li-5969-60">     <span class="n">y</span> <span class="ow" style="color: rgb(0, 0, 0); font-weight: bold; ">&lt;-</span> <span class="n">needRef</span> <span class="n">b</span>
</span><span id="li-5969-61">     <span class="n">z</span> <span class="ow" style="color: rgb(0, 0, 0); font-weight: bold; ">&lt;-</span> <span class="n">needRef</span> <span class="n">c</span>
</span><span id="li-5969-62">     <span class="n">u</span> <span class="ow" style="color: rgb(0, 0, 0); font-weight: bold; ">&lt;-</span> <span class="n">refMaybe</span> <span class="n">y</span> <span class="s" style="color: rgb(151, 134, 160); ">&quot;t&quot;</span> <span class="n">a</span> <span class="c1" style="color: rgb(128, 128, 128); ">-- note that it wouldn&#39;t actually read &quot;a&quot;,                                                                       </span>
</span><span id="li-5969-63">                           <span class="c1" style="color: rgb(128, 128, 128); ">-- but it won&#39;t be known until runtime.                                                                           </span>
</span><span id="li-5969-64">     <span class="n">w</span> <span class="ow" style="color: rgb(0, 0, 0); font-weight: bold; ">&lt;-</span> <span class="n">refIgnore</span> <span class="n">b</span>
</span><span id="li-5969-65">     <span class="n">v</span> <span class="ow" style="color: rgb(0, 0, 0); font-weight: bold; ">&lt;-</span> <span class="n">refFst</span> <span class="n">c</span>
</span><span id="li-5969-66">     <span class="n">return</span> <span class="p">(</span><span class="n">x</span><span class="p">,</span> <span class="n">y</span><span class="p">,</span> <span class="n">z</span><span class="p">)</span></span></pre>
</span><div><br></div><div><br><br><div class="gmail_quote">On Wed, Jan 6, 2010 at 10:28 PM, Edward Kmett <span dir="ltr">&lt;<a href="mailto:ekmett@gmail.com">ekmett@gmail.com</a>&gt;</span> wrote:<br><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex;">
<div>I don&#39;t believe you can get quite the semantics you want. However, you can get reasonably close, by building a manual store and backtracking.</div><div><br></div><div><div>{-# LANGUAGE Rank2Types #-}</div><div>-- lets define an Oracle that tracks whether or not you might need the reference, by backtracking.</div>

<div>module Oracle </div><div>    ( Oracle, Ref</div><div>    , newRef, readRef, writeRef, modifyRef, needRef</div><div>    ) where</div><div><br></div><div>import Control.Applicative</div><div>import Control.Arrow (first)</div>

<div>import Control.Monad</div><div>import Data.IntMap (IntMap)</div><div>import qualified Data.IntMap as M</div><div>import Unsafe.Coerce (unsafeCoerce)</div><div>import GHC.Prim (Any)</div><div><br></div><div>-- we need to track our own worlds, otherwise we&#39;d have to build over ST, change optimistically, and track how to backtrack the state of the Store. Much uglier.</div>

<div>-- values are stored as &#39;Any&#39;s for safety, see GHC.Prim for a discussion on the hazards of risking the storage of function types using unsafeCoerce as anything else.</div><div>data World s = World { store :: !(IntMap Any), hwm :: !Int } </div>

<div><br></div><div>-- references into our store</div><div>newtype Ref s a = Ref Int deriving (Eq)</div><div><br></div><div>-- our monad that can &#39;see the future&#39; ~ StateT (World s) [] </div><div>newtype Oracle s a = Oracle { unOracle :: World s -&gt; [(a, World s)] } </div>

<div><br></div><div>-- we rely on the fact that the list is always non-empty for any oracle you can run. we are only allowed to backtrack if we thought we wouldn&#39;t need the reference, and wound up needing it, so head will always succeed.</div>

<div>runOracle :: (forall s. Oracle s a) -&gt; a</div><div>runOracle f = fst $ head $ unOracle f $ World M.empty 1</div><div><br></div><div><br></div><div>instance Monad (Oracle s) where</div><div>    return a = Oracle $ \w -&gt; [(a,w)]</div>

<div>    Oracle m &gt;&gt;= k = Oracle $ \s -&gt; do</div><div>        (a,s&#39;) &lt;- m s</div><div>        unOracle (k a) s&#39;</div><div><br></div><div>-- note: you cannot safely define fail here without risking a crash in runOracle</div>

<div>-- Similarly, we&#39;re not a MonadPlus instance because we always want to succeed eventually.</div><div><br></div><div>instance Functor (Oracle s) where</div><div>    fmap f (Oracle g) = Oracle $ \w -&gt; first f &lt;$&gt; g w</div>

<div><br></div><div>instance Applicative (Oracle s) where</div><div>    pure = return</div><div>    (&lt;*&gt;) = ap</div><div><br></div><div>-- new ref allocates a fresh slot and inserts the value into the store. the type level brand &#39;s&#39; keeps us safe, and we don&#39;t export the Ref constructor.</div>

<div>newRef :: a -&gt; Oracle s (Ref s a)</div><div>newRef a = Oracle $ \(World w t) -&gt; </div><div>    [(Ref t, World (M.insert t (unsafeCoerce a) w) (t + 1))]</div><div><br></div><div>-- readRef is the only thing that ever backtracks, if we try to read a reference we claimed we wouldn&#39;t need, then we backtrack to when we decided we didn&#39;t need the reference, and continue with its value.</div>

<div>readRef :: Ref s a -&gt; Oracle s a</div><div>readRef (Ref slot) = Oracle $ \world -&gt; </div><div>    maybe [] (\a -&gt; [(unsafeCoerce a, world)]) $ M.lookup slot (store world)</div><div><br></div><div>-- note, writeRef dfoesn&#39;t &#39;need&#39; the ref&#39;s current value, so needRef will report False if you writeRef before you read it after this.</div>

<div>writeRef :: a -&gt; Ref s a -&gt; Oracle s a</div><div>writeRef a (Ref slot) = Oracle $ \world -&gt; </div><div>        [(a, world { store = M.insert slot (unsafeCoerce a) $ store world })]</div><div><br></div><div>
{-</div>
<div>-- alternate writeRef where writing &#39;needs&#39; the ref.</div><div>writeRef :: a -&gt; Ref s a -&gt; Oracle s a</div><div>writeRef a (Ref slot) = Oracle $ \World store v -&gt; do</div><div>    (Just _, store&#39;) &lt;- return $ updateLookupWithKey replace slot store</div>

<div>    [(a, World store&#39; v)]</div><div>  where </div><div>    replace _ _ = Just (unsafeCoerce a)</div><div>-}</div><div><br></div><div>-- modifying a reference of course needs its current value.</div><div>modifyRef :: (a -&gt; a) -&gt; Ref s a -&gt; Oracle s a</div>

<div>modifyRef f r = do</div><div>    a &lt;- readRef r</div><div>    writeRef (f a) r</div><div>    </div><div>-- needRef tries to continue executing the world without the element in the store in question. if that fails, then we&#39;ll backtrack to here, and try again with the original world, and report that the element was in fact needed.</div>

<div>needRef :: Ref s a -&gt; Oracle s Bool</div><div>needRef (Ref slot) = Oracle $ \world -&gt; </div><div>    [ (False, world { store = M.delete slot $ store world })</div><div>    , (True, world)</div><div>    ]</div>
<div>
<br></div><div>-- test case:</div><div class="im"><div>refMaybe b dflt ref = if b then readRef ref else return dflt</div><div>refIgnore ref = return &quot;blablabla&quot;</div></div><div>refFst ref = fst &lt;$&gt; readRef ref</div>
<div class="im"><div>test = do</div>
<div>     a &lt;- newRef &quot;x&quot;</div><div>     b &lt;- newRef 1</div><div>     c &lt;- newRef (&#39;z&#39;, Just 0)</div></div><div>     -- no performLocalGC required</div><div>     x &lt;- needRef a</div><div>     y &lt;- needRef b</div>

<div>     z &lt;- needRef c</div><div class="im"><div>     u &lt;- refMaybe y &quot;t&quot; a -- note that it wouldn&#39;t actually read &quot;a&quot;,</div><div>                           -- but it won&#39;t be known until runtime.</div>

<div>     w &lt;- refIgnore b</div><div>     v &lt;- refFst c</div><div>     return (x, y, z)</div><div><br></div></div><div>-- This will disagree with your desired answer, returning:</div><div><br></div><div><div>*Oracle&gt; runOracle test</div>

<div>Loading package syb ... linking ... done.</div><div>Loading package array-0.2.0.0 ... linking ... done.</div><div>Loading package containers-0.2.0.1 ... linking ... done.</div><div>(False,False,True)</div><div><br></div>

</div></div><div>rather than (True, False, True), because the oracle is able to see into the future (via backtracking) to see that refMaybe doesn&#39;t use the reference after all.</div><div><br></div><div>This probably won&#39;t suit your needs, but it was a fun little exercise.</div>

<div><br></div><font color="#888888"><div>-Edward Kmett</div></font><div><div></div><div class="h5"><div><br></div>On Wed, Jan 6, 2010 at 4:05 PM, Miguel Mitrofanov <span dir="ltr">&lt;<a href="mailto:miguelimo38@yandex.ru" target="_blank">miguelimo38@yandex.ru</a>&gt;</span> wrote:<br>

<div class="gmail_quote"><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex">

<div><br>
On 6 Jan 2010, at 23:21, Edward Kmett wrote:<br>
<br>
<blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex">
You probably just want to hold onto weak references for your &#39;isStillNeeded&#39; checks.<br>
</blockquote>
<br></div>
That&#39;s what I do now. But I want to minimize the network traffic, so I want referenced values to be garbage collected as soon as possible - and I couldn&#39;t find anything except System.Mem.performIO to do the job - which is a bit too global for me.<div>


<br>
<blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex">
Otherwise the isStillNeeded check itself will keep you from garbage collecting!<br>
</blockquote>
<br></div>
Not necessary. What I&#39;m imagining is that there is essentially only one way to access the value stored in the reference - with readRef. So, if there isn&#39;t any chance that readRef would be called, the value can be garbage collected; &quot;isStillNeeded&quot; function only needs the reference, not the value.<br>




<br>
Well, yeah, that&#39;s kinda like weak references.<div><div></div><div><br><br><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex">
<a href="http://cvs.haskell.org/Hugs/pages/libraries/base/System-Mem-Weak.html" target="_blank">http://cvs.haskell.org/Hugs/pages/libraries/base/System-Mem-Weak.html</a><br>
<br>
-Edward Kmett<br>
<br>
On Wed, Jan 6, 2010 at 9:39 AM, Miguel Mitrofanov &lt;<a href="mailto:miguelimo38@yandex.ru" target="_blank">miguelimo38@yandex.ru</a>&gt; wrote:<br>
I&#39;ll take a look at them.<br>
<br>
I want something like this:<br>
<br>
refMaybe b dflt ref = if b then readRef ref else return dflt<br>
refIgnore ref = return &quot;blablabla&quot;<br>
refFst ref =<br>
  do<br>
     (v, w) &lt;- readRef ref<br>
     return v<br>
test =<br>
  do<br>
     a &lt;- newRef &quot;x&quot;<br>
     b &lt;- newRef 1<br>
     c &lt;- newRef (&#39;z&#39;, Just 0)<br>
     performLocalGC -- if necessary<br>
     x &lt;- isStillNeeded a<br>
     y &lt;- isStillNeeded b<br>
     z &lt;- isStillNeeded c<br>
     u &lt;- refMaybe y &quot;t&quot; a -- note that it wouldn&#39;t actually read &quot;a&quot;,<br>
                           -- but it won&#39;t be known until runtime.<br>
     w &lt;- refIgnore b<br>
     v &lt;- refFst c<br>
     return (x, y, z)<br>
<br>
so that &quot;run test&quot; returns (True, False, True).<br>
<br>
<br>
Dan Doel wrote:<br>
On Wednesday 06 January 2010 8:52:10 am Miguel Mitrofanov wrote:<br>
Is there any kind of &quot;ST&quot; monad that allows to know if some STRef is no<br>
 longer needed?<br>
<br>
The problem is, I want to send some data to an external storage over a<br>
 network and get it back later, but I don&#39;t want to send unnecessary data.<br>
<br>
I&#39;ve managed to do something like that with weak pointers,<br>
 System.Mem.performGC and unsafePerformIO, but it seems to me that invoking<br>
 GC every time is an overkill.<br>
<br>
Oh, and I&#39;m ready to trade the purity of runST for that, if necessary.<br>
<br>
You may be able to use something like Oleg&#39;s Lightweight Monadic Regions to get this effect. I suppose it depends somewhat on what qualifies a reference as &quot;no longer needed&quot;.<br>
<br>
 <a href="http://www.cs.rutgers.edu/~ccshan/capability/region-io.pdf" target="_blank">http://www.cs.rutgers.edu/~ccshan/capability/region-io.pdf</a><br>
<br>
I&#39;m not aware of anything out-of-the-box that does what you want, though.<br>
<br>
-- Dan<br>
_______________________________________________<br>
Haskell-Cafe mailing list<br>
<a href="mailto:Haskell-Cafe@haskell.org" target="_blank">Haskell-Cafe@haskell.org</a><br>
<a href="http://www.haskell.org/mailman/listinfo/haskell-cafe" target="_blank">http://www.haskell.org/mailman/listinfo/haskell-cafe</a><br>
<br>
<br>
<br>
_______________________________________________<br>
Haskell-Cafe mailing list<br>
<a href="mailto:Haskell-Cafe@haskell.org" target="_blank">Haskell-Cafe@haskell.org</a><br>
<a href="http://www.haskell.org/mailman/listinfo/haskell-cafe" target="_blank">http://www.haskell.org/mailman/listinfo/haskell-cafe</a><br>
<br>
_______________________________________________<br>
Haskell-Cafe mailing list<br>
<a href="mailto:Haskell-Cafe@haskell.org" target="_blank">Haskell-Cafe@haskell.org</a><br>
<a href="http://www.haskell.org/mailman/listinfo/haskell-cafe" target="_blank">http://www.haskell.org/mailman/listinfo/haskell-cafe</a><br>
</blockquote>
<br>
</div></div></blockquote></div><br>
</div></div></blockquote></div><br></div></div></div>