freek haskell STrefs

Question

하스켈에서 사용할 이중 연결 에지 목록 데이터 구조를 구현하고 싶습니다. 이 데이터 구조는 평면에서 선 배열의 토폴로지를 관리하는 데 사용되며면, 모서리 및 정점에 대한 구조를 포함합니다. 그것은이 데이터 구조에 좋은 인터페이스와 같은 날 것으로 보인다

는

overlay :: Arrangement -> Arrangement -> Arrangement 

같은 기능, 유형 Arrangement으로 될하지만 일반적인 구현은 각면은 참조가 있습니다 (예를 들어, 참조에 크게 의존 인접한 가장자리).

이 작업을위한 이상적인 방법은 변경 가능하고 변경 불가능한 배열과 비슷합니다. Arrangement 데이터 구조의 내부는 기능적 데이터 구조로 구현되지만 배열을 변경하는 작업은 "고정 해제 "그들은 모나드 내에서 새로운 가변 인스턴스를 생성합니다 (이상적으로는 COW 마술을 사용하여 효율적으로 작업 할 수 있습니다).

그래서 제 질문은 다음과 같습니다

(1) 동결 및 배열에 대한이 같은 작은 힙을 고정을 해제하는 방법이 있나요? (2) 그렇지 않은 경우 더 좋은 방법이 있습니까?

Answer 1

freeze 및 thaw의 안전 버전이 어레이의 전체 사본을 만들지는 않으므로 그렇게 효율적일 필요는 없습니다. 물론, 여러 개의 참조를 완전하게 복사하는 것은 논란의 여지가 있지만, 그것을 걷고 재귀 적으로 MVar 등을 가져 와서 구조의 완전한 복사본을 만드는 것 이상의 최적화라고 할 수 있습니다.

취할 수있는 또 다른 접근 방식은 비슷한 것입니다 Repa의 숫자로 - 대수적으로 구조에 대한 연산을 나타내며 run 함수를 작성하여 최적화, 통합 한 다음 모두를 한 번에 실행합니다. 아마 이것이 더 기능적인 디자인 일 것입니다. (심지어는 안전하지 않은 작업을 표지로 사용하여 명시 적으로가 아닌 필요에 따라 구체화를 수행 할 수 있습니다.

Answer 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