Typesafe MRef with a regular monad

oleg@pobox.com oleg@pobox.com
Wed, 4 Jun 2003 13:05:48 -0700 (PDT)


It seems it is possible to implement polymorphic references using the
regular (not IO and not ST) monad and without resorting to any unsafe
extension. Furthermore, that monad has a run function, which does not
compromise the type safety.

When I claimed in the previous message that the polytypic nature of
the heap precludes its encapsulation in a monad, I was fortunately
mistaken. I was confused: I thought that a function signature a->a
meant that the type of the argument must be identical to the type of
the result. That is clearly not true: the type of the argument should
merely be specializable to the type of the result. If we pre-allocate
a heap with, say, 5 cells of the undefined value, we can store values
of any type in these cells. Of course, after we wrote something in a
cell, we can overwrite it with the value of the same or a more
specialized type. Therefore, we can seek the fixpoint heap without
offending the typechecker. This gives us a desired monad.


[Continuing the code from the original message]
A pre-allocated heap of 5 cells:

> t1 = tag_one
> t2 = (tinc t1)
> t3 = (tinc t2)
> t4 = (tinc t3)
> t5 = (tinc t4)
> heap5 = Cons t5 undefined $ Cons t4 undefined $ Cons t3 undefined $
>         Cons t2 undefined $ Cons t1 undefined $ Nil
	

A Heap monad:

> newtype HeapM h a = HeapM (h->(a,h))
>
> instance Monad (HeapM h) where
>    return x     = HeapM $ \h -> (x, h)
>    HeapM  m >>= f = HeapM $ \h -> let (x, h') = m h; HeapM m' = f x in m' h'


The argument of hget and hput functions below must be a heap of 5
cells, with arbitrary values. heap5 is the most general heap of that
sort

> hget tag = HeapM $ \(h::t) -> (fetch (HeapRef tag undefined) h,h)
> 	where x::t = heap5
>	      
> hput tag newval = HeapM $ 
> 	\(h::t) -> ((),alter (HeapRef tag undefined) newval h)
>   where x::t = heap5

We can run our monad:

> runHOF (HeapM hf) = fst $ hf heap5

The test. We test storing and altering polymorphic values, including
polymorphic functional values!

> test7 = do
>      let l1 = tag_one 
>      hput l1 'a'
>      v1 <- hget l1
>
>      let l2 = tinc l1  -- our allocator is somewhat primitive at the moment
>      hput l2 Nothing   -- storing a polymorphic value of type Maybe a
>      v2 <- hget l2
>
>      let l3 = tinc l2
>      hput l3 (\x->x+1)  -- storing a polymorphic function over Num a
>      v3 <- hget l3
>
>      -- Update the cells and retrieve the updated values
>      hput l1 'b'
>      v11 <- hget l1
>      hput l2 $ Just True -- overwrite with a more specialized value
>      v21 <- hget l2
>      hput l3 (\x->x+5)
>      v31 <- hget l3
>      return $ [[show v1,  show v2,  show $ v3 1], 
>                [show v11, show v21, show $ v31 1]]
	       
The result is

*Main> runHOF test7
[["'a'","Nothing","2"],["'b'","Just True","6"]]


Ashley Yakeley wrote:
] ] Is it possible to actually implement a working instance of RefMonad in 
] ] Haskell, without making use of a built-in monad like IO or ST?  

] You certainly wouldn't be able to do this for any monad M which had:

]   performM :: forall a. M a -> a;

] ...because it wouldn't be type-safe: you'd be able to construct coerce 
] :: a -> b just as you can with unsafePerformIO.
 
Fortunately, that doesn't seem to be the case.  Here's an example that is
roughly  equivalent to the unsafe example in the documentation for
unsafePerformIO. Note that t1 is equivalent to readIORef [a] (actually,
t1  points out to a reference cell Ref a, which can accept values of
any type whatsoever).


--> test9 = do
-->      hput t1 []
-->      hput t1 [42]
-->      bang <- hget t1
-->      return $ (bang ::[Char])

If we uncomment the above code, we get a compiler error:

/tmp/o1.lhs:327:
    No instance for (Num Char)
    arising from the literal `42' at /tmp/o1.lhs:327
    In the list element: 42
    In the second argument of `hput', namely `[42]'


A nicer implementation of newRef (an allocator) is left for the future
work. I think that the pre-allocation trick makes it possible.

The pre-allocation scheme isn't such a limitation: clearly we can not
invoke newSTRef or newIORef arbitrary number of times (while keeping
the references). Sooner or later something unpleasant happens. We can
think therefore of newSTRef as indexing in a some pre-allocated array.
With the template Haskell, we can easily pre-allocate a heap of 640K
cells, and that should be enough for everybody.