On Tue, 2010-02-09 at 16:41 +0000, John Lato wrote: > > See http://inmachina.net/~jwlato/haskell/ParsecIteratee.hs for a valid > Stream instance using iteratee. Also Gregory Collins recently posted > an iteratee wrapper for Attoparsec to haskell-cafe. To my knowledge > these are not yet in any packages, but hackage is vast.
Hmm. Am I correct that his implementation caches everything? I tried to rewrite the implementation using... well imperative linked list. For trivial benchmark it have large improvement (althought it may be due to error in test such as using ByteString) and, I believe, that it allows to free memory before finish. Results of test on Core 2 Duo 2.8 GHz: 10: 0.000455s 0.000181s 100: 0.000669s 0.001104s 1000: 0.005209s 0.023704s 10000: 0.053292s 1.423443s 100000: 0.508093s 132.208597s After I broke the running as it was taking too long. Is my implementation correct (when I try to write less trivial benchmark I probably find out but I hope for comment on the idea). Regards
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
import Control.Applicative
import Control.Concurrent.MVar
import Data.Maybe
import Control.Monad
import Control.Monad.ST
import Data.Iteratee
import Data.Iteratee.Base.StreamChunk (StreamChunk)
import Data.Iteratee.WrappedByteString
import Data.IORef
import qualified Data.ListLike as LL
import Data.STRef
import Data.Time
import Data.Word
import System.Mem.Weak
import Text.Parsec
import Text.Parsec.Pos
import ParsecIteratee
class Monad m => Reference r m where
newRef :: a -> m (r a)
readRef :: r a -> m a
writeRef :: r a -> a -> m ()
modifyRef :: r a -> (a -> m (a, b)) -> m b
modifyRef r f = readRef r >>= f >>= \(a, b) -> writeRef r a >> return b
instance Reference IORef IO where
newRef = newIORef
readRef = readIORef
writeRef = writeIORef
instance Reference (STRef s) (ST s) where
newRef = newSTRef
readRef = readSTRef
writeRef = writeSTRef
instance Reference MVar IO where
newRef = newMVar
readRef = readMVar
writeRef = putMVar
data (Monad m, Reference r m, StreamChunk c el) => NextCursor r m c el =
NextCursor (Cursor r m c el) | None | Uneval
data (Monad m, Reference r m, StreamChunk c el) => Cursor r m c el =
Cursor (r (NextCursor r m c el)) (c el)
mkCursor :: (Monad m, Reference r m, StreamChunk c el) => m (Cursor r m c el)
mkCursor = newRef Uneval >>= \r -> (return $! Cursor r LL.empty)
instance (Monad m, Reference r m, StreamChunk c el) =>
Stream (Cursor r m c el) (IterateeG c el m) el where
uncons = unconsStream
unconsStream :: (Monad m, Reference r m, StreamChunk c el)
=> Cursor r m c el
-> IterateeG c el m (Maybe (el, Cursor r m c el))
unconsStream p@(Cursor r c)
| LL.null c = IterateeG $ \st -> join $ modifyRef r $ unconsCursor st p
| otherwise = return $! justUnconsCursor p
unconsCursor :: forall r m c el. (Monad m, Reference r m, StreamChunk c el)
=> StreamG c el
-> Cursor r m c el
-> NextCursor r m c el
-> m (NextCursor r m c el,
m (IterGV c el m (Maybe (el, Cursor r m c el))))
unconsCursor st _ rv@(NextCursor p@(Cursor r c))
| LL.null c = return $! (rv, join $ modifyRef r $ unconsCursor st p)
| otherwise = return $! (rv, return $! Done (justUnconsCursor p) st)
unconsCursor st _ rv@(None)
= return $! (rv, return $! Done Nothing st)
unconsCursor st@(Chunk c) p rv@(Uneval)
| LL.null c = return $! (rv, return $! Cont (unconsStream p) Nothing)
| otherwise = do r <- newRef Uneval :: m (r (NextCursor r m c el))
let p' = Cursor r c
ra = Done (justUnconsCursor p') (Chunk LL.empty)
return $! (NextCursor p', return $! ra)
unconsCursor st@(EOF Nothing) _ rv@(Uneval)
= return $! (None, return $! Done Nothing st)
unconsCursor st@(EOF (Just e)) _ rv@(Uneval)
= return $! (rv, return $! Cont (throwErr e) (Just e))
justUnconsCursor :: (Monad m, Reference r m, StreamChunk c el) =>
Cursor r m c el -> Maybe (el, Cursor r m c el)
justUnconsCursor (Cursor r c) = Just $! (LL.head c, Cursor r $ LL.tail c)
benchmarkParser :: (Stream s m Char) => Int -> ParsecT s () m ()
benchmarkParser i | i < 5 = try $ sequence_ $ replicate i $ char '\0'
| i >= 5 = (try $ sequence_ $ replicate 5 $ char '\0') >>
benchmarkParser (i - 5)
mkBenchmark :: Int -> IO (NominalDiffTime, NominalDiffTime)
mkBenchmark i = do start <- getCurrentTime
c <- mkCursor :: IO (Cursor IORef IO WrappedByteString Char)
let bp :: ParsecT (Cursor IORef IO WrappedByteString Char)
()
(IterateeG WrappedByteString Char IO)
()
bp = benchmarkParser i
bn = runParserT bp () "/dev/zero" c
fileDriver bn "/dev/zero"
end <- getCurrentTime
let diff = end `diffUTCTime` start
start <- getCurrentTime
let bp :: ParsecT Int
()
(IterateeG WrappedByteString Char IO)
()
bp = benchmarkParser i
bn = parsecIteratee bp () "/dev/zero"
fileDriver bn "/dev/zero"
end <- getCurrentTime
return $! (diff, end `diffUTCTime` start)
main = forM_ (map (10^) [1..10]) $ \i -> do
(t, t') <- mkBenchmark i
putStrLn $ show i ++ ":\t" ++ show t ++ "\t" ++ show t'
signature.asc
Description: This is a digitally signed message part
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
