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@gmail.com


On Sun, Feb 15, 2009 at 6:15 PM, Ryan Ingram <ryani.spam@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@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@gmail.com
>
>
> On Sun, Feb 15, 2009 at 5:33 PM, Henning Thielemann
> <lemming@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@haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>
>