content: ----------------------------------------------------------------------------
  -- |
  -- Module      :  FastTags.LexerM
  -- Copyright   :  (c) Sergey Vinokurov 2019
  --
  -- All the types and functions needed to make lexer run:
  -- - 'AlexInput' - primary workhorse, an optimized representation of input
  --   stream as a pointer to utf8 bytes and our position within it.
  -- - Lexer monad 'AlexM' - a monad (self-explanatory) with state that describes
  --   current lexing context.
  -- - 'AlexState' - state of the lexing monad, maintains current Alex code,
  --   comment depth, quasiquoter depth, indentation size, whether we're in
  --   a literate mode (and in which one) or vanilla mode and whether there
  --   are any TH quasiquotes present till the end of file.
  --
  -- All the functions are to do with
  ----------------------------------------------------------------------------
  
  {-# LANGUAGE BangPatterns               #-}
  {-# LANGUAGE CPP                        #-}
  {-# LANGUAGE ConstraintKinds            #-}
  {-# LANGUAGE DeriveFunctor              #-}
  {-# LANGUAGE FlexibleContexts           #-}
  {-# LANGUAGE GeneralizedNewtypeDeriving #-}
  {-# LANGUAGE LambdaCase                 #-}
  {-# LANGUAGE MagicHash                  #-}
  {-# LANGUAGE MultiWayIf                 #-}
  {-# LANGUAGE NamedFieldPuns             #-}
  {-# LANGUAGE OverloadedStrings          #-}
  {-# LANGUAGE RankNTypes                 #-}
  {-# LANGUAGE ScopedTypeVariables        #-}
  {-# LANGUAGE UnboxedTuples              #-}
  
  module FastTags.LexerM
      ( AlexState(..)
      , mkAlexState
      , alexEnterBirdLiterateEnv
      , alexEnterLiterateLatexEnv
      , alexExitLiterateEnv
      , pushContext
      , modifyCommentDepth
      , modifyQuasiquoterDepth
      , modifyPreprocessorDepth
      , addIndentationSize
      , checkQuasiQuoteEndPresent
  
      , AlexM
      , runAlexM
      , alexSetInput
      , alexSetNextCode
  
      , AlexInput(..)
      , aiLineL
      , takeText
      , countInputSpace
      , extractDefineOrLetName
      , dropUntilNL
      , dropUntilUnescapedNL
      , dropUntilNLOr
      , dropUntilNLOrEither
      , unsafeTextHeadAscii
      , unsafeTextHeadOfTailAscii
      , unsafeTextHead
      , utf8BS
  
      , asCodeL
      , asCommentDepthL
      , asQuasiquoterDepthL
      , asIndentationSizeL
      , asPreprocessorDepthL
      , asLiterateLocL
      , asHaveQQEndL
  
        -- * Alex interface
      , alexInputPrevChar
      , alexGetByte
      ) where
  
  import Control.Applicative as A
  import Control.DeepSeq
  import Control.Exception
  import Control.Monad.ST
  import Control.Monad.State.Strict
  import Control.Monad.Writer.Strict
  
  import Data.Char
  import Data.Int
  import qualified Data.Text as T
  import qualified Data.Text.Encoding as TE
  import Data.Void (Void, vacuous)
  
  import qualified Data.ByteString as BS
  import qualified Data.ByteString.Char8 as C8
  import qualified Data.ByteString.Internal as BSI
  import qualified Data.Vector.Unboxed as U
  import qualified Data.Vector.Unboxed.Mutable as UM
  
  import Foreign.ForeignPtr
  import Foreign.Ptr
  import GHC.Base
  import GHC.Ptr
  import GHC.Word
  import Text.Printf
  
  import FastTags.LensBlaze
  import FastTags.LexerTypes
  import FastTags.Token
  
  #if __GLASGOW_HASKELL__ >= 902
  import GHC.Exts (word8ToWord#, wordToWord8#)
  #else
  {-# INLINE word8ToWord# #-}
  word8ToWord# :: Word# -> Word#
  word8ToWord# x = x
  
  {-# INLINE wordToWord8# #-}
  wordToWord8# :: Word# -> Word#
  wordToWord8# x = x
  #endif
  
  
  data AlexState = AlexState
      { asInput        :: {-# UNPACK #-} !AlexInput
      , asIntStore     :: {-# UNPACK #-} !Word64
          -- ^ Integer field that stores all the other useful fields for lexing.
      , asContextStack :: [Context]
      } deriving (Show, Eq, Ord)
  
  {-# INLINE asIntStoreL #-}
  asIntStoreL :: Lens' AlexState Word64
  asIntStoreL = lens asIntStore (\b s -> s { asIntStore = b })
  
  {-# INLINE maybeBoolToInt #-}
  -- | Encode 'Maybe Bool' as bit mask to store it within integer store.
  maybeBoolToInt :: Maybe Bool -> Int
  maybeBoolToInt = \case
      Nothing    -> 0
      Just False -> 1
      Just True  -> 2
  
  {-# INLINE intToMaybeBool #-}
  -- | Decofe 'Maybe Bool' from bit mask stored within integer store.
  intToMaybeBool :: Int -> Maybe Bool
  intToMaybeBool = \case
      0 -> Nothing
      1 -> Just False
      2 -> Just True
      x -> error $ "Invalid integer representation of 'Maybe Bool': " ++ show x
  
  {-# INLINE asCodeL              #-}
  {-# INLINE asCommentDepthL      #-}
  {-# INLINE asQuasiquoterDepthL  #-}
  {-# INLINE asIndentationSizeL   #-}
  {-# INLINE asPreprocessorDepthL #-}
  {-# INLINE asLiterateLocL       #-}
  {-# INLINE asHaveQQEndL         #-}
  -- | Current Alex state the lexer is in. E.g. comments, string, TH quasiquoter
  -- or vanilla toplevel mode.
  asCodeL :: Lens' AlexState AlexCode
  asCommentDepthL, asQuasiquoterDepthL, asIndentationSizeL :: Lens' AlexState Int16
  -- | How many directives deep are we.
  asPreprocessorDepthL :: Lens' AlexState Int16
  -- | Whether we're in bird-style or latex-style literate environment
  asLiterateLocL :: Lens' AlexState (LitMode LitStyle)
  asHaveQQEndL   :: Lens' AlexState (Maybe Bool)
  asCodeL              = asIntStoreL . intL 0  0x000f
  asCommentDepthL      = asIntStoreL . intL 4  0x03ff
  asQuasiquoterDepthL  = asIntStoreL . intL 14 0x03ff
  asIndentationSizeL   = asIntStoreL . int16L  24
  asPreprocessorDepthL = asIntStoreL . int16L  40
  asLiterateLocL       = \f -> asIntStoreL (intL 56 0x0003 (fmap litLocToInt    . f . intToLitLoc))
  asHaveQQEndL         = \f -> asIntStoreL (intL 58 0x0003 (fmap maybeBoolToInt . f . intToMaybeBool))
  
  {-# INLINE litLocToInt #-}
  litLocToInt :: LitMode LitStyle -> Int
  litLocToInt = \case
      LitVanilla      -> 0
      LitOutside      -> 1
      LitInside Bird  -> 2
      LitInside Latex -> 3
  
  {-# INLINE intToLitLoc #-}
  intToLitLoc :: Int -> LitMode LitStyle
  intToLitLoc = \case
      0 -> LitVanilla
      1 -> LitOutside
      2 -> LitInside Bird
      3 -> LitInside Latex
      x -> error $ "Invalid literate location representation: " ++ show x
  
  mkAlexState :: LitMode Void -> AlexCode -> AlexInput -> AlexState
  mkAlexState litLoc startCode input =
      set asCodeL startCode $
      set asLiterateLocL (vacuous litLoc) AlexState
          { asInput        = input
          , asIntStore     = 0
          , asContextStack = []
          }
  
  {-# INLINE alexEnterBirdLiterateEnv #-}
  alexEnterBirdLiterateEnv :: MonadState AlexState m => m ()
  alexEnterBirdLiterateEnv =
      modify $ set asLiterateLocL (LitInside Bird)
  
  {-# INLINE alexEnterLiterateLatexEnv #-}
  alexEnterLiterateLatexEnv :: MonadState AlexState m => m ()
  alexEnterLiterateLatexEnv =
      modify $ set asLiterateLocL (LitInside Latex)
  
  {-# INLINE alexExitLiterateEnv #-}
  alexExitLiterateEnv :: MonadState AlexState m => m ()
  alexExitLiterateEnv =
      modify $ set asLiterateLocL LitOutside
  
  {-# INLINE pushContext #-}
  pushContext :: MonadState AlexState m => Context -> m ()
  pushContext ctx =
      modify (\s -> s { asContextStack = ctx : asContextStack s })
  
  {-# INLINE modifyCommentDepth #-}
  modifyCommentDepth :: MonadState AlexState m => (Int16 -> Int16) -> m Int16
  modifyCommentDepth f = do
      depth <- gets (view asCommentDepthL)
      let !depth' = f depth
      modify $ \s -> set asCommentDepthL depth' s
      return depth'
  
  {-# INLINE modifyQuasiquoterDepth #-}
  modifyQuasiquoterDepth :: MonadState AlexState m => (Int16 -> Int16) -> m Int16
  modifyQuasiquoterDepth f = do
      depth <- gets (view asQuasiquoterDepthL)
      let !depth' = f depth
      modify $ \s -> set asQuasiquoterDepthL depth' s
      return depth'
  
  {-# INLINE modifyPreprocessorDepth #-}
  modifyPreprocessorDepth :: MonadState AlexState m => (Int16 -> Int16) -> m Int16
  modifyPreprocessorDepth f = do
      depth <- gets (view asPreprocessorDepthL)
      let !depth' = f depth
      modify $ \s -> set asPreprocessorDepthL depth' s
      return depth'
  
  {-# INLINE alexSetInput #-}
  alexSetInput :: MonadState AlexState m => AlexInput -> m ()
  alexSetInput input = modify $ \s -> s { asInput = input }
  
  {-# INLINE alexSetNextCode #-}
  alexSetNextCode :: MonadState AlexState m => AlexCode -> m ()
  alexSetNextCode code = modify $ set asCodeL code
  
  {-# INLINE addIndentationSize #-}
  addIndentationSize :: MonadState AlexState m => Int16 -> m ()
  addIndentationSize x =
    modify (over asIndentationSizeL (+ x))
  
  data QQEndsState = QQEndsState
      { qqessPresent  :: !Int#
      , qqessPrevChar :: !Char#
      }
  
  checkQuasiQuoteEndPresent :: Ptr Word8 -> Bool
  checkQuasiQuoteEndPresent
      = (\x -> isTrue# (qqessPresent x))
      . utf8Foldl' combine (QQEndsState 0# '\n'#)
      where
      combine :: QQEndsState -> Char# -> QQEndsState
      combine QQEndsState{qqessPresent, qqessPrevChar} c# = QQEndsState
          { qqessPresent      =
            qqessPresent `orI#`
            case (# qqessPrevChar, c# #) of
                (# '|'#, ']'# #) -> 1#
                (# _,    '⟧'# #) -> 1#
                _                -> 0#
          , qqessPrevChar = c#
          }
  
  type AlexM = WriterT [(AlexInput, TokenVal)] (State AlexState)
  
  {-# INLINE runAlexM #-}
  runAlexM
    :: FilePath
    -> Bool
    -> LitMode Void
    -> AlexCode
    -> C8.ByteString
    -> AlexM a
    -> (a, [Token])
  runAlexM filepath trackPrefixesAndOffsets litLoc startCode input action =
      performIO $
      withAlexInput input $ \input' inputSize -> do
          let (a, xs) = evalState (runWriterT action)
                      $ mkAlexState litLoc startCode input'
          if trackPrefixesAndOffsets
          then do
              let !ptr  = aiPtr input' `plusPtr` 1 -- Drop first newline
                  !size = inputSize - 1
                  !idx  = positionsIndex ptr size
                  res   =
                      map (\(x, y) -> Pos (mkSrcPos filepath idx ptr x) y) xs
              pure $! res `deepseq` (a, res)
          else do
              -- Contents of 'xs' has been seq'ed so TokenVals in there should
              -- have been forced and thus should not contain any references to the
              -- original input bytestring. However, in GHC 9.0 it seems that
              -- GHC does some transformation which results in some entries within 'xs'
              -- being not fully evaluated and thus lead to an error since they get
              -- forced outside of 'withForeignPtr' bounds. The call to 'evaluate' below
              -- is intended to prevent such transformation from occuring.
              _ <- evaluate xs
              pure (a, map (\(x, y) -> Pos (mkSrcPosNoPrefix filepath x) y) xs)
  
  mkSrcPosNoPrefix :: FilePath -> AlexInput -> SrcPos
  mkSrcPosNoPrefix filename input =
      SrcPos { posFile   = filename
             , posLine   = view aiLineL input
             , posOffset = Offset 0
             , posPrefix = mempty
             , posSuffix = mempty
             }
  
  mkSrcPos :: FilePath -> U.Vector Int -> Ptr Word8 -> AlexInput -> SrcPos
  mkSrcPos filename bytesToCharsMap start (input@AlexInput {aiPtr}) =
      SrcPos { posFile = filename
             , posLine = view aiLineL input
             , posOffset
             , posPrefix
             , posSuffix
             }
      where
      lineLen   = view aiLineLengthL input
      posPrefix = TE.decodeUtf8 $ bytesToUtf8BS lineLen $ plusPtr aiPtr $ negate lineLen
      posSuffix = TE.decodeUtf8 $ regionToUtf8BS aiPtr $ dropUntilNL# aiPtr
      posOffset = Offset $ U.unsafeIndex bytesToCharsMap $ minusPtr aiPtr start
  
  
  -- Vector mapping absolute offsets off a pointer into how many utf8 characters
  -- were encoded since the pointer start.
  positionsIndex :: Ptr Word8 -> Int -> U.Vector Int
  positionsIndex (Ptr start#) len =
      U.create $ do
          (vec :: UM.MVector s Int) <- UM.new len
          let assignAfter :: Int -> Int -> Int -> ST s ()
              assignAfter start n item = go' n start
                  where
                  go' :: Int -> Int -> ST s ()
                  go' 0  !i = UM.unsafeWrite vec i item
                  go' !k !i = UM.unsafeWrite vec i item *> go' (k - 1) (i + 1)
              go :: Int# -> Int -> ST s ()
              go bytes# !nChars =
                  case utf8SizeChar# (start# `plusAddr#` bytes#) of
                      0#      -> pure ()
                      nBytes# -> do
                          assignAfter (I# bytes#) (I# nBytes#) nChars
                          go (bytes# +# nBytes#) $ nChars + 1
          go 0# 0
          A.pure vec
  
  
  data AlexInput = AlexInput
      { aiPtr      :: {-# UNPACK #-} !(Ptr Word8)
      , aiIntStore :: {-# UNPACK #-} !Word64
          -- ^ Integer field that stores all the other useful fields for lexing.
      } deriving (Eq, Ord)
  
  instance Show AlexInput where
      show AlexInput{aiPtr, aiIntStore} =
          printf "AlexInput 0x%08x 0x%08x" ptr aiIntStore
          where
          ptr :: Word
          ptr = fromIntegral $ ptrToWordPtr aiPtr
  
  {-# INLINE aiIntStoreL #-}
  aiIntStoreL :: Lens' AlexInput Word64
  aiIntStoreL = lens aiIntStore (\b s -> s { aiIntStore = b })
  
  lineInt32L :: Lens' Int32 Line
  lineInt32L = lens (Line . fromIntegral) (\(Line x) _ -> fromIntegral x)
  
  int2Int32L :: Lens' Int32 Int
  int2Int32L = lens fromIntegral (\x _ -> fromIntegral x)
  
  {-# INLINE aiLineL       #-}
  {-# INLINE aiLineLengthL #-}
  -- | Current line in input stream.
  aiLineL       :: Lens' AlexInput Line
  -- | Length of current line.
  aiLineLengthL :: Lens' AlexInput Int
  
  aiLineL       = aiIntStoreL . int32L 0  . lineInt32L
  aiLineLengthL = aiIntStoreL . int32L 32 . int2Int32L
  
  {-# INLINE takeText #-}
  takeText :: AlexInput -> Int -> T.Text
  takeText AlexInput{aiPtr} len =
      TE.decodeUtf8 $! utf8BS len aiPtr
  
  countInputSpace :: AlexInput -> Int -> Int
  countInputSpace AlexInput{aiPtr} len =
      utf8FoldlBounded len inc 0 aiPtr
      where
      inc !acc ' '#  = acc + 1
      inc !acc '\t'# = acc + 8
      inc !acc c#    = case fixChar c# of
          1## -> acc + 1
          _   -> acc
  
  {-# INLINE performIO #-}
  performIO :: IO a -> a
  performIO = BSI.accursedUnutterablePerformIO
  
  {-# INLINE withAlexInput #-}
  withAlexInput :: C8.ByteString -> (AlexInput -> Int -> IO a) -> IO a
  withAlexInput s f =
      case s' of
          BSI.PS ptr offset len ->
              withForeignPtr ptr $ \ptr' -> do
                  let !input =
                          set aiLineL initLine $
                          AlexInput
                              { aiPtr      = ptr' `plusPtr` offset
                              , aiIntStore = 0
                              }
                  f input $! len - offset
      where
      -- Line numbering starts from 0 because we're adding additional newline
      -- at the beginning to simplify processing. Thus, line numbers in the
      -- result are 1-based.
      initLine = Line 0
  
      -- Add '\0' at the end so that we'll find the end of stream (just
      -- as in the old C days...)
      s' = C8.cons '\n' $ C8.snoc (C8.snoc (stripBOM s) '\n') '\0'
      stripBOM :: C8.ByteString -> C8.ByteString
      stripBOM xs
          | "\xEF\xBB\xBF" `C8.isPrefixOf` xs
          = C8.drop 3 xs
          | otherwise
          = xs
  
  {-# INLINE extractDefineOrLetName #-}
  extractDefineOrLetName :: AlexInput -> Int -> T.Text
  extractDefineOrLetName AlexInput{aiPtr} n =
      TE.decodeUtf8 $ regionToUtf8BS (Ptr start#) end
      where
      !end        = aiPtr `plusPtr` n
      !(Ptr end#) = end
      start#      = (goBack# (end# `plusAddr#` -1#)) `plusAddr#` 1#
  
      goBack# :: Addr# -> Addr#
      goBack# ptr# = case word8ToWord# (indexWord8OffAddr# ptr# 0#) of
          0##  -> ptr#
          9##  -> ptr# -- '\n'
          10## -> ptr# -- '\n'
          13## -> ptr# -- '\r'
          32## -> ptr# -- ' '
          92## -> ptr# -- '\\'
          _    -> goBack# (ptr# `plusAddr#` -1#)
  
  {-# INLINE dropUntilNL #-}
  dropUntilNL :: AlexInput -> AlexInput
  dropUntilNL input@AlexInput{aiPtr} =
      input { aiPtr = dropUntilNL# aiPtr }
  
  {-# INLINE dropUntilUnescapedNL #-}
  dropUntilUnescapedNL :: AlexInput -> AlexInput
  dropUntilUnescapedNL input@AlexInput{aiPtr = start} =
      case dropUntilUnescapedNL# start of
          (# seenNewlines, end #) ->
              over aiLineL (\(Line n) -> Line (n + seenNewlines)) $
              input { aiPtr = end }
  
  {-# INLINE dropUntilNLOr #-}
  dropUntilNLOr :: Word8 -> AlexInput -> AlexInput
  dropUntilNLOr w input@AlexInput{aiPtr} =
      input { aiPtr = dropUntilNLOr# w aiPtr }
  
  {-# INLINE dropUntilNLOrEither #-}
  -- | Drop until either of two bytes.
  dropUntilNLOrEither :: Word8 -> Word8 -> AlexInput -> AlexInput
  dropUntilNLOrEither w1 w2 input@AlexInput{aiPtr} =
      input { aiPtr = dropUntilNLOrEither# w1 w2 aiPtr }
  
  -- Alex interface
  
  {-# INLINE alexInputPrevChar #-}
  alexInputPrevChar :: AlexInput -> Char
  alexInputPrevChar AlexInput{ aiPtr = Ptr ptr# } =
      case base# `minusAddr#` start# of
          0# -> C# (chr# ch0)
          1# -> let !(# x, _ #) = readChar1# start# ch0 in C# x
          2# -> let !(# x, _ #) = readChar2# start# ch0 in C# x
          3# -> let !(# x, _ #) = readChar3# start# ch0 in C# x
          _  -> '\0' -- Invalid!
      where
      ch0 :: Int#
      !ch0 = word2Int# (word8ToWord# (indexWord8OffAddr# start# 0#))
  
      base# = findCharStart ptr# `plusAddr#` -1#
  
      start# = findCharStart base#
  
      findCharStart :: Addr# -> Addr#
      findCharStart p#
          | startsWith10# w#
          = findCharStart (p# `plusAddr#` -1#)
          | otherwise
          = p#
          where
          w# = word2Int# (word8ToWord# (indexWord8OffAddr# p# 0#))
  
  {-# INLINE alexGetByte #-}
  alexGetByte :: AlexInput -> Maybe (Word8, AlexInput)
  alexGetByte input@AlexInput{aiPtr} =
      case nextChar aiPtr of
          (# c#, n, cs #) ->
              case fixChar c# of
                  0##  -> Nothing -- Abort on an unknown character
                  -- '\n'
                  10## -> Just (10, input')
                      where
                      !input' =
                          over aiLineL increaseLine $
                          set aiLineLengthL 0 $
                          input { aiPtr = cs }
                  c    -> Just (b, input')
                      where
                      !b     = W8# (wordToWord8# c)
                      !input' =
                          over aiLineLengthL (+ I# n) $
                          input { aiPtr = cs }
  
  -- Translate unicode character into special symbol we teached Alex to recognize.
  {-# INLINE fixChar #-}
  fixChar :: Char# -> Word#
  fixChar = \case
      -- These should not be translated since Alex knows about them
      '→'#    -> reservedSym
      '∷'#    -> reservedSym
      '⇒'#    -> reservedSym
      '∀'#    -> reservedSym
      '⦇'#    -> reservedSym
      '⦈'#    -> reservedSym
      '⟦'#    -> reservedSym
      '⟧'#    -> reservedSym
      '\x00'# -> fullStop
      '\x01'# -> fullStop
      '\x02'# -> fullStop
      '\x03'# -> fullStop
      '\x04'# -> fullStop
      '\x05'# -> fullStop
      '\x06'# -> fullStop
      '\x07'# -> fullStop
      '\x08'# -> other
      c# -> case ord# c# of
          c2# | isTrue# (c2# <=# 0x7f#) ->
                int2Word# c2# -- Plain ascii needs no fixing.
              | otherwise   ->
                  case generalCategory (C# c#) of
                      UppercaseLetter      -> upper
                      LowercaseLetter      -> lower
                      TitlecaseLetter      -> upper
                      ModifierLetter       -> suffix
                      OtherLetter          -> lower
                      NonSpacingMark       -> suffix
                      DecimalNumber        -> digit
                      OtherNumber          -> digit
                      Space                -> space
                      ConnectorPunctuation -> symbol
                      DashPunctuation      -> symbol
                      OtherPunctuation     -> symbol
                      MathSymbol           -> symbol
                      CurrencySymbol       -> symbol
                      ModifierSymbol       -> symbol
                      OtherSymbol          -> symbol
  
                      SpacingCombiningMark -> space
                      EnclosingMark        -> other
                      LetterNumber         -> symbol
                      OpenPunctuation      -> symbol
                      ClosePunctuation     -> symbol
                      InitialQuote         -> symbol
                      FinalQuote           -> symbol
                      LineSeparator        -> space
                      ParagraphSeparator   -> space
                      Control              -> other
                      Format               -> other
                      Surrogate            -> other
                      PrivateUse           -> other
                      NotAssigned          -> other
      where
        fullStop, space, upper, lower, symbol :: Word#
        digit, suffix, reservedSym, other :: Word#
        fullStop    = 0x00## -- Don't care about these
        space       = 0x01##
        upper       = 0x02##
        lower       = 0x03##
        symbol      = 0x04##
        digit       = 0x05##
        suffix      = 0x06##
        reservedSym = 0x07##
        other       = 0x08##
  
  {-# INLINE unsafeTextHeadAscii #-}
  unsafeTextHeadAscii :: Ptr Word8 -> Word8
  unsafeTextHeadAscii (Ptr ptr#) = W8# (indexWord8OffAddr# ptr# 0#)
  
  {-# INLINE unsafeTextHeadOfTailAscii #-}
  unsafeTextHeadOfTailAscii :: Ptr Word8 -> Word8
  unsafeTextHeadOfTailAscii (Ptr ptr#) = W8# (indexWord8OffAddr# ptr# 1#)
  
  {-# INLINE unsafeTextHead #-}
  unsafeTextHead :: Ptr Word8 -> Char
  unsafeTextHead x =
      case nextChar x of
          (# c#, _, _ #) -> C# c#
  
  {-# INLINE nextChar #-}
  nextChar :: Ptr Word8 -> (# Char#, Int#, Ptr Word8 #)
  nextChar (Ptr ptr#) =
      case utf8DecodeChar# ptr# of
          (# c#, nBytes# #) -> (# c#, nBytes#, Ptr (ptr# `plusAddr#` nBytes#) #)
  
  {-# INLINE dropUntilNL# #-}
  dropUntilNL# :: Ptr Word8 -> Ptr Word8
  dropUntilNL# (Ptr start#) = Ptr (go start#)
      where
      go :: Addr# -> Addr#
      go ptr# = case word8ToWord# (indexWord8OffAddr# ptr# 0#) of
          0##  -> ptr#
          10## -> ptr# -- '\n'
          _    -> go (ptr# `plusAddr#` 1#)
  
  {-# INLINE dropUntilUnescapedNL# #-}
  dropUntilUnescapedNL# :: Ptr Word8 -> (# Int, Ptr Word8 #)
  dropUntilUnescapedNL# (Ptr start#) = go 0 start#
      where
      go :: Int -> Addr# -> (# Int, Ptr Word8 #)
      go !n ptr# = case word8ToWord# (indexWord8OffAddr# ptr# 0#) of
          0##  -> (# n, Ptr ptr# #)
          -- '\n'
          10## -> (# n, Ptr ptr# #)
          -- '\\'
          92## ->
              case word8ToWord# (indexWord8OffAddr# ptr# 1#) of
                  0##  -> (# n, Ptr (ptr# `plusAddr#` 1#) #)
                  -- '\n'
                  10## -> go (n + 1) (ptr# `plusAddr#` 2#)
                  _    -> go n (ptr# `plusAddr#` 2#)
          _    -> go n (ptr# `plusAddr#` 1#)
  
  {-# INLINE dropUntilNLOr# #-}
  dropUntilNLOr# :: Word8 -> Ptr Word8 -> Ptr Word8
  dropUntilNLOr# (W8# w#) (Ptr start#) = Ptr (go start#)
      where
      go :: Addr# -> Addr#
      go ptr# = case word8ToWord# (indexWord8OffAddr# ptr# 0#) of
          0##  -> ptr#
          -- '\n'
          10## -> ptr#
          c# | isTrue# (c# `eqWord#` word8ToWord# w#) -> ptr#
             | otherwise                 -> go (ptr# `plusAddr#` 1#)
  
  {-# INLINE dropUntilNLOrEither# #-}
  dropUntilNLOrEither# :: Word8 -> Word8 -> Ptr Word8 -> Ptr Word8
  dropUntilNLOrEither# (W8# w1#) (W8# w2#) (Ptr start#) = Ptr (go start#)
      where
      go :: Addr# -> Addr#
      go ptr# = case word8ToWord# (indexWord8OffAddr# ptr# 0#) of
          0##  -> ptr#
          -- '\n'
          10## -> ptr#
          c# | isTrue# ((c# `eqWord#` word8ToWord# w1#) `orI#` (c# `eqWord#` word8ToWord# w2#))
             -> ptr#
             | otherwise
             -> go (ptr# `plusAddr#` 1#)
  
  {-# INLINE utf8Foldl' #-}
  utf8Foldl' :: forall a. (a -> Char# -> a) -> a -> Ptr Word8 -> a
  utf8Foldl' f x0 (Ptr ptr#) =
      go x0 ptr#
      where
      go :: a -> Addr# -> a
      go !acc addr# =
          case utf8DecodeChar# addr# of
              (# _,  0#      #) -> acc
              (# c#, nBytes# #) -> go (acc `f` c#) (addr# `plusAddr#` nBytes#)
  
  {-# INLINE utf8FoldlBounded #-}
  utf8FoldlBounded :: forall a. Int -> (a -> Char# -> a) -> a -> Ptr Word8 -> a
  utf8FoldlBounded (I# len#) f x0 (Ptr ptr#) =
      go len# x0 ptr#
      where
      go :: Int#-> a -> Addr# -> a
      go 0# !acc _     = acc
      go n# !acc addr# =
          case utf8DecodeChar# addr# of
              (# _,  0#      #) -> acc
              (# c#, nBytes# #) ->
                  go (n# -# 1#) (acc `f` c#) (addr# `plusAddr#` nBytes#)
  
  {-# INLINE utf8BS #-}
  utf8BS :: Int -> Ptr Word8 -> BS.ByteString
  utf8BS (I# nChars#) (Ptr start#) =
      BSI.PS (performIO (newForeignPtr_ (Ptr start#))) 0 (I# (go nChars# 0#))
      where
      go :: Int# -> Int# -> Int#
      go 0# bytes# = bytes#
      go k# bytes# =
          case utf8SizeChar# (start# `plusAddr#` bytes#)  of
              0#      -> bytes#
              nBytes# -> go (k# -# 1#) (bytes# +# nBytes#)
  
  {-# INLINE bytesToUtf8BS #-}
  bytesToUtf8BS :: Int -> Ptr Word8 -> BS.ByteString
  bytesToUtf8BS (I# nbytes#) (Ptr start#) =
      BSI.PS (performIO (newForeignPtr_ (Ptr start#))) 0 (I# nbytes#)
  
  {-# INLINE regionToUtf8BS #-}
  regionToUtf8BS :: Ptr Word8 -> Ptr Word8 -> BS.ByteString
  regionToUtf8BS start end =
      BSI.PS (performIO (newForeignPtr_ start)) 0 (minusPtr end start)
  
  {-# INLINE utf8DecodeChar# #-}
  utf8DecodeChar# :: Addr# -> (# Char#, Int# #)
  utf8DecodeChar# a# =
      case word8ToWord# (indexWord8OffAddr# a# 0#) of
          0## -> (# '\0'#, 0# #)
          !x# ->
              let !ch0 = word2Int# x# in
              if  | startsWith0# ch0     -> (# chr# ch0, 1# #)
                  | startsWith110# ch0   -> readChar1# a# ch0
                  | startsWith1110# ch0  -> readChar2# a# ch0
                  | startsWith11110# ch0 -> readChar3# a# ch0
                  | otherwise            -> invalid# 1#
  
  -- all invalid# sequences end up here:
  {-# INLINE invalid# #-}
  invalid# :: Int# -> (# Char#, Int# #)
  invalid# nBytes# = (# '\8'#, nBytes# #)
  -- TODO: check whether following note from ghc applies to server's lexer:
  -- '\xFFFD' would be the usual replacement character, but
  -- that's a valid symbol in Haskell, so will result in a
  -- confusing parse error later on.  Instead we use '\0' which
  -- will signal a lexer error immediately.
  
  {-# INLINE readChar1# #-}
  readChar1# :: Addr# -> Int# -> (# Char#, Int# #)
  readChar1# a# ch0 =
      let !ch1 = word2Int# (word8ToWord# (indexWord8OffAddr# a# 1#)) in
      if noValidUtf8Cont# ch1 then invalid# 1# else
      (# chr# (((ch0 `andI#` 0x3F#) `uncheckedIShiftL#` 6#) `orI#`
                (ch1 `andI#` 0x7F#)),
         2# #)
  
  {-# INLINE readChar2# #-}
  readChar2# :: Addr# -> Int# -> (# Char#, Int# #)
  readChar2# a# ch0 =
      let !ch1 = word2Int# (word8ToWord# (indexWord8OffAddr# a# 1#)) in
      if noValidUtf8Cont# ch1 then invalid# 1# else
      let !ch2 = word2Int# (word8ToWord# (indexWord8OffAddr# a# 2#)) in
      if noValidUtf8Cont# ch2 then invalid# 2# else
      (# chr# (((ch0 `andI#` 0x1F#) `uncheckedIShiftL#` 12#) `orI#`
               ((ch1 `andI#` 0x7F#) `uncheckedIShiftL#` 6#)  `orI#`
                (ch2 `andI#` 0x7F#)),
         3# #)
  
  {-# INLINE readChar3# #-}
  readChar3# :: Addr# -> Int# -> (# Char#, Int# #)
  readChar3# a# ch0 =
      let !ch1 = word2Int# (word8ToWord# (indexWord8OffAddr# a# 1#)) in
      if noValidUtf8Cont# ch1 then invalid# 1# else
      let !ch2 = word2Int# (word8ToWord# (indexWord8OffAddr# a# 2#)) in
      if noValidUtf8Cont# ch2 then invalid# 2# else
      let !ch3 = word2Int# (word8ToWord# (indexWord8OffAddr# a# 3#)) in
      if noValidUtf8Cont# ch3 then invalid# 3# else
      (# chr# (((ch0 `andI#` 0x0F#) `uncheckedIShiftL#` 18#) `orI#`
               ((ch1 `andI#` 0x7F#) `uncheckedIShiftL#` 12#) `orI#`
               ((ch2 `andI#` 0x7F#) `uncheckedIShiftL#` 6#)  `orI#`
                (ch3 `andI#` 0x7F#)),
         4# #)
  
  {-# INLINE noValidUtf8Cont# #-}
  noValidUtf8Cont# :: Int# -> Bool
  noValidUtf8Cont# x = isTrue# ((x <# 0x80#) `orI#` (x ># 0xBF#))
  
  {-# INLINE startsWith0# #-}
  startsWith0# :: Int# -> Bool
  startsWith0# x = isTrue# ((x `andI#` 0x80#) ==# 0#)
  
  {-# INLINE startsWith10# #-}
  startsWith10# :: Int# -> Bool
  startsWith10# x = isTrue# ((x `andI#` 0xC0#) ==# 0x80#)
  
  {-# INLINE startsWith110# #-}
  startsWith110# :: Int# -> Bool
  startsWith110# x = isTrue# ((x `andI#` 0xE0#) ==# 0xC0#)
  
  {-# INLINE startsWith1110# #-}
  startsWith1110# :: Int# -> Bool
  startsWith1110# x = isTrue# ((x `andI#` 0xF0#) ==# 0xE0#)
  
  {-# INLINE startsWith11110# #-}
  startsWith11110# :: Int# -> Bool
  startsWith11110# x = isTrue# ((x `andI#` 0xF8#) ==# 0xF0#)
  
  {-# INLINE utf8SizeChar# #-}
  utf8SizeChar# :: Addr# -> Int#
  utf8SizeChar# a# =
      case word8ToWord# (indexWord8OffAddr# a# 0#) of
          0## -> 0#
          !x# ->
              let !ch0 = word2Int# x# in
              if  | startsWith0# ch0     -> 1#
                  | startsWith110# ch0   -> 2#
                  | startsWith1110# ch0  -> 3#
                  | startsWith11110# ch0 -> 4#
                  | otherwise            -> 1#
  