[Haskell-cafe] ANNOUNCE: pqueue-mtl, stateful-mtl
Louis Wasserman
wasserman.louis at gmail.com
Sun Feb 15 19:45:16 EST 2009
The module I put together already has everything I'd need to do it in terms
of an IntMap with much less work than that -- the generic MonadArray type
class has implementations both in terms of ST and in terms of an IntMap
already. Only three changes in the Heap implementation would be needed: two
changes from runArrayT_ 16 to evalIntMapT, and one change of ArrayT to
IntMapT. (Here ArrayT is backed by an STT transformer.)
newtype HeapT e m a = HeapT {execHeapT :: ArrayT e (StateT Int m) a}
deriving (Monad, MonadReader r, MonadST s, MonadWriter w, MonadFix, MonadIO)
-- | Runs an 'HeapT' transformer starting with an empty heap.
runHeapT :: (Monad m, Ord e) => HeapT e m a -> m a
runHeapT m = evalStateT (runArrayT_ 16 (execHeapT m)) 0
But I'm still not entirely convinced that the original STT monad with all
its illegal behavior, hidden from the user, couldn't be used internally by
HeapT without exposing non-referential-transparency -- I'm still thinking on
that problem. (Perhaps it'd be useful to ask, how would this purely
functional implementation of HeapT behave when used as a drop-in replacement
for the STT-backed HeapT?)
Originally I said that I was inferring that the problem with an ST
transformer was that it allowed access to mutable references. If that's
true, can a priority queue be used to simulate an STRef? If so, wouldn't
that imply (rather elegantly, in fact) that an STT-backed heap transformer
would violate referential transparency. (Would the single-threaded array
transformer backing HeapT fail in that fashion as well?)
Louis Wasserman
wasserman.louis at gmail.com
On Sun, Feb 15, 2009 at 6:15 PM, Ryan Ingram <ryani.spam at gmail.com> wrote:
> You can roll your own pure STT monad, at the cost of performance:
>
> -- Do not export any of these constructors, just the types STT and STTRef.
> data W = forall a. W !a
> data Heap s = Heap !Int !(IntMap W)
> newtype STT s m a = STT (StateT (Heap s) m a) deriving (Monad,
> MonadTrans, MonadIO, insert other stuff here, but not MonadState)
> newtype STTRef s a = Ref Int
>
> liftState :: (MonadState s m) => (s -> (a,s)) -> m a
> liftState f = do
> (a, s') <- liftM f get
> put s'
> return a
>
> newSTTRef :: forall s m a. a -> STT s m a
> newSTTRef a = STT $ liftState go where
> go (Heap sz m) = (Ref sz, Heap (sz+1) (insert sz (W a) m)
>
> readSTTRef :: forall s m a. STTRef s a -> STT s m a
> readSTTRef (Ref n) = STT $ liftM go get where
> go (Heap _ m) = case lookup n m of
> Just (~(W a)) -> unsafeCoerce a
> _ -> error "impossible: map lookup failed."
>
> writeSTTRef :: forall s m a. STTRef s a -> a -> STT s m ()
> writeSTTRef (Ref n) a = STT $ modify go where
> go (Heap sz m) = Heap sz (insert n (W a) m)
>
> -- forall s. here makes unsafeCoerce in readSTTRef safe. Otherwise
> references could escape and break unsafeCoerce.
> runSTT :: (forall s. STT s m a) -> m a
> runSTT (STT m) = evalStateT m (Heap 0 empty)
>
> instance (MonadState s m) => MonadState s (STT st m) where
> get = lift get
> put = lift . put
> modify = lift . modify
>
> Unfortunately, you lose garbage collection on referenced data since
> it's all stored in an IntMap. Is there a way to solve this problem,
> perhaps using some form of weak reference? Ideally you'd like to be
> able to find that all references to a particular Ref have been GC'd so
> that you can reuse that Ref index. Otherwise eventually the IntMap
> will fill up if you keep allocating references and throwing them away.
>
> -- ryan
>
> 2009/2/15 Louis Wasserman <wasserman.louis at gmail.com>:
> > Well, it makes me sad, I guess. pqueue-mtl provides an array-backed heap
> > monad transformer that is supposed to keep its own ST thread, if only for
> > the sake of retaining a purely functional interface without any
> externally
> > visible forall'd types, which is perfectly fine in most cases, but I'd
> have
> > to think about whether or not it'd remain referentially transparent if
> the
> > ST thread were only visible to a very tightly encapsulated set of
> commands
> > (i.e. priority queue operations).
> >
> > Louis Wasserman
> > wasserman.louis at gmail.com
> >
> >
> > On Sun, Feb 15, 2009 at 5:33 PM, Henning Thielemann
> > <lemming at henning-thielemann.de> wrote:
> >>
> >> On Sun, 15 Feb 2009, Louis Wasserman wrote:
> >>
> >>> I follow. The primary issue, I'm sort of wildly inferring, is that use
> >>> of STT -- despite being
> >>> pretty much a State monad on the inside -- allows access to things like
> >>> mutable references?
> >>
> >> I assume that ST must always be the most inner monad, like IO. Is this a
> >> problem in an application?
> >
> > _______________________________________________
> > Haskell-Cafe mailing list
> > Haskell-Cafe at haskell.org
> > http://www.haskell.org/mailman/listinfo/haskell-cafe
> >
> >
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/haskell-cafe/attachments/20090215/828aa419/attachment.htm
More information about the Haskell-Cafe
mailing list