----------------------------------------------------------------------------
-- |
-- 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# :: Word# -> Word#
word8ToWord# Word#
x = Word#
x

{-# INLINE wordToWord8# #-}
wordToWord8# :: Word# -> Word#
wordToWord8# :: Word# -> Word#
wordToWord8# Word#
x = Word#
x
#endif


data AlexState = AlexState
    { AlexState -> AlexInput
asInput        :: {-# UNPACK #-} !AlexInput
    , AlexState -> Word64
asIntStore     :: {-# UNPACK #-} !Word64
        -- ^ Integer field that stores all the other useful fields for lexing.
    , AlexState -> [Context]
asContextStack :: [Context]
    } deriving (Int -> AlexState -> ShowS
[AlexState] -> ShowS
AlexState -> String
(Int -> AlexState -> ShowS)
-> (AlexState -> String)
-> ([AlexState] -> ShowS)
-> Show AlexState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AlexState] -> ShowS
$cshowList :: [AlexState] -> ShowS
show :: AlexState -> String
$cshow :: AlexState -> String
showsPrec :: Int -> AlexState -> ShowS
$cshowsPrec :: Int -> AlexState -> ShowS
Show, AlexState -> AlexState -> Bool
(AlexState -> AlexState -> Bool)
-> (AlexState -> AlexState -> Bool) -> Eq AlexState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AlexState -> AlexState -> Bool
$c/= :: AlexState -> AlexState -> Bool
== :: AlexState -> AlexState -> Bool
$c== :: AlexState -> AlexState -> Bool
Eq, Eq AlexState
Eq AlexState
-> (AlexState -> AlexState -> Ordering)
-> (AlexState -> AlexState -> Bool)
-> (AlexState -> AlexState -> Bool)
-> (AlexState -> AlexState -> Bool)
-> (AlexState -> AlexState -> Bool)
-> (AlexState -> AlexState -> AlexState)
-> (AlexState -> AlexState -> AlexState)
-> Ord AlexState
AlexState -> AlexState -> Bool
AlexState -> AlexState -> Ordering
AlexState -> AlexState -> AlexState
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: AlexState -> AlexState -> AlexState
$cmin :: AlexState -> AlexState -> AlexState
max :: AlexState -> AlexState -> AlexState
$cmax :: AlexState -> AlexState -> AlexState
>= :: AlexState -> AlexState -> Bool
$c>= :: AlexState -> AlexState -> Bool
> :: AlexState -> AlexState -> Bool
$c> :: AlexState -> AlexState -> Bool
<= :: AlexState -> AlexState -> Bool
$c<= :: AlexState -> AlexState -> Bool
< :: AlexState -> AlexState -> Bool
$c< :: AlexState -> AlexState -> Bool
compare :: AlexState -> AlexState -> Ordering
$ccompare :: AlexState -> AlexState -> Ordering
$cp1Ord :: Eq AlexState
Ord)

{-# INLINE asIntStoreL #-}
asIntStoreL :: Lens' AlexState Word64
asIntStoreL :: (Word64 -> f Word64) -> AlexState -> f AlexState
asIntStoreL = (AlexState -> Word64)
-> (Word64 -> AlexState -> AlexState)
-> Lens AlexState AlexState Word64 Word64
forall s a b t. (s -> a) -> (b -> s -> t) -> Lens s t a b
lens AlexState -> Word64
asIntStore (\Word64
b AlexState
s -> AlexState
s { asIntStore :: Word64
asIntStore = Word64
b })

{-# INLINE maybeBoolToInt #-}
-- | Encode 'Maybe Bool' as bit mask to store it within integer store.
maybeBoolToInt :: Maybe Bool -> Int
maybeBoolToInt :: Maybe Bool -> Int
maybeBoolToInt = \case
    Maybe Bool
Nothing    -> Int
0
    Just Bool
False -> Int
1
    Just Bool
True  -> Int
2

{-# INLINE intToMaybeBool #-}
-- | Decofe 'Maybe Bool' from bit mask stored within integer store.
intToMaybeBool :: Int -> Maybe Bool
intToMaybeBool :: Int -> Maybe Bool
intToMaybeBool = \case
    Int
0 -> Maybe Bool
forall a. Maybe a
Nothing
    Int
1 -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
    Int
2 -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
    Int
x -> String -> Maybe Bool
forall a. HasCallStack => String -> a
error (String -> Maybe Bool) -> String -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ String
"Invalid integer representation of 'Maybe Bool': " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
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 :: (AlexCode -> f AlexCode) -> AlexState -> f AlexState
asCodeL              = (Word64 -> f Word64) -> AlexState -> f AlexState
Lens AlexState AlexState Word64 Word64
asIntStoreL ((Word64 -> f Word64) -> AlexState -> f AlexState)
-> ((AlexCode -> f AlexCode) -> Word64 -> f Word64)
-> (AlexCode -> f AlexCode)
-> AlexState
-> f AlexState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word64 -> Lens' Word64 AlexCode
forall a b.
(Integral a, Bits b, Integral b) =>
Int -> b -> Lens' b a
intL Int
0  Word64
0x000f
asCommentDepthL :: (Int16 -> f Int16) -> AlexState -> f AlexState
asCommentDepthL      = (Word64 -> f Word64) -> AlexState -> f AlexState
Lens AlexState AlexState Word64 Word64
asIntStoreL ((Word64 -> f Word64) -> AlexState -> f AlexState)
-> ((Int16 -> f Int16) -> Word64 -> f Word64)
-> (Int16 -> f Int16)
-> AlexState
-> f AlexState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word64 -> Lens' Word64 Int16
forall a b.
(Integral a, Bits b, Integral b) =>
Int -> b -> Lens' b a
intL Int
4  Word64
0x03ff
asQuasiquoterDepthL :: (Int16 -> f Int16) -> AlexState -> f AlexState
asQuasiquoterDepthL  = (Word64 -> f Word64) -> AlexState -> f AlexState
Lens AlexState AlexState Word64 Word64
asIntStoreL ((Word64 -> f Word64) -> AlexState -> f AlexState)
-> ((Int16 -> f Int16) -> Word64 -> f Word64)
-> (Int16 -> f Int16)
-> AlexState
-> f AlexState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word64 -> Lens' Word64 Int16
forall a b.
(Integral a, Bits b, Integral b) =>
Int -> b -> Lens' b a
intL Int
14 Word64
0x03ff
asIndentationSizeL :: (Int16 -> f Int16) -> AlexState -> f AlexState
asIndentationSizeL   = (Word64 -> f Word64) -> AlexState -> f AlexState
Lens AlexState AlexState Word64 Word64
asIntStoreL ((Word64 -> f Word64) -> AlexState -> f AlexState)
-> ((Int16 -> f Int16) -> Word64 -> f Word64)
-> (Int16 -> f Int16)
-> AlexState
-> f AlexState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Lens' Word64 Int16
forall b. (Bits b, Integral b) => Int -> Lens' b Int16
int16L  Int
24
asPreprocessorDepthL :: (Int16 -> f Int16) -> AlexState -> f AlexState
asPreprocessorDepthL = (Word64 -> f Word64) -> AlexState -> f AlexState
Lens AlexState AlexState Word64 Word64
asIntStoreL ((Word64 -> f Word64) -> AlexState -> f AlexState)
-> ((Int16 -> f Int16) -> Word64 -> f Word64)
-> (Int16 -> f Int16)
-> AlexState
-> f AlexState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Lens' Word64 Int16
forall b. (Bits b, Integral b) => Int -> Lens' b Int16
int16L  Int
40
asLiterateLocL :: (LitMode LitStyle -> f (LitMode LitStyle))
-> AlexState -> f AlexState
asLiterateLocL       = \LitMode LitStyle -> f (LitMode LitStyle)
f -> (Word64 -> f Word64) -> AlexState -> f AlexState
Lens AlexState AlexState Word64 Word64
asIntStoreL (Int -> Word64 -> (Int -> f Int) -> Word64 -> f Word64
forall a b.
(Integral a, Bits b, Integral b) =>
Int -> b -> Lens' b a
intL Int
56 Word64
0x0003 ((LitMode LitStyle -> Int) -> f (LitMode LitStyle) -> f Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LitMode LitStyle -> Int
litLocToInt    (f (LitMode LitStyle) -> f Int)
-> (Int -> f (LitMode LitStyle)) -> Int -> f Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LitMode LitStyle -> f (LitMode LitStyle)
f (LitMode LitStyle -> f (LitMode LitStyle))
-> (Int -> LitMode LitStyle) -> Int -> f (LitMode LitStyle)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> LitMode LitStyle
intToLitLoc))
asHaveQQEndL :: (Maybe Bool -> f (Maybe Bool)) -> AlexState -> f AlexState
asHaveQQEndL         = \Maybe Bool -> f (Maybe Bool)
f -> (Word64 -> f Word64) -> AlexState -> f AlexState
Lens AlexState AlexState Word64 Word64
asIntStoreL (Int -> Word64 -> (Int -> f Int) -> Word64 -> f Word64
forall a b.
(Integral a, Bits b, Integral b) =>
Int -> b -> Lens' b a
intL Int
58 Word64
0x0003 ((Maybe Bool -> Int) -> f (Maybe Bool) -> f Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe Bool -> Int
maybeBoolToInt (f (Maybe Bool) -> f Int)
-> (Int -> f (Maybe Bool)) -> Int -> f Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Bool -> f (Maybe Bool)
f (Maybe Bool -> f (Maybe Bool))
-> (Int -> Maybe Bool) -> Int -> f (Maybe Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe Bool
intToMaybeBool))

{-# INLINE litLocToInt #-}
litLocToInt :: LitMode LitStyle -> Int
litLocToInt :: LitMode LitStyle -> Int
litLocToInt = \case
    LitMode LitStyle
LitVanilla      -> Int
0
    LitMode LitStyle
LitOutside      -> Int
1
    LitInside LitStyle
Bird  -> Int
2
    LitInside LitStyle
Latex -> Int
3

{-# INLINE intToLitLoc #-}
intToLitLoc :: Int -> LitMode LitStyle
intToLitLoc :: Int -> LitMode LitStyle
intToLitLoc = \case
    Int
0 -> LitMode LitStyle
forall a. LitMode a
LitVanilla
    Int
1 -> LitMode LitStyle
forall a. LitMode a
LitOutside
    Int
2 -> LitStyle -> LitMode LitStyle
forall a. a -> LitMode a
LitInside LitStyle
Bird
    Int
3 -> LitStyle -> LitMode LitStyle
forall a. a -> LitMode a
LitInside LitStyle
Latex
    Int
x -> String -> LitMode LitStyle
forall a. HasCallStack => String -> a
error (String -> LitMode LitStyle) -> String -> LitMode LitStyle
forall a b. (a -> b) -> a -> b
$ String
"Invalid literate location representation: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
x

mkAlexState :: LitMode Void -> AlexCode -> AlexInput -> AlexState
mkAlexState :: LitMode Void -> AlexCode -> AlexInput -> AlexState
mkAlexState LitMode Void
litLoc AlexCode
startCode AlexInput
input =
    Lens AlexState AlexState AlexCode AlexCode
-> AlexCode -> AlexState -> AlexState
forall s t a b. Lens s t a b -> b -> s -> t
set Lens AlexState AlexState AlexCode AlexCode
asCodeL AlexCode
startCode (AlexState -> AlexState) -> AlexState -> AlexState
forall a b. (a -> b) -> a -> b
$
    Lens AlexState AlexState (LitMode LitStyle) (LitMode LitStyle)
-> LitMode LitStyle -> AlexState -> AlexState
forall s t a b. Lens s t a b -> b -> s -> t
set Lens AlexState AlexState (LitMode LitStyle) (LitMode LitStyle)
asLiterateLocL (LitMode Void -> LitMode LitStyle
forall (f :: * -> *) a. Functor f => f Void -> f a
vacuous LitMode Void
litLoc) AlexState :: AlexInput -> Word64 -> [Context] -> AlexState
AlexState
        { asInput :: AlexInput
asInput        = AlexInput
input
        , asIntStore :: Word64
asIntStore     = Word64
0
        , asContextStack :: [Context]
asContextStack = []
        }

{-# INLINE alexEnterBirdLiterateEnv #-}
alexEnterBirdLiterateEnv :: MonadState AlexState m => m ()
alexEnterBirdLiterateEnv :: m ()
alexEnterBirdLiterateEnv =
    (AlexState -> AlexState) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AlexState -> AlexState) -> m ())
-> (AlexState -> AlexState) -> m ()
forall a b. (a -> b) -> a -> b
$ Lens AlexState AlexState (LitMode LitStyle) (LitMode LitStyle)
-> LitMode LitStyle -> AlexState -> AlexState
forall s t a b. Lens s t a b -> b -> s -> t
set Lens AlexState AlexState (LitMode LitStyle) (LitMode LitStyle)
asLiterateLocL (LitStyle -> LitMode LitStyle
forall a. a -> LitMode a
LitInside LitStyle
Bird)

{-# INLINE alexEnterLiterateLatexEnv #-}
alexEnterLiterateLatexEnv :: MonadState AlexState m => m ()
alexEnterLiterateLatexEnv :: m ()
alexEnterLiterateLatexEnv =
    (AlexState -> AlexState) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AlexState -> AlexState) -> m ())
-> (AlexState -> AlexState) -> m ()
forall a b. (a -> b) -> a -> b
$ Lens AlexState AlexState (LitMode LitStyle) (LitMode LitStyle)
-> LitMode LitStyle -> AlexState -> AlexState
forall s t a b. Lens s t a b -> b -> s -> t
set Lens AlexState AlexState (LitMode LitStyle) (LitMode LitStyle)
asLiterateLocL (LitStyle -> LitMode LitStyle
forall a. a -> LitMode a
LitInside LitStyle
Latex)

{-# INLINE alexExitLiterateEnv #-}
alexExitLiterateEnv :: MonadState AlexState m => m ()
alexExitLiterateEnv :: m ()
alexExitLiterateEnv =
    (AlexState -> AlexState) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AlexState -> AlexState) -> m ())
-> (AlexState -> AlexState) -> m ()
forall a b. (a -> b) -> a -> b
$ Lens AlexState AlexState (LitMode LitStyle) (LitMode LitStyle)
-> LitMode LitStyle -> AlexState -> AlexState
forall s t a b. Lens s t a b -> b -> s -> t
set Lens AlexState AlexState (LitMode LitStyle) (LitMode LitStyle)
asLiterateLocL LitMode LitStyle
forall a. LitMode a
LitOutside

{-# INLINE pushContext #-}
pushContext :: MonadState AlexState m => Context -> m ()
pushContext :: Context -> m ()
pushContext Context
ctx =
    (AlexState -> AlexState) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\AlexState
s -> AlexState
s { asContextStack :: [Context]
asContextStack = Context
ctx Context -> [Context] -> [Context]
forall a. a -> [a] -> [a]
: AlexState -> [Context]
asContextStack AlexState
s })

{-# INLINE modifyCommentDepth #-}
modifyCommentDepth :: MonadState AlexState m => (Int16 -> Int16) -> m Int16
modifyCommentDepth :: (Int16 -> Int16) -> m Int16
modifyCommentDepth Int16 -> Int16
f = do
    Int16
depth <- (AlexState -> Int16) -> m Int16
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Lens AlexState AlexState Int16 Int16 -> AlexState -> Int16
forall s t a b. Lens s t a b -> s -> a
view Lens AlexState AlexState Int16 Int16
asCommentDepthL)
    let !depth' :: Int16
depth' = Int16 -> Int16
f Int16
depth
    (AlexState -> AlexState) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AlexState -> AlexState) -> m ())
-> (AlexState -> AlexState) -> m ()
forall a b. (a -> b) -> a -> b
$ \AlexState
s -> Lens AlexState AlexState Int16 Int16
-> Int16 -> AlexState -> AlexState
forall s t a b. Lens s t a b -> b -> s -> t
set Lens AlexState AlexState Int16 Int16
asCommentDepthL Int16
depth' AlexState
s
    Int16 -> m Int16
forall (m :: * -> *) a. Monad m => a -> m a
return Int16
depth'

{-# INLINE modifyQuasiquoterDepth #-}
modifyQuasiquoterDepth :: MonadState AlexState m => (Int16 -> Int16) -> m Int16
modifyQuasiquoterDepth :: (Int16 -> Int16) -> m Int16
modifyQuasiquoterDepth Int16 -> Int16
f = do
    Int16
depth <- (AlexState -> Int16) -> m Int16
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Lens AlexState AlexState Int16 Int16 -> AlexState -> Int16
forall s t a b. Lens s t a b -> s -> a
view Lens AlexState AlexState Int16 Int16
asQuasiquoterDepthL)
    let !depth' :: Int16
depth' = Int16 -> Int16
f Int16
depth
    (AlexState -> AlexState) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AlexState -> AlexState) -> m ())
-> (AlexState -> AlexState) -> m ()
forall a b. (a -> b) -> a -> b
$ \AlexState
s -> Lens AlexState AlexState Int16 Int16
-> Int16 -> AlexState -> AlexState
forall s t a b. Lens s t a b -> b -> s -> t
set Lens AlexState AlexState Int16 Int16
asQuasiquoterDepthL Int16
depth' AlexState
s
    Int16 -> m Int16
forall (m :: * -> *) a. Monad m => a -> m a
return Int16
depth'

{-# INLINE modifyPreprocessorDepth #-}
modifyPreprocessorDepth :: MonadState AlexState m => (Int16 -> Int16) -> m Int16
modifyPreprocessorDepth :: (Int16 -> Int16) -> m Int16
modifyPreprocessorDepth Int16 -> Int16
f = do
    Int16
depth <- (AlexState -> Int16) -> m Int16
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Lens AlexState AlexState Int16 Int16 -> AlexState -> Int16
forall s t a b. Lens s t a b -> s -> a
view Lens AlexState AlexState Int16 Int16
asPreprocessorDepthL)
    let !depth' :: Int16
depth' = Int16 -> Int16
f Int16
depth
    (AlexState -> AlexState) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AlexState -> AlexState) -> m ())
-> (AlexState -> AlexState) -> m ()
forall a b. (a -> b) -> a -> b
$ \AlexState
s -> Lens AlexState AlexState Int16 Int16
-> Int16 -> AlexState -> AlexState
forall s t a b. Lens s t a b -> b -> s -> t
set Lens AlexState AlexState Int16 Int16
asPreprocessorDepthL Int16
depth' AlexState
s
    Int16 -> m Int16
forall (m :: * -> *) a. Monad m => a -> m a
return Int16
depth'

{-# INLINE alexSetInput #-}
alexSetInput :: MonadState AlexState m => AlexInput -> m ()
alexSetInput :: AlexInput -> m ()
alexSetInput AlexInput
input = (AlexState -> AlexState) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AlexState -> AlexState) -> m ())
-> (AlexState -> AlexState) -> m ()
forall a b. (a -> b) -> a -> b
$ \AlexState
s -> AlexState
s { asInput :: AlexInput
asInput = AlexInput
input }

{-# INLINE alexSetNextCode #-}
alexSetNextCode :: MonadState AlexState m => AlexCode -> m ()
alexSetNextCode :: AlexCode -> m ()
alexSetNextCode AlexCode
code = (AlexState -> AlexState) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AlexState -> AlexState) -> m ())
-> (AlexState -> AlexState) -> m ()
forall a b. (a -> b) -> a -> b
$ Lens AlexState AlexState AlexCode AlexCode
-> AlexCode -> AlexState -> AlexState
forall s t a b. Lens s t a b -> b -> s -> t
set Lens AlexState AlexState AlexCode AlexCode
asCodeL AlexCode
code

{-# INLINE addIndentationSize #-}
addIndentationSize :: MonadState AlexState m => Int16 -> m ()
addIndentationSize :: Int16 -> m ()
addIndentationSize Int16
x =
  (AlexState -> AlexState) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Lens AlexState AlexState Int16 Int16
-> (Int16 -> Int16) -> AlexState -> AlexState
forall s t a b. Lens s t a b -> (a -> b) -> s -> t
over Lens AlexState AlexState Int16 Int16
asIndentationSizeL (Int16 -> Int16 -> Int16
forall a. Num a => a -> a -> a
+ Int16
x))

data QQEndsState = QQEndsState
    { QQEndsState -> Int#
qqessPresent  :: !Int#
    , QQEndsState -> Char#
qqessPrevChar :: !Char#
    }

checkQuasiQuoteEndPresent :: Ptr Word8 -> Bool
checkQuasiQuoteEndPresent :: Ptr Word8 -> Bool
checkQuasiQuoteEndPresent
    = (\QQEndsState
x -> Int# -> Bool
isTrue# (QQEndsState -> Int#
qqessPresent QQEndsState
x))
    (QQEndsState -> Bool)
-> (Ptr Word8 -> QQEndsState) -> Ptr Word8 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QQEndsState -> Char# -> QQEndsState)
-> QQEndsState -> Ptr Word8 -> QQEndsState
forall a. (a -> Char# -> a) -> a -> Ptr Word8 -> a
utf8Foldl' QQEndsState -> Char# -> QQEndsState
combine (Int# -> Char# -> QQEndsState
QQEndsState Int#
0# Char#
'\n'#)
    where
    combine :: QQEndsState -> Char# -> QQEndsState
    combine :: QQEndsState -> Char# -> QQEndsState
combine QQEndsState{Int#
qqessPresent :: Int#
qqessPresent :: QQEndsState -> Int#
qqessPresent, Char#
qqessPrevChar :: Char#
qqessPrevChar :: QQEndsState -> Char#
qqessPrevChar} Char#
c# = QQEndsState :: Int# -> Char# -> QQEndsState
QQEndsState
        { qqessPresent :: Int#
qqessPresent      =
          Int#
qqessPresent Int# -> Int# -> Int#
`orI#`
          case (# Char#
qqessPrevChar, Char#
c# #) of
              (# Char#
'|'#, Char#
']'# #) -> Int#
1#
              (# Char#
_,    Char#
'⟧'# #) -> Int#
1#
              (# Char#, Char# #)
_                -> Int#
0#
        , qqessPrevChar :: Char#
qqessPrevChar = Char#
c#
        }

type AlexM = WriterT [(AlexInput, TokenVal)] (State AlexState)

{-# INLINE runAlexM #-}
runAlexM
  :: FilePath
  -> Bool
  -> LitMode Void
  -> AlexCode
  -> C8.ByteString
  -> AlexM a
  -> (a, [Token])
runAlexM :: String
-> Bool
-> LitMode Void
-> AlexCode
-> ByteString
-> AlexM a
-> (a, [Token])
runAlexM String
filepath Bool
trackPrefixesAndOffsets LitMode Void
litLoc AlexCode
startCode ByteString
input AlexM a
action =
    IO (a, [Token]) -> (a, [Token])
forall a. IO a -> a
performIO (IO (a, [Token]) -> (a, [Token]))
-> IO (a, [Token]) -> (a, [Token])
forall a b. (a -> b) -> a -> b
$
    ByteString
-> (AlexInput -> Int -> IO (a, [Token])) -> IO (a, [Token])
forall a. ByteString -> (AlexInput -> Int -> IO a) -> IO a
withAlexInput ByteString
input ((AlexInput -> Int -> IO (a, [Token])) -> IO (a, [Token]))
-> (AlexInput -> Int -> IO (a, [Token])) -> IO (a, [Token])
forall a b. (a -> b) -> a -> b
$ \AlexInput
input' Int
inputSize -> do
        let (a
a, [(AlexInput, TokenVal)]
xs) = State AlexState (a, [(AlexInput, TokenVal)])
-> AlexState -> (a, [(AlexInput, TokenVal)])
forall s a. State s a -> s -> a
evalState (AlexM a -> State AlexState (a, [(AlexInput, TokenVal)])
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT AlexM a
action)
                    (AlexState -> (a, [(AlexInput, TokenVal)]))
-> AlexState -> (a, [(AlexInput, TokenVal)])
forall a b. (a -> b) -> a -> b
$ LitMode Void -> AlexCode -> AlexInput -> AlexState
mkAlexState LitMode Void
litLoc AlexCode
startCode AlexInput
input'
        if Bool
trackPrefixesAndOffsets
        then do
            let !ptr :: Ptr b
ptr  = AlexInput -> Ptr Word8
aiPtr AlexInput
input' Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1 -- Drop first newline
                !size :: Int
size = Int
inputSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
                !idx :: Vector Int
idx  = Ptr Word8 -> Int -> Vector Int
positionsIndex Ptr Word8
forall b. Ptr b
ptr Int
size
                res :: [Token]
res   =
                    ((AlexInput, TokenVal) -> Token)
-> [(AlexInput, TokenVal)] -> [Token]
forall a b. (a -> b) -> [a] -> [b]
map (\(AlexInput
x, TokenVal
y) -> SrcPos -> TokenVal -> Token
forall a. SrcPos -> a -> Pos a
Pos (String -> Vector Int -> Ptr Word8 -> AlexInput -> SrcPos
mkSrcPos String
filepath Vector Int
idx Ptr Word8
forall b. Ptr b
ptr AlexInput
x) TokenVal
y) [(AlexInput, TokenVal)]
xs
            (a, [Token]) -> IO (a, [Token])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((a, [Token]) -> IO (a, [Token]))
-> (a, [Token]) -> IO (a, [Token])
forall a b. (a -> b) -> a -> b
$! [Token]
res [Token] -> (a, [Token]) -> (a, [Token])
forall a b. NFData a => a -> b -> b
`deepseq` (a
a, [Token]
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.
            [(AlexInput, TokenVal)]
_ <- [(AlexInput, TokenVal)] -> IO [(AlexInput, TokenVal)]
forall a. a -> IO a
evaluate [(AlexInput, TokenVal)]
xs
            (a, [Token]) -> IO (a, [Token])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a, ((AlexInput, TokenVal) -> Token)
-> [(AlexInput, TokenVal)] -> [Token]
forall a b. (a -> b) -> [a] -> [b]
map (\(AlexInput
x, TokenVal
y) -> SrcPos -> TokenVal -> Token
forall a. SrcPos -> a -> Pos a
Pos (String -> AlexInput -> SrcPos
mkSrcPosNoPrefix String
filepath AlexInput
x) TokenVal
y) [(AlexInput, TokenVal)]
xs)

mkSrcPosNoPrefix :: FilePath -> AlexInput -> SrcPos
mkSrcPosNoPrefix :: String -> AlexInput -> SrcPos
mkSrcPosNoPrefix String
filename AlexInput
input =
    SrcPos :: String -> Line -> Offset -> Text -> Text -> SrcPos
SrcPos { posFile :: String
posFile   = String
filename
           , posLine :: Line
posLine   = Lens AlexInput AlexInput Line Line -> AlexInput -> Line
forall s t a b. Lens s t a b -> s -> a
view Lens AlexInput AlexInput Line Line
aiLineL AlexInput
input
           , posOffset :: Offset
posOffset = Int -> Offset
Offset Int
0
           , posPrefix :: Text
posPrefix = Text
forall a. Monoid a => a
mempty
           , posSuffix :: Text
posSuffix = Text
forall a. Monoid a => a
mempty
           }

mkSrcPos :: FilePath -> U.Vector Int -> Ptr Word8 -> AlexInput -> SrcPos
mkSrcPos :: String -> Vector Int -> Ptr Word8 -> AlexInput -> SrcPos
mkSrcPos String
filename Vector Int
bytesToCharsMap Ptr Word8
start (input :: AlexInput
input@AlexInput {Ptr Word8
aiPtr :: Ptr Word8
aiPtr :: AlexInput -> Ptr Word8
aiPtr}) =
    SrcPos :: String -> Line -> Offset -> Text -> Text -> SrcPos
SrcPos { posFile :: String
posFile = String
filename
           , posLine :: Line
posLine = Lens AlexInput AlexInput Line Line -> AlexInput -> Line
forall s t a b. Lens s t a b -> s -> a
view Lens AlexInput AlexInput Line Line
aiLineL AlexInput
input
           , Offset
posOffset :: Offset
posOffset :: Offset
posOffset
           , Text
posPrefix :: Text
posPrefix :: Text
posPrefix
           , Text
posSuffix :: Text
posSuffix :: Text
posSuffix
           }
    where
    lineLen :: Int
lineLen   = Lens AlexInput AlexInput Int Int -> AlexInput -> Int
forall s t a b. Lens s t a b -> s -> a
view Lens AlexInput AlexInput Int Int
aiLineLengthL AlexInput
input
    posPrefix :: Text
posPrefix = ByteString -> Text
TE.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Ptr Word8 -> ByteString
bytesToUtf8BS Int
lineLen (Ptr Word8 -> ByteString) -> Ptr Word8 -> ByteString
forall a b. (a -> b) -> a -> b
$ Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
aiPtr (Int -> Ptr Word8) -> Int -> Ptr Word8
forall a b. (a -> b) -> a -> b
$ Int -> Int
forall a. Num a => a -> a
negate Int
lineLen
    posSuffix :: Text
posSuffix = ByteString -> Text
TE.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Ptr Word8 -> Ptr Word8 -> ByteString
regionToUtf8BS Ptr Word8
aiPtr (Ptr Word8 -> ByteString) -> Ptr Word8 -> ByteString
forall a b. (a -> b) -> a -> b
$ Ptr Word8 -> Ptr Word8
dropUntilNL# Ptr Word8
aiPtr
    posOffset :: Offset
posOffset = Int -> Offset
Offset (Int -> Offset) -> Int -> Offset
forall a b. (a -> b) -> a -> b
$ Vector Int -> Int -> Int
forall a. Unbox a => Vector a -> Int -> a
U.unsafeIndex Vector Int
bytesToCharsMap (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
minusPtr Ptr Word8
aiPtr Ptr Word8
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 Word8 -> Int -> Vector Int
positionsIndex (Ptr Addr#
start#) Int
len =
    (forall s. ST s (MVector s Int)) -> Vector Int
forall a. Unbox a => (forall s. ST s (MVector s a)) -> Vector a
U.create ((forall s. ST s (MVector s Int)) -> Vector Int)
-> (forall s. ST s (MVector s Int)) -> Vector Int
forall a b. (a -> b) -> a -> b
$ do
        (MVector s Int
vec :: UM.MVector s Int) <- Int -> ST s (MVector (PrimState (ST s)) Int)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> m (MVector (PrimState m) a)
UM.new Int
len
        let assignAfter :: Int -> Int -> Int -> ST s ()
            assignAfter :: Int -> Int -> Int -> ST s ()
assignAfter Int
start Int
n Int
item = Int -> Int -> ST s ()
go' Int
n Int
start
                where
                go' :: Int -> Int -> ST s ()
                go' :: Int -> Int -> ST s ()
go' Int
0  !Int
i = MVector (PrimState (ST s)) Int -> Int -> Int -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
UM.unsafeWrite MVector s Int
MVector (PrimState (ST s)) Int
vec Int
i Int
item
                go' !Int
k !Int
i = MVector (PrimState (ST s)) Int -> Int -> Int -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
UM.unsafeWrite MVector s Int
MVector (PrimState (ST s)) Int
vec Int
i Int
item ST s () -> ST s () -> ST s ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> Int -> ST s ()
go' (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
            go :: Int# -> Int -> ST s ()
            go :: Int# -> Int -> ST s ()
go Int#
bytes# !Int
nChars =
                case Addr# -> Int#
utf8SizeChar# (Addr#
start# Addr# -> Int# -> Addr#
`plusAddr#` Int#
bytes#) of
                    Int#
0#      -> () -> ST s ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                    Int#
nBytes# -> do
                        Int -> Int -> Int -> ST s ()
assignAfter (Int# -> Int
I# Int#
bytes#) (Int# -> Int
I# Int#
nBytes#) Int
nChars
                        Int# -> Int -> ST s ()
go (Int#
bytes# Int# -> Int# -> Int#
+# Int#
nBytes#) (Int -> ST s ()) -> Int -> ST s ()
forall a b. (a -> b) -> a -> b
$ Int
nChars Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
        Int# -> Int -> ST s ()
go Int#
0# Int
0
        MVector s Int -> ST s (MVector s Int)
forall (f :: * -> *) a. Applicative f => a -> f a
A.pure MVector s Int
vec


data AlexInput = AlexInput
    { AlexInput -> Ptr Word8
aiPtr      :: {-# UNPACK #-} !(Ptr Word8)
    , AlexInput -> Word64
aiIntStore :: {-# UNPACK #-} !Word64
        -- ^ Integer field that stores all the other useful fields for lexing.
    } deriving (AlexInput -> AlexInput -> Bool
(AlexInput -> AlexInput -> Bool)
-> (AlexInput -> AlexInput -> Bool) -> Eq AlexInput
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AlexInput -> AlexInput -> Bool
$c/= :: AlexInput -> AlexInput -> Bool
== :: AlexInput -> AlexInput -> Bool
$c== :: AlexInput -> AlexInput -> Bool
Eq, Eq AlexInput
Eq AlexInput
-> (AlexInput -> AlexInput -> Ordering)
-> (AlexInput -> AlexInput -> Bool)
-> (AlexInput -> AlexInput -> Bool)
-> (AlexInput -> AlexInput -> Bool)
-> (AlexInput -> AlexInput -> Bool)
-> (AlexInput -> AlexInput -> AlexInput)
-> (AlexInput -> AlexInput -> AlexInput)
-> Ord AlexInput
AlexInput -> AlexInput -> Bool
AlexInput -> AlexInput -> Ordering
AlexInput -> AlexInput -> AlexInput
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: AlexInput -> AlexInput -> AlexInput
$cmin :: AlexInput -> AlexInput -> AlexInput
max :: AlexInput -> AlexInput -> AlexInput
$cmax :: AlexInput -> AlexInput -> AlexInput
>= :: AlexInput -> AlexInput -> Bool
$c>= :: AlexInput -> AlexInput -> Bool
> :: AlexInput -> AlexInput -> Bool
$c> :: AlexInput -> AlexInput -> Bool
<= :: AlexInput -> AlexInput -> Bool
$c<= :: AlexInput -> AlexInput -> Bool
< :: AlexInput -> AlexInput -> Bool
$c< :: AlexInput -> AlexInput -> Bool
compare :: AlexInput -> AlexInput -> Ordering
$ccompare :: AlexInput -> AlexInput -> Ordering
$cp1Ord :: Eq AlexInput
Ord)

instance Show AlexInput where
    show :: AlexInput -> String
show AlexInput{Ptr Word8
aiPtr :: Ptr Word8
aiPtr :: AlexInput -> Ptr Word8
aiPtr, Word64
aiIntStore :: Word64
aiIntStore :: AlexInput -> Word64
aiIntStore} =
        String -> Word -> Word64 -> String
forall r. PrintfType r => String -> r
printf String
"AlexInput 0x%08x 0x%08x" Word
ptr Word64
aiIntStore
        where
        ptr :: Word
        ptr :: Word
ptr = WordPtr -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (WordPtr -> Word) -> WordPtr -> Word
forall a b. (a -> b) -> a -> b
$ Ptr Word8 -> WordPtr
forall a. Ptr a -> WordPtr
ptrToWordPtr Ptr Word8
aiPtr

{-# INLINE aiIntStoreL #-}
aiIntStoreL :: Lens' AlexInput Word64
aiIntStoreL :: (Word64 -> f Word64) -> AlexInput -> f AlexInput
aiIntStoreL = (AlexInput -> Word64)
-> (Word64 -> AlexInput -> AlexInput)
-> Lens AlexInput AlexInput Word64 Word64
forall s a b t. (s -> a) -> (b -> s -> t) -> Lens s t a b
lens AlexInput -> Word64
aiIntStore (\Word64
b AlexInput
s -> AlexInput
s { aiIntStore :: Word64
aiIntStore = Word64
b })

lineInt32L :: Lens' Int32 Line
lineInt32L :: (Line -> f Line) -> Int32 -> f Int32
lineInt32L = (Int32 -> Line)
-> (Line -> Int32 -> Int32) -> Lens Int32 Int32 Line Line
forall s a b t. (s -> a) -> (b -> s -> t) -> Lens s t a b
lens (Int -> Line
Line (Int -> Line) -> (Int32 -> Int) -> Int32 -> Line
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (\(Line Int
x) Int32
_ -> Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x)

int2Int32L :: Lens' Int32 Int
int2Int32L :: (Int -> f Int) -> Int32 -> f Int32
int2Int32L = (Int32 -> Int)
-> (Int -> Int32 -> Int32) -> Lens Int32 Int32 Int Int
forall s a b t. (s -> a) -> (b -> s -> t) -> Lens s t a b
lens Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (\Int
x Int32
_ -> Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x)

{-# INLINE aiLineL       #-}
{-# INLINE aiLineLengthL #-}
-- | Current line in input stream.
aiLineL       :: Lens' AlexInput Line
-- | Length of current line.
aiLineLengthL :: Lens' AlexInput Int

aiLineL :: (Line -> f Line) -> AlexInput -> f AlexInput
aiLineL       = (Word64 -> f Word64) -> AlexInput -> f AlexInput
Lens AlexInput AlexInput Word64 Word64
aiIntStoreL ((Word64 -> f Word64) -> AlexInput -> f AlexInput)
-> ((Line -> f Line) -> Word64 -> f Word64)
-> (Line -> f Line)
-> AlexInput
-> f AlexInput
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Lens' Word64 Int32
forall b. (Bits b, Integral b) => Int -> Lens' b Int32
int32L Int
0  ((Int32 -> f Int32) -> Word64 -> f Word64)
-> ((Line -> f Line) -> Int32 -> f Int32)
-> (Line -> f Line)
-> Word64
-> f Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Line -> f Line) -> Int32 -> f Int32
Lens Int32 Int32 Line Line
lineInt32L
aiLineLengthL :: (Int -> f Int) -> AlexInput -> f AlexInput
aiLineLengthL = (Word64 -> f Word64) -> AlexInput -> f AlexInput
Lens AlexInput AlexInput Word64 Word64
aiIntStoreL ((Word64 -> f Word64) -> AlexInput -> f AlexInput)
-> ((Int -> f Int) -> Word64 -> f Word64)
-> (Int -> f Int)
-> AlexInput
-> f AlexInput
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Lens' Word64 Int32
forall b. (Bits b, Integral b) => Int -> Lens' b Int32
int32L Int
32 ((Int32 -> f Int32) -> Word64 -> f Word64)
-> ((Int -> f Int) -> Int32 -> f Int32)
-> (Int -> f Int)
-> Word64
-> f Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> f Int) -> Int32 -> f Int32
Lens Int32 Int32 Int Int
int2Int32L

{-# INLINE takeText #-}
takeText :: AlexInput -> Int -> T.Text
takeText :: AlexInput -> Int -> Text
takeText AlexInput{Ptr Word8
aiPtr :: Ptr Word8
aiPtr :: AlexInput -> Ptr Word8
aiPtr} Int
len =
    ByteString -> Text
TE.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$! Int -> Ptr Word8 -> ByteString
utf8BS Int
len Ptr Word8
aiPtr

countInputSpace :: AlexInput -> Int -> Int
countInputSpace :: AlexInput -> Int -> Int
countInputSpace AlexInput{Ptr Word8
aiPtr :: Ptr Word8
aiPtr :: AlexInput -> Ptr Word8
aiPtr} Int
len =
    Int -> (Int -> Char# -> Int) -> Int -> Ptr Word8 -> Int
forall a. Int -> (a -> Char# -> a) -> a -> Ptr Word8 -> a
utf8FoldlBounded Int
len Int -> Char# -> Int
forall a. Num a => a -> Char# -> a
inc Int
0 Ptr Word8
aiPtr
    where
    inc :: a -> Char# -> a
inc !a
acc Char#
' '#  = a
acc a -> a -> a
forall a. Num a => a -> a -> a
+ a
1
    inc !a
acc Char#
'\t'# = a
acc a -> a -> a
forall a. Num a => a -> a -> a
+ a
8
    inc !a
acc Char#
c#    = case Char# -> Word#
fixChar Char#
c# of
        Word#
1## -> a
acc a -> a -> a
forall a. Num a => a -> a -> a
+ a
1
        Word#
_   -> a
acc

{-# INLINE performIO #-}
performIO :: IO a -> a
performIO :: IO a -> a
performIO = IO a -> a
forall a. IO a -> a
BSI.accursedUnutterablePerformIO

{-# INLINE withAlexInput #-}
withAlexInput :: C8.ByteString -> (AlexInput -> Int -> IO a) -> IO a
withAlexInput :: ByteString -> (AlexInput -> Int -> IO a) -> IO a
withAlexInput ByteString
s AlexInput -> Int -> IO a
f =
    case ByteString
s' of
        BSI.PS ForeignPtr Word8
ptr Int
offset Int
len ->
            ForeignPtr Word8 -> (Ptr Word8 -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
ptr ((Ptr Word8 -> IO a) -> IO a) -> (Ptr Word8 -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr' -> do
                let !input :: AlexInput
input =
                        Lens AlexInput AlexInput Line Line
-> Line -> AlexInput -> AlexInput
forall s t a b. Lens s t a b -> b -> s -> t
set Lens AlexInput AlexInput Line Line
aiLineL Line
initLine (AlexInput -> AlexInput) -> AlexInput -> AlexInput
forall a b. (a -> b) -> a -> b
$
                        AlexInput :: Ptr Word8 -> Word64 -> AlexInput
AlexInput
                            { aiPtr :: Ptr Word8
aiPtr      = Ptr Word8
ptr' Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
offset
                            , aiIntStore :: Word64
aiIntStore = Word64
0
                            }
                AlexInput -> Int -> IO a
f AlexInput
input (Int -> IO a) -> Int -> IO a
forall a b. (a -> b) -> a -> b
$! Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
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
initLine = Int -> Line
Line Int
0

    -- Add '\0' at the end so that we'll find the end of stream (just
    -- as in the old C days...)
    s' :: ByteString
s' = Char -> ByteString -> ByteString
C8.cons Char
'\n' (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Char -> ByteString
C8.snoc (ByteString -> Char -> ByteString
C8.snoc (ByteString -> ByteString
stripBOM ByteString
s) Char
'\n') Char
'\0'
    stripBOM :: C8.ByteString -> C8.ByteString
    stripBOM :: ByteString -> ByteString
stripBOM ByteString
xs
        | ByteString
"\xEF\xBB\xBF" ByteString -> ByteString -> Bool
`C8.isPrefixOf` ByteString
xs
        = Int -> ByteString -> ByteString
C8.drop Int
3 ByteString
xs
        | Bool
otherwise
        = ByteString
xs

{-# INLINE extractDefineOrLetName #-}
extractDefineOrLetName :: AlexInput -> Int -> T.Text
extractDefineOrLetName :: AlexInput -> Int -> Text
extractDefineOrLetName AlexInput{Ptr Word8
aiPtr :: Ptr Word8
aiPtr :: AlexInput -> Ptr Word8
aiPtr} Int
n =
    ByteString -> Text
TE.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Ptr Word8 -> Ptr Word8 -> ByteString
regionToUtf8BS (Addr# -> Ptr Word8
forall a. Addr# -> Ptr a
Ptr Addr#
start#) Ptr Word8
forall b. Ptr b
end
    where
    !end :: Ptr b
end        = Ptr Word8
aiPtr Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
n
    !(Ptr Addr#
end#) = Ptr Any
forall b. Ptr b
end
    start# :: Addr#
start#      = (Addr# -> Addr#
goBack# (Addr#
end# Addr# -> Int# -> Addr#
`plusAddr#` Int#
-1#)) Addr# -> Int# -> Addr#
`plusAddr#` Int#
1#

    goBack# :: Addr# -> Addr#
    goBack# :: Addr# -> Addr#
goBack# Addr#
ptr# = case Word# -> Word#
word8ToWord# (Addr# -> Int# -> Word#
indexWord8OffAddr# Addr#
ptr# Int#
0#) of
        Word#
0##  -> Addr#
ptr#
        Word#
9##  -> Addr#
ptr# -- '\n'
        Word#
10## -> Addr#
ptr# -- '\n'
        Word#
13## -> Addr#
ptr# -- '\r'
        Word#
32## -> Addr#
ptr# -- ' '
        Word#
92## -> Addr#
ptr# -- '\\'
        Word#
_    -> Addr# -> Addr#
goBack# (Addr#
ptr# Addr# -> Int# -> Addr#
`plusAddr#` Int#
-1#)

{-# INLINE dropUntilNL #-}
dropUntilNL :: AlexInput -> AlexInput
dropUntilNL :: AlexInput -> AlexInput
dropUntilNL input :: AlexInput
input@AlexInput{Ptr Word8
aiPtr :: Ptr Word8
aiPtr :: AlexInput -> Ptr Word8
aiPtr} =
    AlexInput
input { aiPtr :: Ptr Word8
aiPtr = Ptr Word8 -> Ptr Word8
dropUntilNL# Ptr Word8
aiPtr }

{-# INLINE dropUntilUnescapedNL #-}
dropUntilUnescapedNL :: AlexInput -> AlexInput
dropUntilUnescapedNL :: AlexInput -> AlexInput
dropUntilUnescapedNL input :: AlexInput
input@AlexInput{aiPtr :: AlexInput -> Ptr Word8
aiPtr = Ptr Word8
start} =
    case Ptr Word8 -> (# Int, Ptr Word8 #)
dropUntilUnescapedNL# Ptr Word8
start of
        (# Int
seenNewlines, Ptr Word8
end #) ->
            Lens AlexInput AlexInput Line Line
-> (Line -> Line) -> AlexInput -> AlexInput
forall s t a b. Lens s t a b -> (a -> b) -> s -> t
over Lens AlexInput AlexInput Line Line
aiLineL (\(Line Int
n) -> Int -> Line
Line (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
seenNewlines)) (AlexInput -> AlexInput) -> AlexInput -> AlexInput
forall a b. (a -> b) -> a -> b
$
            AlexInput
input { aiPtr :: Ptr Word8
aiPtr = Ptr Word8
end }

{-# INLINE dropUntilNLOr #-}
dropUntilNLOr :: Word8 -> AlexInput -> AlexInput
dropUntilNLOr :: Word8 -> AlexInput -> AlexInput
dropUntilNLOr Word8
w input :: AlexInput
input@AlexInput{Ptr Word8
aiPtr :: Ptr Word8
aiPtr :: AlexInput -> Ptr Word8
aiPtr} =
    AlexInput
input { aiPtr :: Ptr Word8
aiPtr = Word8 -> Ptr Word8 -> Ptr Word8
dropUntilNLOr# Word8
w Ptr Word8
aiPtr }

{-# INLINE dropUntilNLOrEither #-}
-- | Drop until either of two bytes.
dropUntilNLOrEither :: Word8 -> Word8 -> AlexInput -> AlexInput
dropUntilNLOrEither :: Word8 -> Word8 -> AlexInput -> AlexInput
dropUntilNLOrEither Word8
w1 Word8
w2 input :: AlexInput
input@AlexInput{Ptr Word8
aiPtr :: Ptr Word8
aiPtr :: AlexInput -> Ptr Word8
aiPtr} =
    AlexInput
input { aiPtr :: Ptr Word8
aiPtr = Word8 -> Word8 -> Ptr Word8 -> Ptr Word8
dropUntilNLOrEither# Word8
w1 Word8
w2 Ptr Word8
aiPtr }

-- Alex interface

{-# INLINE alexInputPrevChar #-}
alexInputPrevChar :: AlexInput -> Char
alexInputPrevChar :: AlexInput -> Char
alexInputPrevChar AlexInput{ aiPtr :: AlexInput -> Ptr Word8
aiPtr = Ptr Addr#
ptr# } =
    case Addr#
base# Addr# -> Addr# -> Int#
`minusAddr#` Addr#
start# of
        Int#
0# -> Char# -> Char
C# (Int# -> Char#
chr# Int#
ch0)
        Int#
1# -> let !(# Char#
x, Int#
_ #) = Addr# -> Int# -> (# Char#, Int# #)
readChar1# Addr#
start# Int#
ch0 in Char# -> Char
C# Char#
x
        Int#
2# -> let !(# Char#
x, Int#
_ #) = Addr# -> Int# -> (# Char#, Int# #)
readChar2# Addr#
start# Int#
ch0 in Char# -> Char
C# Char#
x
        Int#
3# -> let !(# Char#
x, Int#
_ #) = Addr# -> Int# -> (# Char#, Int# #)
readChar3# Addr#
start# Int#
ch0 in Char# -> Char
C# Char#
x
        Int#
_  -> Char
'\0' -- Invalid!
    where
    ch0 :: Int#
    !ch0 :: Int#
ch0 = Word# -> Int#
word2Int# (Word# -> Word#
word8ToWord# (Addr# -> Int# -> Word#
indexWord8OffAddr# Addr#
start# Int#
0#))

    base# :: Addr#
base# = Addr# -> Addr#
findCharStart Addr#
ptr# Addr# -> Int# -> Addr#
`plusAddr#` Int#
-1#

    start# :: Addr#
start# = Addr# -> Addr#
findCharStart Addr#
base#

    findCharStart :: Addr# -> Addr#
    findCharStart :: Addr# -> Addr#
findCharStart Addr#
p#
        | Int# -> Bool
startsWith10# Int#
w#
        = Addr# -> Addr#
findCharStart (Addr#
p# Addr# -> Int# -> Addr#
`plusAddr#` Int#
-1#)
        | Bool
otherwise
        = Addr#
p#
        where
        w# :: Int#
w# = Word# -> Int#
word2Int# (Word# -> Word#
word8ToWord# (Addr# -> Int# -> Word#
indexWord8OffAddr# Addr#
p# Int#
0#))

{-# INLINE alexGetByte #-}
alexGetByte :: AlexInput -> Maybe (Word8, AlexInput)
alexGetByte :: AlexInput -> Maybe (Word8, AlexInput)
alexGetByte input :: AlexInput
input@AlexInput{Ptr Word8
aiPtr :: Ptr Word8
aiPtr :: AlexInput -> Ptr Word8
aiPtr} =
    case Ptr Word8 -> (# Char#, Int#, Ptr Word8 #)
nextChar Ptr Word8
aiPtr of
        (# Char#
c#, Int#
n, Ptr Word8
cs #) ->
            case Char# -> Word#
fixChar Char#
c# of
                Word#
0##  -> Maybe (Word8, AlexInput)
forall a. Maybe a
Nothing -- Abort on an unknown character
                -- '\n'
                Word#
10## -> (Word8, AlexInput) -> Maybe (Word8, AlexInput)
forall a. a -> Maybe a
Just (Word8
10, AlexInput
input')
                    where
                    !input' :: AlexInput
input' =
                        Lens AlexInput AlexInput Line Line
-> (Line -> Line) -> AlexInput -> AlexInput
forall s t a b. Lens s t a b -> (a -> b) -> s -> t
over Lens AlexInput AlexInput Line Line
aiLineL Line -> Line
increaseLine (AlexInput -> AlexInput) -> AlexInput -> AlexInput
forall a b. (a -> b) -> a -> b
$
                        Lens AlexInput AlexInput Int Int -> Int -> AlexInput -> AlexInput
forall s t a b. Lens s t a b -> b -> s -> t
set Lens AlexInput AlexInput Int Int
aiLineLengthL Int
0 (AlexInput -> AlexInput) -> AlexInput -> AlexInput
forall a b. (a -> b) -> a -> b
$
                        AlexInput
input { aiPtr :: Ptr Word8
aiPtr = Ptr Word8
cs }
                Word#
c    -> (Word8, AlexInput) -> Maybe (Word8, AlexInput)
forall a. a -> Maybe a
Just (Word8
b, AlexInput
input')
                    where
                    !b :: Word8
b     = Word# -> Word8
W8# (Word# -> Word#
wordToWord8# Word#
c)
                    !input' :: AlexInput
input' =
                        Lens AlexInput AlexInput Int Int
-> (Int -> Int) -> AlexInput -> AlexInput
forall s t a b. Lens s t a b -> (a -> b) -> s -> t
over Lens AlexInput AlexInput Int Int
aiLineLengthL (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int# -> Int
I# Int#
n) (AlexInput -> AlexInput) -> AlexInput -> AlexInput
forall a b. (a -> b) -> a -> b
$
                        AlexInput
input { aiPtr :: Ptr Word8
aiPtr = Ptr Word8
cs }

-- Translate unicode character into special symbol we teached Alex to recognize.
{-# INLINE fixChar #-}
fixChar :: Char# -> Word#
fixChar :: Char# -> Word#
fixChar = \case
    -- These should not be translated since Alex knows about them
    Char#
'→'#    -> Word#
reservedSym
    Char#
'∷'#    -> Word#
reservedSym
    Char#
'⇒'#    -> Word#
reservedSym
    Char#
'∀'#    -> Word#
reservedSym
    Char#
'⦇'#    -> Word#
reservedSym
    Char#
'⦈'#    -> Word#
reservedSym
    Char#
'⟦'#    -> Word#
reservedSym
    Char#
'⟧'#    -> Word#
reservedSym
    Char#
'\x00'# -> Word#
fullStop
    Char#
'\x01'# -> Word#
fullStop
    Char#
'\x02'# -> Word#
fullStop
    Char#
'\x03'# -> Word#
fullStop
    Char#
'\x04'# -> Word#
fullStop
    Char#
'\x05'# -> Word#
fullStop
    Char#
'\x06'# -> Word#
fullStop
    Char#
'\x07'# -> Word#
fullStop
    Char#
'\x08'# -> Word#
other
    Char#
c# -> case Char# -> Int#
ord# Char#
c# of
        Int#
c2# | Int# -> Bool
isTrue# (Int#
c2# Int# -> Int# -> Int#
<=# Int#
0x7f#) ->
              Int# -> Word#
int2Word# Int#
c2# -- Plain ascii needs no fixing.
            | Bool
otherwise   ->
                case Char -> GeneralCategory
generalCategory (Char# -> Char
C# Char#
c#) of
                    GeneralCategory
UppercaseLetter      -> Word#
upper
                    GeneralCategory
LowercaseLetter      -> Word#
lower
                    GeneralCategory
TitlecaseLetter      -> Word#
upper
                    GeneralCategory
ModifierLetter       -> Word#
suffix
                    GeneralCategory
OtherLetter          -> Word#
lower
                    GeneralCategory
NonSpacingMark       -> Word#
suffix
                    GeneralCategory
DecimalNumber        -> Word#
digit
                    GeneralCategory
OtherNumber          -> Word#
digit
                    GeneralCategory
Space                -> Word#
space
                    GeneralCategory
ConnectorPunctuation -> Word#
symbol
                    GeneralCategory
DashPunctuation      -> Word#
symbol
                    GeneralCategory
OtherPunctuation     -> Word#
symbol
                    GeneralCategory
MathSymbol           -> Word#
symbol
                    GeneralCategory
CurrencySymbol       -> Word#
symbol
                    GeneralCategory
ModifierSymbol       -> Word#
symbol
                    GeneralCategory
OtherSymbol          -> Word#
symbol

                    GeneralCategory
SpacingCombiningMark -> Word#
space
                    GeneralCategory
EnclosingMark        -> Word#
other
                    GeneralCategory
LetterNumber         -> Word#
symbol
                    GeneralCategory
OpenPunctuation      -> Word#
symbol
                    GeneralCategory
ClosePunctuation     -> Word#
symbol
                    GeneralCategory
InitialQuote         -> Word#
symbol
                    GeneralCategory
FinalQuote           -> Word#
symbol
                    GeneralCategory
LineSeparator        -> Word#
space
                    GeneralCategory
ParagraphSeparator   -> Word#
space
                    GeneralCategory
Control              -> Word#
other
                    GeneralCategory
Format               -> Word#
other
                    GeneralCategory
Surrogate            -> Word#
other
                    GeneralCategory
PrivateUse           -> Word#
other
                    GeneralCategory
NotAssigned          -> Word#
other
    where
      fullStop, space, upper, lower, symbol :: Word#
      digit, suffix, reservedSym, other :: Word#
      fullStop :: Word#
fullStop    = Word#
0x00## -- Don't care about these
      space :: Word#
space       = Word#
0x01##
      upper :: Word#
upper       = Word#
0x02##
      lower :: Word#
lower       = Word#
0x03##
      symbol :: Word#
symbol      = Word#
0x04##
      digit :: Word#
digit       = Word#
0x05##
      suffix :: Word#
suffix      = Word#
0x06##
      reservedSym :: Word#
reservedSym = Word#
0x07##
      other :: Word#
other       = Word#
0x08##

{-# INLINE unsafeTextHeadAscii #-}
unsafeTextHeadAscii :: Ptr Word8 -> Word8
unsafeTextHeadAscii :: Ptr Word8 -> Word8
unsafeTextHeadAscii (Ptr Addr#
ptr#) = Word# -> Word8
W8# (Addr# -> Int# -> Word#
indexWord8OffAddr# Addr#
ptr# Int#
0#)

{-# INLINE unsafeTextHeadOfTailAscii #-}
unsafeTextHeadOfTailAscii :: Ptr Word8 -> Word8
unsafeTextHeadOfTailAscii :: Ptr Word8 -> Word8
unsafeTextHeadOfTailAscii (Ptr Addr#
ptr#) = Word# -> Word8
W8# (Addr# -> Int# -> Word#
indexWord8OffAddr# Addr#
ptr# Int#
1#)

{-# INLINE unsafeTextHead #-}
unsafeTextHead :: Ptr Word8 -> Char
unsafeTextHead :: Ptr Word8 -> Char
unsafeTextHead Ptr Word8
x =
    case Ptr Word8 -> (# Char#, Int#, Ptr Word8 #)
nextChar Ptr Word8
x of
        (# Char#
c#, Int#
_, Ptr Word8
_ #) -> Char# -> Char
C# Char#
c#

{-# INLINE nextChar #-}
nextChar :: Ptr Word8 -> (# Char#, Int#, Ptr Word8 #)
nextChar :: Ptr Word8 -> (# Char#, Int#, Ptr Word8 #)
nextChar (Ptr Addr#
ptr#) =
    case Addr# -> (# Char#, Int# #)
utf8DecodeChar# Addr#
ptr# of
        (# Char#
c#, Int#
nBytes# #) -> (# Char#
c#, Int#
nBytes#, Addr# -> Ptr Word8
forall a. Addr# -> Ptr a
Ptr (Addr#
ptr# Addr# -> Int# -> Addr#
`plusAddr#` Int#
nBytes#) #)

{-# INLINE dropUntilNL# #-}
dropUntilNL# :: Ptr Word8 -> Ptr Word8
dropUntilNL# :: Ptr Word8 -> Ptr Word8
dropUntilNL# (Ptr Addr#
start#) = Addr# -> Ptr Word8
forall a. Addr# -> Ptr a
Ptr (Addr# -> Addr#
go Addr#
start#)
    where
    go :: Addr# -> Addr#
    go :: Addr# -> Addr#
go Addr#
ptr# = case Word# -> Word#
word8ToWord# (Addr# -> Int# -> Word#
indexWord8OffAddr# Addr#
ptr# Int#
0#) of
        Word#
0##  -> Addr#
ptr#
        Word#
10## -> Addr#
ptr# -- '\n'
        Word#
_    -> Addr# -> Addr#
go (Addr#
ptr# Addr# -> Int# -> Addr#
`plusAddr#` Int#
1#)

{-# INLINE dropUntilUnescapedNL# #-}
dropUntilUnescapedNL# :: Ptr Word8 -> (# Int, Ptr Word8 #)
dropUntilUnescapedNL# :: Ptr Word8 -> (# Int, Ptr Word8 #)
dropUntilUnescapedNL# (Ptr Addr#
start#) = Int -> Addr# -> (# Int, Ptr Word8 #)
go Int
0 Addr#
start#
    where
    go :: Int -> Addr# -> (# Int, Ptr Word8 #)
    go :: Int -> Addr# -> (# Int, Ptr Word8 #)
go !Int
n Addr#
ptr# = case Word# -> Word#
word8ToWord# (Addr# -> Int# -> Word#
indexWord8OffAddr# Addr#
ptr# Int#
0#) of
        Word#
0##  -> (# Int
n, Addr# -> Ptr Word8
forall a. Addr# -> Ptr a
Ptr Addr#
ptr# #)
        -- '\n'
        Word#
10## -> (# Int
n, Addr# -> Ptr Word8
forall a. Addr# -> Ptr a
Ptr Addr#
ptr# #)
        -- '\\'
        Word#
92## ->
            case Word# -> Word#
word8ToWord# (Addr# -> Int# -> Word#
indexWord8OffAddr# Addr#
ptr# Int#
1#) of
                Word#
0##  -> (# Int
n, Addr# -> Ptr Word8
forall a. Addr# -> Ptr a
Ptr (Addr#
ptr# Addr# -> Int# -> Addr#
`plusAddr#` Int#
1#) #)
                -- '\n'
                Word#
10## -> Int -> Addr# -> (# Int, Ptr Word8 #)
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Addr#
ptr# Addr# -> Int# -> Addr#
`plusAddr#` Int#
2#)
                Word#
_    -> Int -> Addr# -> (# Int, Ptr Word8 #)
go Int
n (Addr#
ptr# Addr# -> Int# -> Addr#
`plusAddr#` Int#
2#)
        Word#
_    -> Int -> Addr# -> (# Int, Ptr Word8 #)
go Int
n (Addr#
ptr# Addr# -> Int# -> Addr#
`plusAddr#` Int#
1#)

{-# INLINE dropUntilNLOr# #-}
dropUntilNLOr# :: Word8 -> Ptr Word8 -> Ptr Word8
dropUntilNLOr# :: Word8 -> Ptr Word8 -> Ptr Word8
dropUntilNLOr# (W8# Word#
w#) (Ptr Addr#
start#) = Addr# -> Ptr Word8
forall a. Addr# -> Ptr a
Ptr (Addr# -> Addr#
go Addr#
start#)
    where
    go :: Addr# -> Addr#
    go :: Addr# -> Addr#
go Addr#
ptr# = case Word# -> Word#
word8ToWord# (Addr# -> Int# -> Word#
indexWord8OffAddr# Addr#
ptr# Int#
0#) of
        Word#
0##  -> Addr#
ptr#
        -- '\n'
        Word#
10## -> Addr#
ptr#
        Word#
c# | Int# -> Bool
isTrue# (Word#
c# Word# -> Word# -> Int#
`eqWord#` Word# -> Word#
word8ToWord# Word#
w#) -> Addr#
ptr#
           | Bool
otherwise                 -> Addr# -> Addr#
go (Addr#
ptr# Addr# -> Int# -> Addr#
`plusAddr#` Int#
1#)

{-# INLINE dropUntilNLOrEither# #-}
dropUntilNLOrEither# :: Word8 -> Word8 -> Ptr Word8 -> Ptr Word8
dropUntilNLOrEither# :: Word8 -> Word8 -> Ptr Word8 -> Ptr Word8
dropUntilNLOrEither# (W8# Word#
w1#) (W8# Word#
w2#) (Ptr Addr#
start#) = Addr# -> Ptr Word8
forall a. Addr# -> Ptr a
Ptr (Addr# -> Addr#
go Addr#
start#)
    where
    go :: Addr# -> Addr#
    go :: Addr# -> Addr#
go Addr#
ptr# = case Word# -> Word#
word8ToWord# (Addr# -> Int# -> Word#
indexWord8OffAddr# Addr#
ptr# Int#
0#) of
        Word#
0##  -> Addr#
ptr#
        -- '\n'
        Word#
10## -> Addr#
ptr#
        Word#
c# | Int# -> Bool
isTrue# ((Word#
c# Word# -> Word# -> Int#
`eqWord#` Word# -> Word#
word8ToWord# Word#
w1#) Int# -> Int# -> Int#
`orI#` (Word#
c# Word# -> Word# -> Int#
`eqWord#` Word# -> Word#
word8ToWord# Word#
w2#))
           -> Addr#
ptr#
           | Bool
otherwise
           -> Addr# -> Addr#
go (Addr#
ptr# Addr# -> Int# -> Addr#
`plusAddr#` Int#
1#)

{-# INLINE utf8Foldl' #-}
utf8Foldl' :: forall a. (a -> Char# -> a) -> a -> Ptr Word8 -> a
utf8Foldl' :: (a -> Char# -> a) -> a -> Ptr Word8 -> a
utf8Foldl' a -> Char# -> a
f a
x0 (Ptr Addr#
ptr#) =
    a -> Addr# -> a
go a
x0 Addr#
ptr#
    where
    go :: a -> Addr# -> a
    go :: a -> Addr# -> a
go !a
acc Addr#
addr# =
        case Addr# -> (# Char#, Int# #)
utf8DecodeChar# Addr#
addr# of
            (# Char#
_,  Int#
0#      #) -> a
acc
            (# Char#
c#, Int#
nBytes# #) -> a -> Addr# -> a
go (a
acc a -> Char# -> a
`f` Char#
c#) (Addr#
addr# Addr# -> Int# -> Addr#
`plusAddr#` Int#
nBytes#)

{-# INLINE utf8FoldlBounded #-}
utf8FoldlBounded :: forall a. Int -> (a -> Char# -> a) -> a -> Ptr Word8 -> a
utf8FoldlBounded :: Int -> (a -> Char# -> a) -> a -> Ptr Word8 -> a
utf8FoldlBounded (I# Int#
len#) a -> Char# -> a
f a
x0 (Ptr Addr#
ptr#) =
    Int# -> a -> Addr# -> a
go Int#
len# a
x0 Addr#
ptr#
    where
    go :: Int#-> a -> Addr# -> a
    go :: Int# -> a -> Addr# -> a
go Int#
0# !a
acc Addr#
_     = a
acc
    go Int#
n# !a
acc Addr#
addr# =
        case Addr# -> (# Char#, Int# #)
utf8DecodeChar# Addr#
addr# of
            (# Char#
_,  Int#
0#      #) -> a
acc
            (# Char#
c#, Int#
nBytes# #) ->
                Int# -> a -> Addr# -> a
go (Int#
n# Int# -> Int# -> Int#
-# Int#
1#) (a
acc a -> Char# -> a
`f` Char#
c#) (Addr#
addr# Addr# -> Int# -> Addr#
`plusAddr#` Int#
nBytes#)

{-# INLINE utf8BS #-}
utf8BS :: Int -> Ptr Word8 -> BS.ByteString
utf8BS :: Int -> Ptr Word8 -> ByteString
utf8BS (I# Int#
nChars#) (Ptr Addr#
start#) =
    ForeignPtr Word8 -> Int -> Int -> ByteString
BSI.PS (IO (ForeignPtr Word8) -> ForeignPtr Word8
forall a. IO a -> a
performIO (Ptr Word8 -> IO (ForeignPtr Word8)
forall a. Ptr a -> IO (ForeignPtr a)
newForeignPtr_ (Addr# -> Ptr Word8
forall a. Addr# -> Ptr a
Ptr Addr#
start#))) Int
0 (Int# -> Int
I# (Int# -> Int# -> Int#
go Int#
nChars# Int#
0#))
    where
    go :: Int# -> Int# -> Int#
    go :: Int# -> Int# -> Int#
go Int#
0# Int#
bytes# = Int#
bytes#
    go Int#
k# Int#
bytes# =
        case Addr# -> Int#
utf8SizeChar# (Addr#
start# Addr# -> Int# -> Addr#
`plusAddr#` Int#
bytes#)  of
            Int#
0#      -> Int#
bytes#
            Int#
nBytes# -> Int# -> Int# -> Int#
go (Int#
k# Int# -> Int# -> Int#
-# Int#
1#) (Int#
bytes# Int# -> Int# -> Int#
+# Int#
nBytes#)

{-# INLINE bytesToUtf8BS #-}
bytesToUtf8BS :: Int -> Ptr Word8 -> BS.ByteString
bytesToUtf8BS :: Int -> Ptr Word8 -> ByteString
bytesToUtf8BS (I# Int#
nbytes#) (Ptr Addr#
start#) =
    ForeignPtr Word8 -> Int -> Int -> ByteString
BSI.PS (IO (ForeignPtr Word8) -> ForeignPtr Word8
forall a. IO a -> a
performIO (Ptr Word8 -> IO (ForeignPtr Word8)
forall a. Ptr a -> IO (ForeignPtr a)
newForeignPtr_ (Addr# -> Ptr Word8
forall a. Addr# -> Ptr a
Ptr Addr#
start#))) Int
0 (Int# -> Int
I# Int#
nbytes#)

{-# INLINE regionToUtf8BS #-}
regionToUtf8BS :: Ptr Word8 -> Ptr Word8 -> BS.ByteString
regionToUtf8BS :: Ptr Word8 -> Ptr Word8 -> ByteString
regionToUtf8BS Ptr Word8
start Ptr Word8
end =
    ForeignPtr Word8 -> Int -> Int -> ByteString
BSI.PS (IO (ForeignPtr Word8) -> ForeignPtr Word8
forall a. IO a -> a
performIO (Ptr Word8 -> IO (ForeignPtr Word8)
forall a. Ptr a -> IO (ForeignPtr a)
newForeignPtr_ Ptr Word8
start)) Int
0 (Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
minusPtr Ptr Word8
end Ptr Word8
start)

{-# INLINE utf8DecodeChar# #-}
utf8DecodeChar# :: Addr# -> (# Char#, Int# #)
utf8DecodeChar# :: Addr# -> (# Char#, Int# #)
utf8DecodeChar# Addr#
a# =
    case Word# -> Word#
word8ToWord# (Addr# -> Int# -> Word#
indexWord8OffAddr# Addr#
a# Int#
0#) of
        Word#
0## -> (# Char#
'\0'#, Int#
0# #)
        !Word#
x# ->
            let !ch0 :: Int#
ch0 = Word# -> Int#
word2Int# Word#
x# in
            if  | Int# -> Bool
startsWith0# Int#
ch0     -> (# Int# -> Char#
chr# Int#
ch0, Int#
1# #)
                | Int# -> Bool
startsWith110# Int#
ch0   -> Addr# -> Int# -> (# Char#, Int# #)
readChar1# Addr#
a# Int#
ch0
                | Int# -> Bool
startsWith1110# Int#
ch0  -> Addr# -> Int# -> (# Char#, Int# #)
readChar2# Addr#
a# Int#
ch0
                | Int# -> Bool
startsWith11110# Int#
ch0 -> Addr# -> Int# -> (# Char#, Int# #)
readChar3# Addr#
a# Int#
ch0
                | Bool
otherwise            -> Int# -> (# Char#, Int# #)
invalid# Int#
1#

-- all invalid# sequences end up here:
{-# INLINE invalid# #-}
invalid# :: Int# -> (# Char#, Int# #)
invalid# :: Int# -> (# Char#, Int# #)
invalid# Int#
nBytes# = (# Char#
'\8'#, Int#
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# :: Addr# -> Int# -> (# Char#, Int# #)
readChar1# Addr#
a# Int#
ch0 =
    let !ch1 :: Int#
ch1 = Word# -> Int#
word2Int# (Word# -> Word#
word8ToWord# (Addr# -> Int# -> Word#
indexWord8OffAddr# Addr#
a# Int#
1#)) in
    if Int# -> Bool
noValidUtf8Cont# Int#
ch1 then Int# -> (# Char#, Int# #)
invalid# Int#
1# else
    (# Int# -> Char#
chr# (((Int#
ch0 Int# -> Int# -> Int#
`andI#` Int#
0x3F#) Int# -> Int# -> Int#
`uncheckedIShiftL#` Int#
6#) Int# -> Int# -> Int#
`orI#`
              (Int#
ch1 Int# -> Int# -> Int#
`andI#` Int#
0x7F#)),
       Int#
2# #)

{-# INLINE readChar2# #-}
readChar2# :: Addr# -> Int# -> (# Char#, Int# #)
readChar2# :: Addr# -> Int# -> (# Char#, Int# #)
readChar2# Addr#
a# Int#
ch0 =
    let !ch1 :: Int#
ch1 = Word# -> Int#
word2Int# (Word# -> Word#
word8ToWord# (Addr# -> Int# -> Word#
indexWord8OffAddr# Addr#
a# Int#
1#)) in
    if Int# -> Bool
noValidUtf8Cont# Int#
ch1 then Int# -> (# Char#, Int# #)
invalid# Int#
1# else
    let !ch2 :: Int#
ch2 = Word# -> Int#
word2Int# (Word# -> Word#
word8ToWord# (Addr# -> Int# -> Word#
indexWord8OffAddr# Addr#
a# Int#
2#)) in
    if Int# -> Bool
noValidUtf8Cont# Int#
ch2 then Int# -> (# Char#, Int# #)
invalid# Int#
2# else
    (# Int# -> Char#
chr# (((Int#
ch0 Int# -> Int# -> Int#
`andI#` Int#
0x1F#) Int# -> Int# -> Int#
`uncheckedIShiftL#` Int#
12#) Int# -> Int# -> Int#
`orI#`
             ((Int#
ch1 Int# -> Int# -> Int#
`andI#` Int#
0x7F#) Int# -> Int# -> Int#
`uncheckedIShiftL#` Int#
6#)  Int# -> Int# -> Int#
`orI#`
              (Int#
ch2 Int# -> Int# -> Int#
`andI#` Int#
0x7F#)),
       Int#
3# #)

{-# INLINE readChar3# #-}
readChar3# :: Addr# -> Int# -> (# Char#, Int# #)
readChar3# :: Addr# -> Int# -> (# Char#, Int# #)
readChar3# Addr#
a# Int#
ch0 =
    let !ch1 :: Int#
ch1 = Word# -> Int#
word2Int# (Word# -> Word#
word8ToWord# (Addr# -> Int# -> Word#
indexWord8OffAddr# Addr#
a# Int#
1#)) in
    if Int# -> Bool
noValidUtf8Cont# Int#
ch1 then Int# -> (# Char#, Int# #)
invalid# Int#
1# else
    let !ch2 :: Int#
ch2 = Word# -> Int#
word2Int# (Word# -> Word#
word8ToWord# (Addr# -> Int# -> Word#
indexWord8OffAddr# Addr#
a# Int#
2#)) in
    if Int# -> Bool
noValidUtf8Cont# Int#
ch2 then Int# -> (# Char#, Int# #)
invalid# Int#
2# else
    let !ch3 :: Int#
ch3 = Word# -> Int#
word2Int# (Word# -> Word#
word8ToWord# (Addr# -> Int# -> Word#
indexWord8OffAddr# Addr#
a# Int#
3#)) in
    if Int# -> Bool
noValidUtf8Cont# Int#
ch3 then Int# -> (# Char#, Int# #)
invalid# Int#
3# else
    (# Int# -> Char#
chr# (((Int#
ch0 Int# -> Int# -> Int#
`andI#` Int#
0x0F#) Int# -> Int# -> Int#
`uncheckedIShiftL#` Int#
18#) Int# -> Int# -> Int#
`orI#`
             ((Int#
ch1 Int# -> Int# -> Int#
`andI#` Int#
0x7F#) Int# -> Int# -> Int#
`uncheckedIShiftL#` Int#
12#) Int# -> Int# -> Int#
`orI#`
             ((Int#
ch2 Int# -> Int# -> Int#
`andI#` Int#
0x7F#) Int# -> Int# -> Int#
`uncheckedIShiftL#` Int#
6#)  Int# -> Int# -> Int#
`orI#`
              (Int#
ch3 Int# -> Int# -> Int#
`andI#` Int#
0x7F#)),
       Int#
4# #)

{-# INLINE noValidUtf8Cont# #-}
noValidUtf8Cont# :: Int# -> Bool
noValidUtf8Cont# :: Int# -> Bool
noValidUtf8Cont# Int#
x = Int# -> Bool
isTrue# ((Int#
x Int# -> Int# -> Int#
<# Int#
0x80#) Int# -> Int# -> Int#
`orI#` (Int#
x Int# -> Int# -> Int#
># Int#
0xBF#))

{-# INLINE startsWith0# #-}
startsWith0# :: Int# -> Bool
startsWith0# :: Int# -> Bool
startsWith0# Int#
x = Int# -> Bool
isTrue# ((Int#
x Int# -> Int# -> Int#
`andI#` Int#
0x80#) Int# -> Int# -> Int#
==# Int#
0#)

{-# INLINE startsWith10# #-}
startsWith10# :: Int# -> Bool
startsWith10# :: Int# -> Bool
startsWith10# Int#
x = Int# -> Bool
isTrue# ((Int#
x Int# -> Int# -> Int#
`andI#` Int#
0xC0#) Int# -> Int# -> Int#
==# Int#
0x80#)

{-# INLINE startsWith110# #-}
startsWith110# :: Int# -> Bool
startsWith110# :: Int# -> Bool
startsWith110# Int#
x = Int# -> Bool
isTrue# ((Int#
x Int# -> Int# -> Int#
`andI#` Int#
0xE0#) Int# -> Int# -> Int#
==# Int#
0xC0#)

{-# INLINE startsWith1110# #-}
startsWith1110# :: Int# -> Bool
startsWith1110# :: Int# -> Bool
startsWith1110# Int#
x = Int# -> Bool
isTrue# ((Int#
x Int# -> Int# -> Int#
`andI#` Int#
0xF0#) Int# -> Int# -> Int#
==# Int#
0xE0#)

{-# INLINE startsWith11110# #-}
startsWith11110# :: Int# -> Bool
startsWith11110# :: Int# -> Bool
startsWith11110# Int#
x = Int# -> Bool
isTrue# ((Int#
x Int# -> Int# -> Int#
`andI#` Int#
0xF8#) Int# -> Int# -> Int#
==# Int#
0xF0#)

{-# INLINE utf8SizeChar# #-}
utf8SizeChar# :: Addr# -> Int#
utf8SizeChar# :: Addr# -> Int#
utf8SizeChar# Addr#
a# =
    case Word# -> Word#
word8ToWord# (Addr# -> Int# -> Word#
indexWord8OffAddr# Addr#
a# Int#
0#) of
        Word#
0## -> Int#
0#
        !Word#
x# ->
            let !ch0 :: Int#
ch0 = Word# -> Int#
word2Int# Word#
x# in
            if  | Int# -> Bool
startsWith0# Int#
ch0     -> Int#
1#
                | Int# -> Bool
startsWith110# Int#
ch0   -> Int#
2#
                | Int# -> Bool
startsWith1110# Int#
ch0  -> Int#
3#
                | Int# -> Bool
startsWith11110# Int#
ch0 -> Int#
4#
                | Bool
otherwise            -> Int#
1#