[Haskell-cafe] ANNOUNCE: pqueue-mtl, stateful-mtl

Louis Wasserman wasserman.louis at gmail.com
Mon Feb 16 11:55:06 EST 2009


I just posted stateful-mtl and pqueue-mtl 1.0.2, making use of the new
approach to single-threaded ST wrapping.  I discovered while making the
modifications to both packages that the MonadSTTrans type class was
unnecessary, enabling a cleaner integration with mtl proper.  I'm pretty
confident that this approach is airtight, but let me know if you encounter
contradictions or problems.

Louis Wasserman
wasserman.louis at gmail.com


On Mon, Feb 16, 2009 at 10:21 AM, Sittampalam, Ganesh <
ganesh.sittampalam at credit-suisse.com> wrote:

>  Oh, I see, every derived monad has to have an 's' in its type somewhere.
>
>  ------------------------------
> *From:* Louis Wasserman [mailto:wasserman.louis at gmail.com]
> *Sent:* 16 February 2009 16:17
>
> *To:* Sittampalam, Ganesh
> *Cc:* Dan Doel; Henning Thielemann; haskell-cafe at haskell.org
> *Subject:* Re: [Haskell-cafe] ANNOUNCE: pqueue-mtl, stateful-mtl
>
> But the m -> s dependency will have been removed by the time runST gets a
> hold of it!  It works, I just tested it.
>
> *Control.Monad.Array.ArrayM> :t runST (runArrayT 5 Nothing getContents)
> runST (runArrayT 5 Nothing getContents) :: [Maybe a]
> *Control.Monad.Array.ArrayM> runST (runArrayT 5 Nothing getContents)
> [Nothing,Nothing,Nothing,Nothing,Nothing]
>
> There is, unfortunately, one last key point needed in this approach: the
> transformer cannot implement MonadTrans, which requires that it work for all
> monads.  The hack I added is
>
> class MonadSTTrans s t where
>     stLift :: MonadST s m => m a -> t m a
>
> instance MonadTrans t => MonadSTTrans s t where
>     stLift = lift
>
> which, as a side effect, makes explicit the distinction between normal
> monad transformers and ST-wrapped monad transformers.
>
> Louis Wasserman
> wasserman.louis at gmail.com
>
>
> On Mon, Feb 16, 2009 at 10:04 AM, Sittampalam, Ganesh <
> ganesh.sittampalam at credit-suisse.com> wrote:
>
>>  I don't think this can be right, because the m -> s dependency will
>> contradict the universal quantification of s required by runST. In other
>> words, unwrapping the transformers will leave you with an ST computation for
>> a specific s, which runST will reject.
>>
>>  ------------------------------
>> *From:* Louis Wasserman [mailto:wasserman.louis at gmail.com]
>> *Sent:* 16 February 2009 16:01
>> *To:* Sittampalam, Ganesh
>> *Cc:* Dan Doel; Henning Thielemann; haskell-cafe at haskell.org
>>
>> *Subject:* Re: [Haskell-cafe] ANNOUNCE: pqueue-mtl, stateful-mtl
>>
>>   Overnight I had the following thought, which I think could work rather
>> well.  The most basic implementation of the idea is as follows:
>>
>> class MonadST s m | m -> s where
>> liftST :: ST s a -> m a
>>
>> instance MonadST s (ST s) where ...
>> instance MonadST s m => MonadST ...
>>
>> newtype FooT m e = FooT (StateT Foo m e)
>>
>> instance (Monad m, MonadST s m) => Monad (FooT m) where ...
>>
>> instance (Monad m, MonadST s m) => MonadBar (FooT m) where
>> <operations using an ST state>
>>
>> instance (Monad m, MonadST s m)  => MonadST s (FooT m) where ...
>>
>> The point here is that a MonadST instance guarantees that the bottom monad
>> is an ST -- and therefore single-threaded of necessity -- and grants any
>> ST-based monad transformers on top of it access to its single state thread.
>>
>> The more fully general approach to guaranteeing an underlying monad is
>> single-threaded would be to create a dummy state parameter version of each
>> single-threaded monad -- State, Writer, and Reader -- and add a typeclass
>> called MonadThreaded or something.
>>
>> The real question with this approach would be how to go about unwrapping
>> ST-based monad transformers in this fashion: I'm thinking that you would
>> essentially perform unwrapping of the outer monad using an ST computation
>> which gets lifted to the next-higher monad.  So, say, for example:
>>
>> newtype MonadST s m => ArrayT e m a = ArrayT {execArrayT :: StateT
>> (STArray s Int e) m a}
>>
>> runArrayT :: (Monad m, MonadST s m) => Int -> ArrayT e m a -> m a
>> runArrayT n m = liftST (newArray_ (0, n-1)) >>= evalStateT (execArrayT m)
>>
>> Key points:
>> - A MonadST s m instance should *always* imply that the bottom-level
>> monad is of type ST s, preferably a bottom level provided when defining a
>> monad by stacking transformers.  The fact that the bottom monad is in ST
>> should guarantee single-threaded, referentially transparent behavior.
>> - A non-transformer implementation of an ST-bound monad transformer would
>> simply involve setting the bottom monad to ST, rather than Identity as for
>> most monad transformers.
>> - Unwrapping an ST-bound monad transformer involves no universal
>> quantification on the state type.  After all transformers have been
>> unwrapped, it should be possible to invoke runST on the final ST s a.
>> - Both normal transformers and ST-bound transformers should propagate
>> MonadST.
>>
>> I'm going to go try implementing this idea in stateful-mtl now...
>>
>> Louis Wasserman
>> wasserman.louis at gmail.com
>>
>>
>> On Mon, Feb 16, 2009 at 3:07 AM, Sittampalam, Ganesh <
>> ganesh.sittampalam at credit-suisse.com> wrote:
>>
>>>  Well, I think a type system like Clean's that had linear/uniqueness
>>> types could "fix" the issue by actually checking that the state is
>>> single-threaded (and thus stop you from applying it to a "forking" monad).
>>> But there's a fundamental operational problem that ST makes destructive
>>> updates, so to support it as a monad transformer in general you'd need a
>>> type system that actually introduced fork operations (which "linear implicit
>>> parameters" used to do in GHC , but they were removed because they were
>>> quite complicated semantically and noone really used them).
>>>
>>>  ------------------------------
>>> *From:* haskell-cafe-bounces at haskell.org [mailto:
>>> haskell-cafe-bounces at haskell.org] *On Behalf Of *Louis Wasserman
>>> *Sent:* 16 February 2009 03:31
>>> *To:* Dan Doel
>>> *Cc:* Henning Thielemann; haskell-cafe at haskell.org
>>> *Subject:* Re: [Haskell-cafe] ANNOUNCE: pqueue-mtl, stateful-mtl
>>>
>>>   Okay, I tested it out and the arrow transformer has the same problem.
>>> I realized this after I sent the last message -- the point is that at any
>>> particular point, intuitively there should be exactly one copy of a State# s
>>> for each state thread, and it should never get duplicated; allowing other
>>> monads or arrows to hold a State# s in any form allows them to hold more
>>> than one, violating that goal.
>>>
>>> I'm not entirely convinced yet that there *isn't* some really gorgeous
>>> type system magic to fix this issue, like the type-system magic that
>>> motivates the type of runST in the first place, but that's not an argument
>>> that such magic exists...it's certainly an interesting topic to mull.
>>>
>>> Louis Wasserman
>>> wasserman.louis at gmail.com
>>>
>>>
>>> On Sun, Feb 15, 2009 at 9:20 PM, Dan Doel <dan.doel at gmail.com> wrote:
>>>
>>>> On Sunday 15 February 2009 9:44:42 pm Louis Wasserman wrote:
>>>> > Hello all,
>>>> >
>>>> > I just uploaded stateful-mtl and pqueue-mtl 1.0.1.  The ST monad
>>>> > transformer and array transformer have been removed -- I've convinced
>>>> > myself that a heap transformer backed by an ST array cannot be
>>>> > referentially transparent -- and the heap monad is now available only
>>>> as a
>>>> > basic monad and not a transformer, though it still provides priority
>>>> queue
>>>> > functionality to any of the mtl wrappers around it.  stateful-mtl
>>>> retains a
>>>> > MonadST typeclass which is implemented by ST and monad transformers
>>>> around
>>>> > it, allowing computations in the the ST-bound heap monad to perform ST
>>>> > operations in its thread.
>>>> >
>>>> > Since this discussion had largely led to the conclusion that ST can
>>>> only be
>>>> > used as a bottom-level monad, it would be pretty uncool if ST
>>>> computations
>>>> > couldn't be performed in a monad using ST internally because the ST
>>>> thread
>>>> > was hidden and there was no way to place ST computations 'under' the
>>>> outer
>>>> > monad.  Anyway, it's essentially just like the MonadIO typeclass,
>>>> except
>>>> > with a functional dependency on the state type.
>>>> >
>>>> > There was a question I asked that never got answered, and I'm still
>>>> > curious: would an ST *arrow* transformer be valid?  Arrows impose
>>>> > sequencing on their operations that monads don't...  I'm going to test
>>>> out
>>>> > some ideas, I think.
>>>>
>>>> Your proposed type:
>>>>
>>>>  State (Kleisli []) x y = (s, x) -> [(s, y)]
>>>>
>>>> is (roughly) isomorphic to:
>>>>
>>>>  x -> StateT s [] y = x -> s -> [(s, y)]
>>>>
>>>> The problem with an ST transformer is that the state parameter needs to
>>>> be
>>>> used linearly, because that's the only condition under which the
>>>> optimization
>>>> of mutable update is safe. ST ensures this by construction, as opposed
>>>> to
>>>> other languages (Clean) that have type systems that can express this
>>>> kind of
>>>> constraint directly. However, with STT, whether the state parameter is
>>>> used
>>>> linearly is a function of the wrapped monad. You'd have to give a more
>>>> fleshed
>>>> out version of your proposed state arrow transformer, but off the top of
>>>> my
>>>> head, I'm not sure it'd be any better.
>>>>
>>>> -- Dan
>>>>
>>>
>>>  ==============================================================================
>>> Please access the attached hyperlink for an important electronic communications disclaimer:
>>> http://www.credit-suisse.com/legal/en/disclaimer_email_ib.html
>>> ==============================================================================
>>>
>>>
>> ==============================================================================
>> Please access the attached hyperlink for an important electronic communications disclaimer:
>> http://www.credit-suisse.com/legal/en/disclaimer_email_ib.html
>> ==============================================================================
>>
>>
> ==============================================================================
> Please access the attached hyperlink for an important electronic communications disclaimer:
> http://www.credit-suisse.com/legal/en/disclaimer_email_ib.html
> ==============================================================================
>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/haskell-cafe/attachments/20090216/bd0c9724/attachment.htm


More information about the Haskell-Cafe mailing list