{-
(c) The University of Glasgow 2006
(c) The University of Glasgow, 1997-2006


Buffers for scanning string input stored in external arrays.
-}

{-# LANGUAGE BangPatterns, CPP, MagicHash, UnboxedTuples #-}
{-# OPTIONS_GHC -O2 #-}
-- We always optimise this, otherwise performance of a non-optimised
-- compiler is severely affected

module GHC.Data.StringBuffer
       (
        StringBuffer(..),
        -- non-abstract for vs\/HaskellService

         -- * Creation\/destruction
        hGetStringBuffer,
        hGetStringBufferBlock,
        hPutStringBuffer,
        appendStringBuffers,
        stringToStringBuffer,

        -- * Inspection
        nextChar,
        currentChar,
        prevChar,
        atEnd,

        -- * Moving and comparison
        stepOn,
        offsetBytes,
        byteDiff,
        atLine,

        -- * Conversion
        lexemeToString,
        lexemeToFastString,
        decodePrevNChars,

         -- * Parsing integers
        parseUnsignedInteger,
       ) where

#include "HsVersions.h"

import GHC.Prelude

import GHC.Utils.Encoding
import GHC.Data.FastString
import GHC.Utils.IO.Unsafe
import GHC.Utils.Panic.Plain
import GHC.Utils.Misc

import Data.Maybe
import Control.Exception
import System.IO
import System.IO.Unsafe         ( unsafePerformIO )
import GHC.IO.Encoding.UTF8     ( mkUTF8 )
import GHC.IO.Encoding.Failure  ( CodingFailureMode(IgnoreCodingFailure) )

import GHC.Exts

import Foreign

-- -----------------------------------------------------------------------------
-- The StringBuffer type

-- |A StringBuffer is an internal pointer to a sized chunk of bytes.
-- The bytes are intended to be *immutable*.  There are pure
-- operations to read the contents of a StringBuffer.
--
-- A StringBuffer may have a finalizer, depending on how it was
-- obtained.
--
data StringBuffer
 = StringBuffer {
     StringBuffer -> ForeignPtr Word8
buf :: {-# UNPACK #-} !(ForeignPtr Word8),
     StringBuffer -> Int
len :: {-# UNPACK #-} !Int,        -- length
     StringBuffer -> Int
cur :: {-# UNPACK #-} !Int         -- current pos
  }
  -- The buffer is assumed to be UTF-8 encoded, and furthermore
  -- we add three @\'\\0\'@ bytes to the end as sentinels so that the
  -- decoder doesn't have to check for overflow at every single byte
  -- of a multibyte sequence.

instance Show StringBuffer where
        showsPrec :: Int -> StringBuffer -> ShowS
showsPrec Int
_ StringBuffer
s = String -> ShowS
showString String
"<stringbuffer("
                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Show a => a -> ShowS
External instance of the constraint type Show Int
shows (StringBuffer -> Int
len StringBuffer
s) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"," ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Show a => a -> ShowS
External instance of the constraint type Show Int
shows (StringBuffer -> Int
cur StringBuffer
s)
                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
")>"

-- -----------------------------------------------------------------------------
-- Creation / Destruction

-- | Read a file into a 'StringBuffer'.  The resulting buffer is automatically
-- managed by the garbage collector.
hGetStringBuffer :: FilePath -> IO StringBuffer
hGetStringBuffer :: String -> IO StringBuffer
hGetStringBuffer String
fname = do
   Handle
h <- String -> IOMode -> IO Handle
openBinaryFile String
fname IOMode
ReadMode
   Integer
size_i <- Handle -> IO Integer
hFileSize Handle
h
   Integer
offset_i <- Handle -> Integer -> Integer -> IO Integer
skipBOM Handle
h Integer
size_i Integer
0  -- offset is 0 initially
   let size :: Int
size = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Int
External instance of the constraint type Integral Integer
fromIntegral (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Integer
size_i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
- Integer
offset_i
   ForeignPtr Word8
buf <- Int -> IO (ForeignPtr Word8)
forall a. Storable a => Int -> IO (ForeignPtr a)
External instance of the constraint type Storable Word8
mallocForeignPtrArray (Int
sizeInt -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+Int
3)
   ForeignPtr Word8
-> (Ptr Word8 -> IO StringBuffer) -> IO StringBuffer
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
buf ((Ptr Word8 -> IO StringBuffer) -> IO StringBuffer)
-> (Ptr Word8 -> IO StringBuffer) -> IO StringBuffer
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> do
     Int
r <- if Int
size Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Int
== Int
0 then Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return Int
0 else Handle -> Ptr Word8 -> Int -> IO Int
forall a. Handle -> Ptr a -> Int -> IO Int
hGetBuf Handle
h Ptr Word8
ptr Int
size
     Handle -> IO ()
hClose Handle
h
     if (Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Int
/= Int
size)
        then IOError -> IO StringBuffer
forall a. IOError -> IO a
ioError (String -> IOError
userError String
"short read of file")
        else ForeignPtr Word8 -> Ptr Word8 -> Int -> IO StringBuffer
newUTF8StringBuffer ForeignPtr Word8
buf Ptr Word8
ptr Int
size

hGetStringBufferBlock :: Handle -> Int -> IO StringBuffer
hGetStringBufferBlock :: Handle -> Int -> IO StringBuffer
hGetStringBufferBlock Handle
handle Int
wanted
    = do Integer
size_i <- Handle -> IO Integer
hFileSize Handle
handle
         Integer
offset_i <- Handle -> IO Integer
hTell Handle
handle IO Integer -> (Integer -> IO Integer) -> IO Integer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
External instance of the constraint type Monad IO
>>= Handle -> Integer -> Integer -> IO Integer
skipBOM Handle
handle Integer
size_i
         let size :: Int
size = Int -> Int -> Int
forall a. Ord a => a -> a -> a
External instance of the constraint type Ord Int
min Int
wanted (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Int
External instance of the constraint type Integral Integer
fromIntegral (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Integer
size_iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
-Integer
offset_i)
         ForeignPtr Word8
buf <- Int -> IO (ForeignPtr Word8)
forall a. Storable a => Int -> IO (ForeignPtr a)
External instance of the constraint type Storable Word8
mallocForeignPtrArray (Int
sizeInt -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+Int
3)
         ForeignPtr Word8
-> (Ptr Word8 -> IO StringBuffer) -> IO StringBuffer
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
buf ((Ptr Word8 -> IO StringBuffer) -> IO StringBuffer)
-> (Ptr Word8 -> IO StringBuffer) -> IO StringBuffer
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr ->
             do Int
r <- if Int
size Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Int
== Int
0 then Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return Int
0 else Handle -> Ptr Word8 -> Int -> IO Int
forall a. Handle -> Ptr a -> Int -> IO Int
hGetBuf Handle
handle Ptr Word8
ptr Int
size
                if Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Int
/= Int
size
                   then IOError -> IO StringBuffer
forall a. IOError -> IO a
ioError (String -> IOError
userError (String -> IOError) -> String -> IOError
forall a b. (a -> b) -> a -> b
$ String
"short read of file: "String -> ShowS
forall a. [a] -> [a] -> [a]
++(Int, Int, Integer, Handle) -> String
forall a. Show a => a -> String
External instance of the constraint type forall a b c d.
(Show a, Show b, Show c, Show d) =>
Show (a, b, c, d)
External instance of the constraint type Show Int
External instance of the constraint type Show Int
External instance of the constraint type Show Integer
External instance of the constraint type Show Handle
show(Int
r,Int
size,Integer
size_i,Handle
handle))
                   else ForeignPtr Word8 -> Ptr Word8 -> Int -> IO StringBuffer
newUTF8StringBuffer ForeignPtr Word8
buf Ptr Word8
ptr Int
size

hPutStringBuffer :: Handle -> StringBuffer -> IO ()
hPutStringBuffer :: Handle -> StringBuffer -> IO ()
hPutStringBuffer Handle
hdl (StringBuffer ForeignPtr Word8
buf Int
len Int
cur)
    = do ForeignPtr Any -> (Ptr Any -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr (ForeignPtr Word8 -> Int -> ForeignPtr Any
forall a b. ForeignPtr a -> Int -> ForeignPtr b
plusForeignPtr ForeignPtr Word8
buf Int
cur) ((Ptr Any -> IO ()) -> IO ()) -> (Ptr Any -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Any
ptr ->
             Handle -> Ptr Any -> Int -> IO ()
forall a. Handle -> Ptr a -> Int -> IO ()
hPutBuf Handle
hdl Ptr Any
ptr Int
len

-- | Skip the byte-order mark if there is one (see #1744 and #6016),
-- and return the new position of the handle in bytes.
--
-- This is better than treating #FEFF as whitespace,
-- because that would mess up layout.  We don't have a concept
-- of zero-width whitespace in Haskell: all whitespace codepoints
-- have a width of one column.
skipBOM :: Handle -> Integer -> Integer -> IO Integer
skipBOM :: Handle -> Integer -> Integer -> IO Integer
skipBOM Handle
h Integer
size Integer
offset =
  -- Only skip BOM at the beginning of a file.
  if Integer
size Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Integer
> Integer
0 Bool -> Bool -> Bool
&& Integer
offset Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Integer
== Integer
0
    then do
      -- Validate assumption that handle is in binary mode.
      ASSERTM( hGetEncoding h >>= return . isNothing )
      -- Temporarily select utf8 encoding with error ignoring,
      -- to make `hLookAhead` and `hGetChar` return full Unicode characters.
      IO () -> IO () -> IO Integer -> IO Integer
forall a b c. IO a -> IO b -> IO c -> IO c
bracket_ (Handle -> TextEncoding -> IO ()
hSetEncoding Handle
h TextEncoding
safeEncoding) (Handle -> Bool -> IO ()
hSetBinaryMode Handle
h Bool
True) (IO Integer -> IO Integer) -> IO Integer -> IO Integer
forall a b. (a -> b) -> a -> b
$ do
        Char
c <- Handle -> IO Char
hLookAhead Handle
h
        if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Char
== Char
'\xfeff'
          then Handle -> IO Char
hGetChar Handle
h IO Char -> IO Integer -> IO Integer
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
External instance of the constraint type Monad IO
>> Handle -> IO Integer
hTell Handle
h
          else Integer -> IO Integer
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return Integer
offset
    else Integer -> IO Integer
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return Integer
offset
  where
    safeEncoding :: TextEncoding
safeEncoding = CodingFailureMode -> TextEncoding
mkUTF8 CodingFailureMode
IgnoreCodingFailure

newUTF8StringBuffer :: ForeignPtr Word8 -> Ptr Word8 -> Int -> IO StringBuffer
newUTF8StringBuffer :: ForeignPtr Word8 -> Ptr Word8 -> Int -> IO StringBuffer
newUTF8StringBuffer ForeignPtr Word8
buf Ptr Word8
ptr Int
size = do
  Ptr Word8 -> [Word8] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
External instance of the constraint type Storable Word8
pokeArray (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
size :: Ptr Word8) [Word8
0,Word8
0,Word8
0]
  -- sentinels for UTF-8 decoding
  StringBuffer -> IO StringBuffer
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return (StringBuffer -> IO StringBuffer)
-> StringBuffer -> IO StringBuffer
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> Int -> Int -> StringBuffer
StringBuffer ForeignPtr Word8
buf Int
size Int
0

appendStringBuffers :: StringBuffer -> StringBuffer -> IO StringBuffer
appendStringBuffers :: StringBuffer -> StringBuffer -> IO StringBuffer
appendStringBuffers StringBuffer
sb1 StringBuffer
sb2
    = do ForeignPtr Word8
newBuf <- Int -> IO (ForeignPtr Word8)
forall a. Storable a => Int -> IO (ForeignPtr a)
External instance of the constraint type Storable Word8
mallocForeignPtrArray (Int
sizeInt -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+Int
3)
         ForeignPtr Word8
-> (Ptr Word8 -> IO StringBuffer) -> IO StringBuffer
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
newBuf ((Ptr Word8 -> IO StringBuffer) -> IO StringBuffer)
-> (Ptr Word8 -> IO StringBuffer) -> IO StringBuffer
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr ->
          ForeignPtr Word8
-> (Ptr Word8 -> IO StringBuffer) -> IO StringBuffer
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr (StringBuffer -> ForeignPtr Word8
buf StringBuffer
sb1) ((Ptr Word8 -> IO StringBuffer) -> IO StringBuffer)
-> (Ptr Word8 -> IO StringBuffer) -> IO StringBuffer
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
sb1Ptr ->
           ForeignPtr Word8
-> (Ptr Word8 -> IO StringBuffer) -> IO StringBuffer
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr (StringBuffer -> ForeignPtr Word8
buf StringBuffer
sb2) ((Ptr Word8 -> IO StringBuffer) -> IO StringBuffer)
-> (Ptr Word8 -> IO StringBuffer) -> IO StringBuffer
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
sb2Ptr ->
             do Ptr Word8 -> Ptr Word8 -> Int -> IO ()
forall a. Storable a => Ptr a -> Ptr a -> Int -> IO ()
External instance of the constraint type Storable Word8
copyArray Ptr Word8
ptr (Ptr Word8
sb1Ptr Ptr Word8 -> Int -> Ptr Word8
forall a. Storable a => Ptr a -> Int -> Ptr a
External instance of the constraint type Storable Word8
`advancePtr` StringBuffer -> Int
cur StringBuffer
sb1) Int
sb1_len
                Ptr Word8 -> Ptr Word8 -> Int -> IO ()
forall a. Storable a => Ptr a -> Ptr a -> Int -> IO ()
External instance of the constraint type Storable Word8
copyArray (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a. Storable a => Ptr a -> Int -> Ptr a
External instance of the constraint type Storable Word8
`advancePtr` Int
sb1_len) (Ptr Word8
sb2Ptr Ptr Word8 -> Int -> Ptr Word8
forall a. Storable a => Ptr a -> Int -> Ptr a
External instance of the constraint type Storable Word8
`advancePtr` StringBuffer -> Int
cur StringBuffer
sb2) Int
sb2_len
                Ptr Word8 -> [Word8] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
External instance of the constraint type Storable Word8
pokeArray (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a. Storable a => Ptr a -> Int -> Ptr a
External instance of the constraint type Storable Word8
`advancePtr` Int
size) [Word8
0,Word8
0,Word8
0]
                StringBuffer -> IO StringBuffer
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return (ForeignPtr Word8 -> Int -> Int -> StringBuffer
StringBuffer ForeignPtr Word8
newBuf Int
size Int
0)
    where sb1_len :: Int
sb1_len = StringBuffer -> Int
calcLen StringBuffer
sb1
          sb2_len :: Int
sb2_len = StringBuffer -> Int
calcLen StringBuffer
sb2
          calcLen :: StringBuffer -> Int
calcLen StringBuffer
sb = StringBuffer -> Int
len StringBuffer
sb Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- StringBuffer -> Int
cur StringBuffer
sb
          size :: Int
size =  Int
sb1_len Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
sb2_len

-- | Encode a 'String' into a 'StringBuffer' as UTF-8.  The resulting buffer
-- is automatically managed by the garbage collector.
stringToStringBuffer :: String -> StringBuffer
stringToStringBuffer :: String -> StringBuffer
stringToStringBuffer String
str =
 IO StringBuffer -> StringBuffer
forall a. IO a -> a
unsafePerformIO (IO StringBuffer -> StringBuffer)
-> IO StringBuffer -> StringBuffer
forall a b. (a -> b) -> a -> b
$ do
  let size :: Int
size = String -> Int
utf8EncodedLength String
str
  ForeignPtr Word8
buf <- Int -> IO (ForeignPtr Word8)
forall a. Storable a => Int -> IO (ForeignPtr a)
External instance of the constraint type Storable Word8
mallocForeignPtrArray (Int
sizeInt -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+Int
3)
  ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
buf ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> do
    Ptr Word8 -> String -> IO ()
utf8EncodeString Ptr Word8
ptr String
str
    Ptr Word8 -> [Word8] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
External instance of the constraint type Storable Word8
pokeArray (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
size :: Ptr Word8) [Word8
0,Word8
0,Word8
0]
    -- sentinels for UTF-8 decoding
  StringBuffer -> IO StringBuffer
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return (ForeignPtr Word8 -> Int -> Int -> StringBuffer
StringBuffer ForeignPtr Word8
buf Int
size Int
0)

-- -----------------------------------------------------------------------------
-- Grab a character

-- | Return the first UTF-8 character of a nonempty 'StringBuffer' and as well
-- the remaining portion (analogous to 'Data.List.uncons').  __Warning:__ The
-- behavior is undefined if the 'StringBuffer' is empty.  The result shares
-- the same buffer as the original.  Similar to 'utf8DecodeChar', if the
-- character cannot be decoded as UTF-8, @\'\\0\'@ is returned.
{-# INLINE nextChar #-}
nextChar :: StringBuffer -> (Char,StringBuffer)
nextChar :: StringBuffer -> (Char, StringBuffer)
nextChar (StringBuffer ForeignPtr Word8
buf Int
len (I# Int#
cur#)) =
  -- Getting our fingers dirty a little here, but this is performance-critical
  IO (Char, StringBuffer) -> (Char, StringBuffer)
forall a. IO a -> a
inlinePerformIO (IO (Char, StringBuffer) -> (Char, StringBuffer))
-> IO (Char, StringBuffer) -> (Char, StringBuffer)
forall a b. (a -> b) -> a -> b
$ do
    ForeignPtr Word8
-> (Ptr Word8 -> IO (Char, StringBuffer))
-> IO (Char, StringBuffer)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
buf ((Ptr Word8 -> IO (Char, StringBuffer)) -> IO (Char, StringBuffer))
-> (Ptr Word8 -> IO (Char, StringBuffer))
-> IO (Char, StringBuffer)
forall a b. (a -> b) -> a -> b
$ \(Ptr Addr#
a#) -> do
        case Addr# -> (# Char#, Int# #)
utf8DecodeChar# (Addr#
a# Addr# -> Int# -> Addr#
`plusAddr#` Int#
cur#) of
          (# Char#
c#, Int#
nBytes# #) ->
             let cur' :: Int
cur' = Int# -> Int
I# (Int#
cur# Int# -> Int# -> Int#
+# Int#
nBytes#) in
             (Char, StringBuffer) -> IO (Char, StringBuffer)
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return (Char# -> Char
C# Char#
c#, ForeignPtr Word8 -> Int -> Int -> StringBuffer
StringBuffer ForeignPtr Word8
buf Int
len Int
cur')

-- | Return the first UTF-8 character of a nonempty 'StringBuffer' (analogous
-- to 'Data.List.head').  __Warning:__ The behavior is undefined if the
-- 'StringBuffer' is empty.  Similar to 'utf8DecodeChar', if the character
-- cannot be decoded as UTF-8, @\'\\0\'@ is returned.
currentChar :: StringBuffer -> Char
currentChar :: StringBuffer -> Char
currentChar = (Char, StringBuffer) -> Char
forall a b. (a, b) -> a
fst ((Char, StringBuffer) -> Char)
-> (StringBuffer -> (Char, StringBuffer)) -> StringBuffer -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringBuffer -> (Char, StringBuffer)
nextChar

prevChar :: StringBuffer -> Char -> Char
prevChar :: StringBuffer -> Char -> Char
prevChar (StringBuffer ForeignPtr Word8
_   Int
_   Int
0)   Char
deflt = Char
deflt
prevChar (StringBuffer ForeignPtr Word8
buf Int
_   Int
cur) Char
_     =
  IO Char -> Char
forall a. IO a -> a
inlinePerformIO (IO Char -> Char) -> IO Char -> Char
forall a b. (a -> b) -> a -> b
$ do
    ForeignPtr Word8 -> (Ptr Word8 -> IO Char) -> IO Char
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
buf ((Ptr Word8 -> IO Char) -> IO Char)
-> (Ptr Word8 -> IO Char) -> IO Char
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> do
      Ptr Word8
p' <- Ptr Word8 -> IO (Ptr Word8)
utf8PrevChar (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
cur)
      Char -> IO Char
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return ((Char, Int) -> Char
forall a b. (a, b) -> a
fst (Ptr Word8 -> (Char, Int)
utf8DecodeChar Ptr Word8
p'))

-- -----------------------------------------------------------------------------
-- Moving

-- | Return a 'StringBuffer' with the first UTF-8 character removed (analogous
-- to 'Data.List.tail').  __Warning:__ The behavior is undefined if the
-- 'StringBuffer' is empty.  The result shares the same buffer as the
-- original.
stepOn :: StringBuffer -> StringBuffer
stepOn :: StringBuffer -> StringBuffer
stepOn StringBuffer
s = (Char, StringBuffer) -> StringBuffer
forall a b. (a, b) -> b
snd (StringBuffer -> (Char, StringBuffer)
nextChar StringBuffer
s)

-- | Return a 'StringBuffer' with the first @n@ bytes removed.  __Warning:__
-- If there aren't enough characters, the returned 'StringBuffer' will be
-- invalid and any use of it may lead to undefined behavior.  The result
-- shares the same buffer as the original.
offsetBytes :: Int                      -- ^ @n@, the number of bytes
            -> StringBuffer
            -> StringBuffer
offsetBytes :: Int -> StringBuffer -> StringBuffer
offsetBytes Int
i StringBuffer
s = StringBuffer
s { cur :: Int
cur = StringBuffer -> Int
cur StringBuffer
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
i }

-- | Compute the difference in offset between two 'StringBuffer's that share
-- the same buffer.  __Warning:__ The behavior is undefined if the
-- 'StringBuffer's use separate buffers.
byteDiff :: StringBuffer -> StringBuffer -> Int
byteDiff :: StringBuffer -> StringBuffer -> Int
byteDiff StringBuffer
s1 StringBuffer
s2 = StringBuffer -> Int
cur StringBuffer
s2 Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- StringBuffer -> Int
cur StringBuffer
s1

-- | Check whether a 'StringBuffer' is empty (analogous to 'Data.List.null').
atEnd :: StringBuffer -> Bool
atEnd :: StringBuffer -> Bool
atEnd (StringBuffer ForeignPtr Word8
_ Int
l Int
c) = Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Int
== Int
c

-- | Computes a 'StringBuffer' which points to the first character of the
-- wanted line. Lines begin at 1.
atLine :: Int -> StringBuffer -> Maybe StringBuffer
atLine :: Int -> StringBuffer -> Maybe StringBuffer
atLine Int
line sb :: StringBuffer
sb@(StringBuffer ForeignPtr Word8
buf Int
len Int
_) =
  IO (Maybe StringBuffer) -> Maybe StringBuffer
forall a. IO a -> a
inlinePerformIO (IO (Maybe StringBuffer) -> Maybe StringBuffer)
-> IO (Maybe StringBuffer) -> Maybe StringBuffer
forall a b. (a -> b) -> a -> b
$
    ForeignPtr Word8
-> (Ptr Word8 -> IO (Maybe StringBuffer))
-> IO (Maybe StringBuffer)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
buf ((Ptr Word8 -> IO (Maybe StringBuffer)) -> IO (Maybe StringBuffer))
-> (Ptr Word8 -> IO (Maybe StringBuffer))
-> IO (Maybe StringBuffer)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> do
      Ptr Word8
p' <- Int -> Int -> Ptr Word8 -> IO (Ptr Word8)
skipToLine Int
line Int
len Ptr Word8
p
      if Ptr Word8
p' Ptr Word8 -> Ptr Word8 -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type forall a. Eq (Ptr a)
== Ptr Word8
forall a. Ptr a
nullPtr
        then Maybe StringBuffer -> IO (Maybe StringBuffer)
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return Maybe StringBuffer
forall a. Maybe a
Nothing
        else
          let
            delta :: Int
delta = Ptr Word8
p' Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
p
          in Maybe StringBuffer -> IO (Maybe StringBuffer)
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return (Maybe StringBuffer -> IO (Maybe StringBuffer))
-> Maybe StringBuffer -> IO (Maybe StringBuffer)
forall a b. (a -> b) -> a -> b
$ StringBuffer -> Maybe StringBuffer
forall a. a -> Maybe a
Just (StringBuffer
sb { cur :: Int
cur = Int
delta
                               , len :: Int
len = Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
delta
                               })

skipToLine :: Int -> Int -> Ptr Word8 -> IO (Ptr Word8)
skipToLine :: Int -> Int -> Ptr Word8 -> IO (Ptr Word8)
skipToLine !Int
line !Int
len !Ptr Word8
op0 = Int -> Ptr Word8 -> IO (Ptr Word8)
go Int
1 Ptr Word8
op0
  where
    !opend :: Ptr b
opend = Ptr Word8
op0 Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
len

    go :: Int -> Ptr Word8 -> IO (Ptr Word8)
go !Int
i_line !Ptr Word8
op
      | Ptr Word8
op Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type forall a. Ord (Ptr a)
>= Ptr Word8
forall a. Ptr a
opend    = Ptr Word8 -> IO (Ptr Word8)
forall (f :: * -> *) a. Applicative f => a -> f a
External instance of the constraint type Applicative IO
pure Ptr Word8
forall a. Ptr a
nullPtr
      | Int
i_line Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Int
== Int
line = Ptr Word8 -> IO (Ptr Word8)
forall (f :: * -> *) a. Applicative f => a -> f a
External instance of the constraint type Applicative IO
pure Ptr Word8
op
      | Bool
otherwise      = do
          Word8
w <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
External instance of the constraint type Storable Word8
peek Ptr Word8
op :: IO Word8
          case Word8
w of
            Word8
10 -> Int -> Ptr Word8 -> IO (Ptr Word8)
go (Int
i_line Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
1) (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
op Int
1)
            Word8
13 -> do
              -- this is safe because a 'StringBuffer' is
              -- guaranteed to have 3 bytes sentinel values.
              Word8
w' <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
External instance of the constraint type Storable Word8
peek (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
op Int
1) :: IO Word8
              case Word8
w' of
                Word8
10 -> Int -> Ptr Word8 -> IO (Ptr Word8)
go (Int
i_line Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
1) (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
op Int
2)
                Word8
_  -> Int -> Ptr Word8 -> IO (Ptr Word8)
go (Int
i_line Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
1) (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
op Int
1)
            Word8
_  -> Int -> Ptr Word8 -> IO (Ptr Word8)
go Int
i_line (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
op Int
1)

-- -----------------------------------------------------------------------------
-- Conversion

-- | Decode the first @n@ bytes of a 'StringBuffer' as UTF-8 into a 'String'.
-- Similar to 'utf8DecodeChar', if the character cannot be decoded as UTF-8,
-- they will be replaced with @\'\\0\'@.
lexemeToString :: StringBuffer
               -> Int                   -- ^ @n@, the number of bytes
               -> String
lexemeToString :: StringBuffer -> Int -> String
lexemeToString StringBuffer
_ Int
0 = String
""
lexemeToString (StringBuffer ForeignPtr Word8
buf Int
_ Int
cur) Int
bytes =
  ForeignPtr Word8 -> Int -> Int -> String
utf8DecodeStringLazy ForeignPtr Word8
buf Int
cur Int
bytes

lexemeToFastString :: StringBuffer
                   -> Int               -- ^ @n@, the number of bytes
                   -> FastString
lexemeToFastString :: StringBuffer -> Int -> FastString
lexemeToFastString StringBuffer
_ Int
0 = FastString
nilFS
lexemeToFastString (StringBuffer ForeignPtr Word8
buf Int
_ Int
cur) Int
len =
   IO FastString -> FastString
forall a. IO a -> a
inlinePerformIO (IO FastString -> FastString) -> IO FastString -> FastString
forall a b. (a -> b) -> a -> b
$
     ForeignPtr Word8 -> (Ptr Word8 -> IO FastString) -> IO FastString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
buf ((Ptr Word8 -> IO FastString) -> IO FastString)
-> (Ptr Word8 -> IO FastString) -> IO FastString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr ->
       FastString -> IO FastString
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return (FastString -> IO FastString) -> FastString -> IO FastString
forall a b. (a -> b) -> a -> b
$! Ptr Word8 -> Int -> FastString
mkFastStringBytes (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
cur) Int
len

-- | Return the previous @n@ characters (or fewer if we are less than @n@
-- characters into the buffer.
decodePrevNChars :: Int -> StringBuffer -> String
decodePrevNChars :: Int -> StringBuffer -> String
decodePrevNChars Int
n (StringBuffer ForeignPtr Word8
buf Int
_ Int
cur) =
    IO String -> String
forall a. IO a -> a
inlinePerformIO (IO String -> String) -> IO String -> String
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> (Ptr Word8 -> IO String) -> IO String
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
buf ((Ptr Word8 -> IO String) -> IO String)
-> (Ptr Word8 -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p0 ->
      Ptr Word8 -> Int -> String -> Ptr Word8 -> IO String
go Ptr Word8
p0 Int
n String
"" (Ptr Word8
p0 Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
cur Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
1))
  where
    go :: Ptr Word8 -> Int -> String -> Ptr Word8 -> IO String
    go :: Ptr Word8 -> Int -> String -> Ptr Word8 -> IO String
go Ptr Word8
buf0 Int
n String
acc Ptr Word8
p | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Int
== Int
0 Bool -> Bool -> Bool
|| Ptr Word8
buf0 Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type forall a. Ord (Ptr a)
>= Ptr Word8
p = String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return String
acc
    go Ptr Word8
buf0 Int
n String
acc Ptr Word8
p = do
        Ptr Word8
p' <- Ptr Word8 -> IO (Ptr Word8)
utf8PrevChar Ptr Word8
p
        let (Char
c,Int
_) = Ptr Word8 -> (Char, Int)
utf8DecodeChar Ptr Word8
p'
        Ptr Word8 -> Int -> String -> Ptr Word8 -> IO String
go Ptr Word8
buf0 (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
1) (Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:String
acc) Ptr Word8
p'

-- -----------------------------------------------------------------------------
-- Parsing integer strings in various bases
parseUnsignedInteger :: StringBuffer -> Int -> Integer -> (Char->Int) -> Integer
parseUnsignedInteger :: StringBuffer -> Int -> Integer -> (Char -> Int) -> Integer
parseUnsignedInteger (StringBuffer ForeignPtr Word8
buf Int
_ Int
cur) Int
len Integer
radix Char -> Int
char_to_int
  = IO Integer -> Integer
forall a. IO a -> a
inlinePerformIO (IO Integer -> Integer) -> IO Integer -> Integer
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> (Ptr Word8 -> IO Integer) -> IO Integer
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
buf ((Ptr Word8 -> IO Integer) -> IO Integer)
-> (Ptr Word8 -> IO Integer) -> IO Integer
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> Integer -> IO Integer
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return (Integer -> IO Integer) -> Integer -> IO Integer
forall a b. (a -> b) -> a -> b
$! let
    go :: Int -> Integer -> Integer
go Int
i Integer
x | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Int
== Int
len  = Integer
x
           | Bool
otherwise = case (Char, Int) -> Char
forall a b. (a, b) -> a
fst (Ptr Word8 -> (Char, Int)
utf8DecodeChar (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
cur Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
i))) of
               Char
'_'  -> Int -> Integer -> Integer
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
1) Integer
x    -- skip "_" (#14473)
               Char
char -> Int -> Integer -> Integer
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
1) (Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
* Integer
radix Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
+ Int -> Integer
forall a. Integral a => a -> Integer
External instance of the constraint type Integral Int
toInteger (Char -> Int
char_to_int Char
char))
  in Int -> Integer -> Integer
go Int
0 Integer
0