Реализация Data.STM.LinkedList

В первом приближении Haskell является достаточно выразительным языком, поэтому любой алгоритм, реализованный на другом языке общего назначения, также может быть реализован в Haskell с сохранением асимптотических характеристик производительности. (Это довольно низкая планка. Большинство языков общего назначения настолько выразительны.)

В частности, хотя Haskell наиболее естественно поддерживает неизменяемые структуры данных, он имеет достаточную поддержку изменяемых данных, причем изменяемые структуры данных и их алгоритмы обычно могут быть напрямую переведены в код Haskell. Могут быть некоторые накладные расходы (часто значительные накладные расходы), а изменяемые структуры данных могут быть значительно более неудобными в использовании, чем их неизменные собратья, но это все же возможно.

Однако с практической точки зрения сопоставление фактической (в отличие от асимптотической) производительности C ++ реализации изменяемой структуры данных может оказаться чрезвычайно трудным, если не невозможным. Может быть разумным получить в 2-3 раза производительность выше, чем у C ++, а в 5-10 раз довольно легко (см. Ниже). Однако, если вам нужно соответствовать производительности C ++, вам, вероятно, будет лучше написать высокопроизводительный изменяющий код на C ++ и использовать FFI (интерфейс внешней функции) для взаимодействия с этим кодом.

В любом случае, двусвязный список с «умеренной производительностью» с O (1) length, безусловно, возможен, и нет никаких фундаментальных трудностей с поддержанием изменяемых метаданных для всего списка. Причина, по которой stm-linkedlist не предоставляет O (1) length, вероятно, та же самая причина, по которой C ++ гарантировал только производительность O (n) std::list<>::size до C ++ 11. А именно, многие практические применения двусвязных списков никогда не требуют вызова _5 _ / _ 6_, а обеспечение производительности O (1) требует дополнительных затрат на ведение бухгалтерского учета.

В качестве доказательства концепции следующих типов данных достаточно для реализации полностью изменяемого двусвязного списка с функцией длины O (1). Здесь типы и идентификаторы, оканчивающиеся подчеркиванием, предназначены только для внутреннего использования. Список строг по своим указателям (так что никаких бесконечных списков!), Но ленив по своим значениям.

data List a = List
  { headNode_ :: !(IORef (Node_ a))
  , length_ :: !(IORef Int) }
data Node_ a = Node_
  { prev_ :: !(IORef (Node_ a))
  , next_ :: !(IORef (Node_ a))
  , value_ :: a }

Тип List содержит указатель (т.е. IORef) на неполный headNode, который указывает на начало и конец списка (или на себя для пустого списка), но имеет поле неопределенного значения. Это делает это значение узла небезопасным, поэтому оно никогда не должно быть напрямую доступно конечному пользователю. List также содержит указатель на значение длины списка.

Дополнительный тип Node (без подчеркивания) используется для украшения указателя узла его соответствующим списком (например, «итератор» из комментариев), чтобы сделать метаданные списка доступными для функций, которым они нужны:

data Node a = Node
  { node_ :: !(IORef (Node_ a))
  , list_ :: !(List a) }

Обратите внимание, что List и Node - это типы данных, ориентированные на пользователя для работы со списками.

Вы создаете empty список следующим образом:

empty :: IO (List a)
empty = mdo
  n <- newIORef (Node_ n n undefined)
  List n <$> newIORef 0

Вставка до и после данного узла работает следующим образом. Здесь небезопасное представление головного узла окупается, поскольку алгоритм может рассматривать вставку в начале и в конце списка как особые случаи вставки между головным узлом и фактическим узлом списка.

insertBefore :: a -> Node a -> IO (Node a)
insertBefore x Node{node_=rnode2, list_} = do
  Node_{prev_=rnode1} <- readIORef rnode2
  insertBetween_ x list_ rnode1 rnode2

insertAfter :: a -> Node a -> IO (Node a)
insertAfter x Node{node_=rnode1, list_} = do
  Node_{next_=rnode2} <- readIORef rnode1
  insertBetween_ x list_ rnode1 rnode2

insertBetween_ :: a -> List a -> IORef (Node_ a) -> IORef (Node_ a) -> IO (Node a)
insertBetween_ x l rnode1 rnode2 = do
  modifyIORef' (length_ l) succ
  newnode <- newIORef (Node_ rnode1 rnode2 x)
  modifyIORef' rnode1 (\n -> n{next_=newnode})
  modifyIORef' rnode2 (\n -> n{prev_=newnode})
  return $ Node newnode l

Поскольку пользователю не разрешено «иметь» головной узел, нам нужны дополнительные функции, ориентированные на пользователя, для вставки в начало и конец списка:

prepend :: a -> List a -> IO (Node a)
prepend x l = insertAfter x (Node (headNode_ l) l)

append :: a -> List a -> IO (Node a)
append x l = insertBefore x (Node (headNode_ l) l)

Обратите внимание, что все вставки проходят через insertBetween_, который отвечает за увеличение значения длины.

Удаление выполняется просто и единообразно, независимо от того, является ли это внутренним узлом или узлом в начале или в конце. Все удаления проходят через эту delete функцию, которая отвечает за уменьшение значения длины.

delete :: Node a -> IO ()
delete Node{node_,list_} = do
  modifyIORef' (length_ list_) pred
  Node_{next_, prev_} <- readIORef node_
  modifyIORef' prev_ (\n -> n{next_=next_})
  modifyIORef' next_ (\n -> n{prev_=prev_})

Удаление головного узла было бы катастрофой, но пользователям не разрешается иметь такой Node, так что мы в безопасности.

Если у пользователя есть Node, он может перемещаться вперед и назад по списку:

prev :: Node a -> IO (Maybe (Node a))
prev Node{node_, list_} = do
  Node_{prev_} <- readIORef node_
  return $ maybeNode_ prev_ list_

next :: Node a -> IO (Maybe (Node a))
next Node{node_, list_} = do
  Node_{next_} <- readIORef node_
  return $ maybeNode_ next_ list_

maybeNode_ :: IORef (Node_ a) -> List a -> Maybe (Node a)
maybeNode_ n l =
  if n == headNode_ l
  then Nothing
  else Just (Node n l)

Обратите внимание, что мы должны позаботиться о том, чтобы никогда не передавать пользователю головной узел, поэтому maybeNode_ здесь проверяет его и вместо этого возвращает Nothing.

Для начала пользователь может получить начало или конец List, используя следующие функции (которые используют prev или next на запрещенном головном узле):

start :: List a -> IO (Maybe (Node a))
start l = next $ Node (headNode_ l) l

end :: List a -> IO (Maybe (Node a))
end l = prev $ Node (headNode_ l) l

Не хватает только нескольких различных функций запросов:

value :: Node a -> IO a
value = fmap value_ . readIORef . node_

null :: List a -> IO Bool
null l = (==0) <$> length l

length :: List a -> IO Int
length = readIORef . length_

некоторые утилиты для преобразования в простые списки:

toList :: List a -> IO [a]
toList = toList_ next_

toListRev :: List a -> IO [a]
toListRev = toList_ prev_

toList_ :: (Node_ a -> IORef (Node_ a)) -> List a -> IO [a]
toList_ dir l = go =<< readIORef h
  where h = headNode_ l
        go n = do
          if dir n == h then return []
            else do
            n' <- readIORef (dir n)
            (value_ n':) <$> go n'

и экземпляр Show для отладки:

instance (Show a) => Show (List a) where
  showsPrec d lst = showParen (d > 10) $ showString "fromList " . showsPrec 11 (unsafePerformIO $ toList lst)

ПРЕДУПРЕЖДЕНИЕ: этот Show экземпляр небезопасен, если список изменен до того, как сгенерированная строка будет полностью оценена, поэтому его следует использовать только для отладки (и, вероятно, удалить из производственной версии).

Кроме того, хотя это не является строго необходимым, поскольку мы можем удалять и повторно вставлять, ни одна уважающая себя изменяемая структура не будет полной без модификации элементов на месте:

modify :: (a -> a) -> Node a -> IO ()
modify f Node{node_} = modifyIORef' node_ (\n -> n { value_ = f (value_ n) })

Вот полный код. (См. Определение ex1 для примера использования.) Вы можете использовать его в качестве отправной точки для вашей собственной реализации. Он не тестировался и не тестировался, за исключением того, что пара быстрых тестов показывает, что он, вероятно, примерно в 5-10 раз медленнее, чем реализация на C ++.

{-# LANGUAGE NamedFieldPuns, RecursiveDo #-}

module LinkedList
  ( List, Node
  , value, null, length
  , empty, prepend, append, insertBefore, insertAfter, delete, modify
  , prev, next, start, end
  , toList, toListRev
  ) where

import System.IO.Unsafe
import Control.Monad
import Prelude hiding (null, length)

import Data.IORef

data List a = List
  { headNode_ :: !(IORef (Node_ a))
  , length_ :: !(IORef Int) }
data Node a = Node
  { node_ :: !(IORef (Node_ a))
  , list_ :: !(List a) }
data Node_ a = Node_
  { prev_ :: !(IORef (Node_ a))
  , next_ :: !(IORef (Node_ a))
  , value_ :: a }

-- unsafe show instance: remove from production version
instance (Show a) => Show (List a) where
  showsPrec d lst = showParen (d > 10) $ showString "fromList " . showsPrec 11 (unsafePerformIO $ toList lst)

value :: Node a -> IO a
value = fmap value_ . readIORef . node_

null :: List a -> IO Bool
null l = (==0) <$> length l

length :: List a -> IO Int
length = readIORef . length_

empty :: IO (List a)
empty = mdo
  n <- newIORef (Node_ n n undefined)
  List n <$> newIORef 0

prepend :: a -> List a -> IO (Node a)
prepend x l = insertAfter x (Node (headNode_ l) l)

append :: a -> List a -> IO (Node a)
append x l = insertBefore x (Node (headNode_ l) l)

insertBefore :: a -> Node a -> IO (Node a)
insertBefore x Node{node_=rnode2, list_} = do
  Node_{prev_=rnode1} <- readIORef rnode2
  insertBetween_ x list_ rnode1 rnode2

insertAfter :: a -> Node a -> IO (Node a)
insertAfter x Node{node_=rnode1, list_} = do
  Node_{next_=rnode2} <- readIORef rnode1
  insertBetween_ x list_ rnode1 rnode2

insertBetween_ :: a -> List a -> IORef (Node_ a) -> IORef (Node_ a) -> IO (Node a)
insertBetween_ x l rnode1 rnode2 = do
  modifyIORef' (length_ l) succ
  newnode <- newIORef (Node_ rnode1 rnode2 x)
  modifyIORef' rnode1 (\n -> n{next_=newnode})
  modifyIORef' rnode2 (\n -> n{prev_=newnode})
  return $ Node newnode l

delete :: Node a -> IO ()
delete Node{node_,list_} = do
  modifyIORef' (length_ list_) pred
  Node_{next_, prev_} <- readIORef node_
  modifyIORef' prev_ (\n -> n{next_=next_})
  modifyIORef' next_ (\n -> n{prev_=prev_})

modify :: (a -> a) -> Node a -> IO ()
modify f Node{node_} = modifyIORef' node_ (\n -> n { value_ = f (value_ n) })

prev :: Node a -> IO (Maybe (Node a))
prev Node{node_, list_} = do
  Node_{prev_} <- readIORef node_
  return $ maybeNode_ prev_ list_

next :: Node a -> IO (Maybe (Node a))
next Node{node_, list_} = do
  Node_{next_} <- readIORef node_
  return $ maybeNode_ next_ list_

maybeNode_ :: IORef (Node_ a) -> List a -> Maybe (Node a)
maybeNode_ n l =
  if n == headNode_ l
  then Nothing
  else Just (Node n l)

start :: List a -> IO (Maybe (Node a))
start l = next $ Node (headNode_ l) l

end :: List a -> IO (Maybe (Node a))
end l = prev $ Node (headNode_ l) l

toList :: List a -> IO [a]
toList = toList_ next_

toListRev :: List a -> IO [a]
toListRev = toList_ prev_

toList_ :: (Node_ a -> IORef (Node_ a)) -> List a -> IO [a]
toList_ dir l = go =<< readIORef h
  where h = headNode_ l
        go n = do
          if dir n == h then return []
            else do
            n' <- readIORef (dir n)
            (value_ n':) <$> go n'

ex1 :: IO (List Int)
ex1 = do
  t <- empty
  mapM_ (flip prepend t) [10,9..1]
  mapM_ (flip append t) [11..20]
  return t