Commits

Mario Blažević committed 9d07a01

Optimized take.

  • Participants
  • Parent commits 2e61460

Comments (0)

Files changed (4)

Data/Picoparsec/Monoid/Internal.hs

         then ks i a m (unI i)
         else T.runParser (demandInput >> go n) i a m kf ks
 
--- | If at least @n@ prime tokens of input are available, return the
--- current input, otherwise fail.
-ensure :: FactorialMonoid t => Int -> Parser t t
-ensure !n = T.Parser $ \i0 a0 m0 kf ks ->
-    if Factorial.length (unI i0) >= n
-    then ks i0 a0 m0 (unI i0)
-    -- The uncommon case is kept out-of-line to reduce code size:
-    else ensure' n i0 a0 m0 kf ks
--- Non-recursive so the bounds check can be inlined:
-{-# INLINE ensure #-}
-
 -- | If at least one token of input is available, return the current
 -- input, otherwise fail.
 ensureOne :: FactorialMonoid t => Parser t t
 -- | Consume @n@ tokens of input, but succeed only if the predicate
 -- returns 'True'.
 takeWith :: FactorialMonoid t => Int -> (t -> Bool) -> Parser t t
-takeWith n0 p = do
-  let n = max n0 0
-  s <- ensure n
-  let (h, t) = Factorial.splitAt n s
-  if p h
-    then put t >> return h
-    else fail "takeWith"
+takeWith n0 p =
+  get >>= \i->
+  let !(h, t) = Factorial.splitAt n0 i
+      n1 = Factorial.length h
+  in if null t && n1 < n0
+     then put mempty
+          >> demandInput
+          >> takeWith' h n1 p
+     else if p h
+          then put t
+               >> return h
+          else fail "takeWith"
+
+-- The uncommon case
+takeWith' :: FactorialMonoid t => t -> Int -> (t -> Bool) -> Parser t t
+takeWith' h0 n0 p =
+  get >>= \i->
+  let !(h, t) = Factorial.splitAt n0 i
+      n1 = Factorial.length h
+      h1 = h0 <> h
+  in if null t && n1 < n0
+     then put mempty
+          >> demandInput
+          >> takeWith' h1 n1 p
+     else if p h1
+          then put t
+               >> return h1
+          else fail "takeWith"
 
 -- | Consume exactly @n@ prime input tokens.
 take :: FactorialMonoid t => Int -> Parser t t

benchmarks/PicoAeson.hs

 {-# INLINEABLE array_' #-}
 
 commaSeparated :: (Eq t, TextualMonoid t) => Parser t a -> Char -> Parser t [a]
-commaSeparated item end = do
+commaSeparated item end = {-# SCC "commaSeparated" #-} do
   c <- P.peekChar
   if c == end
     then P.anyToken >> return []
 {-# INLINE commaSeparated #-}
 
 arrayValues :: (Eq t, TextualMonoid t) => Parser t (Value t) -> Parser t (Vector (Value t))
-arrayValues val = do
+arrayValues val = {-# SCC "arrayValues" #-} do
   skipSpace
   Vector.fromList <$> commaSeparated val ']'
 {-# INLINE arrayValues #-}
 {-# INLINE jstring_ #-}
 
 unescape :: TextualMonoid t => Parser t t
-unescape = (P.satisfyChar (`elem` "\"\\/ntbrfu")
+unescape = {-# SCC "unescape" #-}
+           (P.satisfyChar (`elem` "\"\\/ntbrfu")
             <|> fail "invalid JSON escape sequence")
            >>= \e-> case e
                     of '"' -> pure "\""
 {-# INLINE unescape #-}
 
 hexQuad :: TextualMonoid t => Parser t Int
-hexQuad = do s <- P.take 4
+hexQuad = {-# SCC "hexQuad" #-}
+          do s <- P.take 4
              let q = Textual.foldl' (const $ const (-1)) extend 0 s :: Int
              if q < 0 then fail "invalid hex escape" else return q
   where extend n c = n `shiftL` 4 .|. hex c
 -- smaller memory footprint.
 
 skipSpace :: TextualMonoid t => Parser t ()
-skipSpace = P.skipCharsWhile isSpace
+skipSpace = {-# SCC "skipSpace" #-} P.skipCharsWhile isSpace
 {-# INLINE skipSpace #-}
 
 -- | Parse a top-level JSON value followed by optional whitespace and

benchmarks/picoparsec-benchamrks.cabal

--- These benchmarks are not intended to be installed.
--- So don't install 'em.
-
-name: picoparsec-benchmarks
-version: 0
-cabal-version: >=1.6
-build-type: Simple
-
-executable picoparsec-benchmarks
-  main-is: Benchmarks.hs
-  other-modules:
-    HeadersByteString
-    HeadersText
-    Links
-    Numbers
-  hs-source-dirs: .. .
-  ghc-options: -O2 -Wall
-  build-depends:
-    array,
-    base == 4.*,
-    bytestring >= 0.10.4.0,
-    criterion >= 0.5,
-    deepseq >= 1.1,
-    directory,
-    filepath,
-    parsec >= 3.1.2,
-    scientific,
-    text >= 1.1.1.0,
-    unordered-containers,
-    vector

benchmarks/picoparsec-benchmarks.cabal

+-- These benchmarks are not intended to be installed.
+-- So don't install 'em.
+
+name: picoparsec-benchmarks
+version: 0
+cabal-version: >=1.6
+build-type: Simple
+
+executable picoparsec-benchmarks
+  main-is: Benchmarks.hs
+  other-modules:
+    HeadersByteString
+    HeadersText
+    Links
+    Numbers
+  hs-source-dirs: .. .
+  ghc-options: -O2 -Wall
+  build-depends:
+    array,
+    base == 4.*,
+    bytestring >= 0.10.4.0,
+    criterion >= 0.5,
+    deepseq >= 1.1,
+    directory,
+    filepath,
+    parsec >= 3.1.2,
+    scientific,
+    text >= 1.1.1.0,
+    unordered-containers,
+    vector