Параллельное чтение и запись в IOArray в Haskell

Я начал писать параллельные программы на Haskell с GHC для многоядерных машин. В качестве первого шага я решил написать программу, которая одновременно читает и записывает в IOArray. У меня создалось впечатление, что чтение и запись в IOArray не требуют синхронизации. Я делаю это, чтобы установить базовый уровень для сравнения с производительностью других структур данных, которые действительно используют соответствующие механизмы синхронизации. Я пришел к некоторым удивительным результатам, а именно к тому, что во многих случаях я вообще не набирал скорость. Это заставляет меня задаться вопросом, происходит ли какая-то низкоуровневая синхронизация во время выполнения ghc, например синхронизация и блокировка при оценке преобразователей (то есть «черных дыр»). Вот подробности ...

Я пишу пару вариаций одной программы. Основная идея состоит в том, что я написал структуру данных DirectAddressTable, которая представляет собой просто оболочку вокруг IOArray, предоставляющую методы вставки и поиска:

-- file DirectAddressTable.hs
module DirectAddressTable 
       ( DAT
       , newDAT
       , lookupDAT
       , insertDAT
       , getAssocsDAT
       )
       where

import Data.Array.IO
import Data.Array.MArray

newtype DAT = DAT (IOArray Int Char)

-- create a fixed size array; missing keys have value '-'.
newDAT :: Int -> IO DAT
newDAT n = do a <- newArray (0, n - 1) '-'
              return (DAT a)

-- lookup an item.
lookupDAT :: DAT -> Int -> IO (Maybe Char)
lookupDAT (DAT a) i = do c <- readArray a i 
                         return (if c=='-' then Nothing else Just c)

-- insert an item
insertDAT :: DAT -> Int -> Char -> IO ()
insertDAT (DAT a) i v = writeArray a i v

-- get all associations (exclude missing items, i.e. those whose value is '-').
getAssocsDAT :: DAT -> IO [(Int,Char)]
getAssocsDAT (DAT a) = 
  do assocs <- getAssocs a
     return [ (k,c) | (k,c) <- assocs, c /= '-' ]

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

-- file DirectTableTest.hs
import DirectAddressTable
import Control.Concurrent
import Control.Parallel
import System.Environment

main = 
  do args <- getArgs
     let numThreads = read (args !! 0)
     vs <- sequence (replicate numThreads newEmptyMVar)
     a <- newDAT arraySize     
     sequence_ [ forkIO (doLotsOfStuff numThreads i a >>= putMVar v) 
               | (i,v) <- zip [1..] vs]
     sequence_ [ takeMVar v >>= \a -> getAssocsDAT a >>= \xs -> print (last xs)  
               | v <- vs]     

doLotsOfStuff :: Int -> Int -> DAT -> IO DAT
doLotsOfStuff numThreads i a = 
  do let p j c = (c `seq` insertDAT a j c) >> 
                 lookupDAT a j >>= \v -> 
                 v `pseq` return ()  
     sequence_ [ p j c | (j,c) <- bunchOfKeys i ]
     return a
  where  bunchOfKeys i = take numElems $ zip cyclicIndices $ drop i cyclicChars
         numElems      = numberOfElems `div` numThreads

cyclicIndices = cycle [0..highestIndex]
cyclicChars   = cycle chars
chars         = ['a'..'z']

-- Parameters
arraySize :: Int
arraySize     = 100
highestIndex  = arraySize - 1
numberOfElems = 10 * 1000 * 1000     

Я скомпилировал это с помощью ghc 7.2.1 (аналогичные результаты с 7.0.3) с помощью «ghc --make -rtsopts -threaded -fforce-Recomp -O2 DirectTableTest.hs». Время выполнения ./DirectTableTest 1 + RTS -N1 "занимает около 1,4 секунды, а время выполнения ./DirectTableTest 2 + RTS -N2" занимает около 2,0 секунд! Использование на одно ядро ​​больше, чем количество рабочих потоков, немного лучше: «time ./DirectTableTest 1 + RTS -N1» занимает около 1,4 секунды, а выполнение «time ./DirectTableTest 1 + RTS -N2» и «time ./DirectTableTest 2 + RTS» -N3 »и то и другое занимает около 1,4 секунды. Запуск с параметром «-N2 -s» показывает, что производительность составляет 95,4%, а GC - 4,3%. Глядя на запуск программы с ThreadScope, я не вижу ничего слишком тревожного. Каждый HEC срабатывает один раз в мс, когда происходит сборка мусора. Работа с 4 ядрами дает время около 1,2 секунды, что, по крайней мере, немного лучше, чем 1 ядро. Больше ядер не улучшается.

Я обнаружил, что изменение типа массива, используемого в реализации DirectAddressTable, с IOArray на IOUArray, решает эту проблему. С этим изменением время выполнения «time ./DirectTableTest 1 + RTS -N1» составляет около 1,4 секунды, тогда как время выполнения «time ./DirectTableTest 2 + RTS -N2» составляет около 1,0 секунды. Увеличение до 4 ядер дает время работы 0,55 секунды. Запуск с «-s» показывает, что время сборки мусора составляет% 3,9%. В ThreadScope я вижу, что оба потока уступают каждые 0,4 мс, чаще, чем в предыдущей программе.

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

Я понимаю, почему IOUArray может работать лучше, чем IOArray, но я не знаю, почему он лучше масштабируется для нескольких потоков и ядер. Кто-нибудь знает, почему это может происходить, или что я могу сделать, чтобы узнать, что происходит? Интересно, может ли эта проблема быть связана с блокировкой нескольких потоков при оценке одного и того же преобразователя и связано ли это с этим: http: //hackage.haskell.org / trac / ghc / ticket / 3838 .