Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/6f1a4327263385d8056d7cf754ee357d2b14c24b >--------------------------------------------------------------- commit 6f1a4327263385d8056d7cf754ee357d2b14c24b Author: Simon Marlow <marlo...@gmail.com> Date: Tue Apr 10 16:31:13 2012 +0100 fix quadratic performance issue with long module names (#5981) >--------------------------------------------------------------- compiler/main/HeaderInfo.hs | 26 +++++++++++++++----------- 1 files changed, 15 insertions(+), 11 deletions(-) diff --git a/compiler/main/HeaderInfo.hs b/compiler/main/HeaderInfo.hs index 6322024..6ea12e5 100644 --- a/compiler/main/HeaderInfo.hs +++ b/compiler/main/HeaderInfo.hs @@ -160,12 +160,12 @@ blockSize = 1024 lazyGetToks :: DynFlags -> FilePath -> Handle -> IO [Located Token] lazyGetToks dflags filename handle = do buf <- hGetStringBufferBlock handle blockSize - unsafeInterleaveIO $ lazyLexBuf handle (pragState dflags buf loc) False + unsafeInterleaveIO $ lazyLexBuf handle (pragState dflags buf loc) False blockSize where loc = mkRealSrcLoc (mkFastString filename) 1 1 - lazyLexBuf :: Handle -> PState -> Bool -> IO [Located Token] - lazyLexBuf handle state eof = do + lazyLexBuf :: Handle -> PState -> Bool -> Int -> IO [Located Token] + lazyLexBuf handle state eof size = do case unP (lexer return) state of POk state' t -> do -- pprTrace "lazyLexBuf" (text (show (buffer state'))) (return ()) @@ -173,22 +173,26 @@ lazyGetToks dflags filename handle = do -- if this token reached the end of the buffer, and we haven't -- necessarily read up to the end of the file, then the token might -- be truncated, so read some more of the file and lex it again. - then getMore handle state + then getMore handle state size else case t of L _ ITeof -> return [t] - _other -> do rest <- lazyLexBuf handle state' eof + _other -> do rest <- lazyLexBuf handle state' eof size return (t : rest) - _ | not eof -> getMore handle state + _ | not eof -> getMore handle state size | otherwise -> return [L (RealSrcSpan (last_loc state)) ITeof] -- parser assumes an ITeof sentinel at the end - getMore :: Handle -> PState -> IO [Located Token] - getMore handle state = do + getMore :: Handle -> PState -> Int -> IO [Located Token] + getMore handle state size = do -- pprTrace "getMore" (text (show (buffer state))) (return ()) - nextbuf <- hGetStringBufferBlock handle blockSize - if (len nextbuf == 0) then lazyLexBuf handle state True else do + let new_size = size * 2 + -- double the buffer size each time we read a new block. This + -- counteracts the quadratic slowdown we otherwise get for very + -- large module names (#5981) + nextbuf <- hGetStringBufferBlock handle new_size + if (len nextbuf == 0) then lazyLexBuf handle state True new_size else do newbuf <- appendStringBuffers (buffer state) nextbuf - unsafeInterleaveIO $ lazyLexBuf handle state{buffer=newbuf} False + unsafeInterleaveIO $ lazyLexBuf handle state{buffer=newbuf} False new_size getToks :: DynFlags -> FilePath -> StringBuffer -> [Located Token] _______________________________________________ Cvs-ghc mailing list Cvs-ghc@haskell.org http://www.haskell.org/mailman/listinfo/cvs-ghc
