我想实现一个在 Haskell 中使用的双连接边列表数据结构。此数据结构用于管理平面中线排列的拓扑结构,并包含面、边和顶点的结构。
在我看来,这个数据结构的一个好的接口(interface)应该是类型 Arrangement
, 具有类似的功能
overlay :: Arrangement -> Arrangement -> Arrangement
但通常的实现很大程度上依赖于引用(例如,每个面都有对相邻边的引用)。
在我看来,理想的工作方式类似于可变和不可变数组的工作方式:
Arrangement
的内部结构数据结构被实现为函数式数据结构,但是改变排列的操作“解冻”它们以在 monad 中创建新的可变实例(理想情况下使用 COW 魔法来提高效率)。所以我的问题是:
(1) 有没有办法像数组一样卡住和解冻一个小堆?
(2)如果没有,有更好的方法吗?
最佳答案
这可能是您正在寻找的。循环应该可以正常工作。首先出现一个涉及循环的简单示例。
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
现在,代码。
{-# 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
关于haskell - 卡住haskell STrefs,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/13609933/