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

Louis Wasserman wasserman.louis at gmail.com
Mon Feb 16 11:17:19 EST 2009


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
> ==============================================================================
>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/haskell-cafe/attachments/20090216/4ddfeac9/attachment.htm


More information about the Haskell-Cafe mailing list