读取文件时限制内存使用

我是一个哈斯克尔初学者,认为这是一个很好的练习。我有一个 当我需要读取线程A中的文件时,处理文件行 在线程b_i中,然后将结果输出到线程c。

我已经实现了这一点,但其中一个要求是 无法信任整个文件是否适合内存。我希望那懒惰 IO和垃圾收集器可以为我这样做,但是遗憾的是内存使用率 不断上升。

读卡器线程(A)使用 readFile 然后拉上拉链 用线号和包装。然后写下这些压缩线 到 Control.Concurrent.Chan . 每个消费线程B都有自己的通道。

每个使用者在有数据时读取自己的通道,如果regex 匹配,输出到各自的输出通道包装 在“可能”(由列表组成)。

打印机检查每个B线程的输出通道。如果没有 结果(行)为空,打印行。从现在起 不应该引用旧的行,我认为垃圾 收集者可以释放这些线,但唉,我似乎在 这里错了。

.lhs文件在这里: http://gitorious.org/hajautettujen-sovellusten-muodostamistekniikat/hajautettujen-sovellusten-muodostamistekniikat/blobs/master/mgrep.lhs

所以问题是,如何限制内存使用,或者允许垃圾 收集器以拆下管路。

根据要求的代码段。希望缩进不会破坏得太严重:)

data Global = Global {done :: MVar Bool, consumers :: Consumers}
type Done = Bool
type Linenum = Int
type Line = (Linenum, Maybe String)
type Output = MVar [Line]
type Input = Chan Line
type Consumers = MVar (M.Map ThreadId (Done, (Input, Output)))
type State a = ReaderT Global IO a


producer :: [Input] -> FilePath -> State ()
producer c p = do
  liftIO $ Main.log "Starting producer"
  d <- asks done
  f <- liftIO $ readFile p
  mapM_ (\l -> mapM_
    (liftIO . flip writeChan l) c)
    $ zip [1..] $ map Just $ lines f
  liftIO $ modifyMVar_ d (return . not)

printer :: State ()
printer = do
  liftIO $ Main.log "Starting printer"
  c <- (fmap (map (snd . snd) . M.elems)
    (asks consumers >>= liftIO . readMVar))
  uniq' c
  where head' :: Output -> IO Line
    head' ch = fmap head (readMVar ch)

    tail' = mapM_ (liftIO . flip modifyMVar_
        (return . tail))

    cont ch = tail' ch >> uniq' ch

    printMsg ch = readMVar (head ch) >>=
        liftIO . putStrLn . fromJust . snd . head

    cempty :: [Output] -> IO Bool
    cempty ch = fmap (any id)
        (mapM (fmap ((==) 0 . length) . readMVar ) ch)

    {- Return false unless none are Nothing -}
    uniq :: [Output] -> IO Bool
    uniq ch = fmap (any id . map (isNothing . snd))
        (mapM (liftIO . head') ch)

    uniq' :: [Output] -> State ()
    uniq' ch = do
      d <- consumersDone
      e <- liftIO $ cempty ch
      if not e
        then  do
          u <- liftIO $ uniq ch
          if u then cont ch else do
        liftIO $ printMsg ch
        cont ch
          else unless d $ uniq' ch