freezing haskell STrefs - haskell

Question

I would like to implement a Doubly Connected Edge List data structure for use in Haskell. This data structure is used to manage the topology of an arrangement of lines in a plane, and contains structures for faces, edges, and vertices.
It seems to me like a good interface to this data structure would be as a type Arrangement, with functions like
overlay :: Arrangement -> Arrangement -> Arrangement
but the usual implementation relies heavily on references (for example each face has references to the adjacent edges).
It seems to me that the ideal way for this to work would be similar to the way mutable and immutable arrays do: the internals of the Arrangement data structure are implemented as functional data structures, but the operations that mutate arrangements "unfreeze" them to create new mutable instances within a monad (ideally using COW magic to make things efficient).
So my questions are:
(1) is there a way to freeze and unfreeze a small heap like there is for arrays?
(2) if not, is there a better approach?

Answer 1

This might be what you are looking for. Loops should work fine. A simple example involving a loop appears first.
data List a t = Nil | Cons a t deriving (Show, Functor, Foldable, Traversable)
runTerm $ do
x <- newVar Nil
writeVar x (Cons 'a' (Var x)))
return $ Var x
And now, the code.
{-# LANGUAGE
Rank2Types
, StandaloneDeriving
, UndecidableInstances #-}
module Freeze
( Term (..)
, Fix (..)
, runTerm
, freeze
, thaw
, Var
, newVar
, writeVar
, readVar
, modifyVar
, modifyVar'
) where
import Control.Applicative
import Control.Monad.Fix
import Control.Monad.Trans.Class
import Control.Monad.Trans.Reader
import Control.Monad.ST
import Data.STRef
import Data.Traversable (Traversable, traverse)
data Term s f
= Var {-# UNPACK #-} !(Var s f)
| Val !(f (Term s f))
newtype Fix f = Fix { getFix :: f (Fix f) }
deriving instance Show (f (Fix f)) => Show (Fix f)
runTerm :: Traversable f => (forall s . ST s (Term s f)) -> Fix f
runTerm m = runST $ m >>= freeze
freeze :: Traversable f => Term s f -> ST s (Fix f)
freeze t = do
xs <- newSTRef Nil
f <- runReaderT (loop t) xs
readSTRef xs >>= mapM_' modifyToOnly
return f
where
loop (Val f) = Fix <$> traverse loop f
loop (Var (STRef ref)) = do
a <- lift $ readSTRef ref
case a of
Both _ f' ->
return f'
Only f -> mfix $ \ f' -> do
lift $ writeSTRef ref $! Both f f'
ask >>= lift . flip modifySTRef' (ref :|)
Fix <$> traverse loop f
thaw :: Traversable f => Fix f -> ST s (Term s f)
thaw = return . loop
where
loop = Val . fmap loop . getFix
newtype Var s f = STRef (STRef s (Many s f))
newVar :: f (Term s f) -> ST s (Var s f)
newVar = fmap STRef . newSTRef . Only
readVar :: Var s f -> ST s (f (Term s f))
readVar (STRef ref) = fst' <$> readSTRef ref
writeVar :: Var s f -> f (Term s f) -> ST s ()
writeVar (STRef ref) a = writeSTRef ref $! Only a
modifyVar :: Var s f -> (f (Term s f) -> f (Term s f)) -> ST s ()
modifyVar (STRef ref) f = modifySTRef' ref (Only . f . fst')
modifyVar' :: Var s f -> (f (Term s f) -> f (Term s f)) -> ST s ()
modifyVar' (STRef ref) f = modifySTRef' ref (\ a -> Only $! f (fst' a))
data Many s f
= Only (f (Term s f))
| Both (f (Term s f)) (Fix f)
fst' :: Many s f -> f (Term s f)
fst' (Only a) = a
fst' (Both a _) = a
modifyToOnly :: STRef s (Many s f) -> ST s ()
modifyToOnly ref = do
a <- readSTRef ref
case a of
Only _ -> return ()
Both f _ -> writeSTRef ref $! Only f
data List s a = Nil | {-# UNPACK #-} !(STRef s a) :| !(List s a)
mapM_' :: Monad m => (STRef s a -> m b) -> List s a -> m ()
mapM_' _ Nil = return ()
mapM_' k (x :| xs) = k x >> mapM_' k xs

Answer 2

Not that the safe versions of freeze and thaw make complete copies of the array, so aren't necessarily that efficient. Of course, making a complete copy of an array of refs is arguably an optimization over making a complete copy of a structure through walking it and recursively pulling things ou of MVars, etc.
Another approach to take would be something similar to that of Repa -- represent operations over your structure algebraically, and write a run function that optimizes, fuses, and then executes all in one pass. Arguably this is a more functional design. (You can use unsafe operations under the covers even, to make reification happen on-demand rather than explicitly).