{-# 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
, alexInputPrevChar
, alexGetByte
) where
import Control.Applicative as A
import Control.DeepSeq
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
data AlexState = AlexState
{ AlexState -> AlexInput
asInput :: {-# UNPACK #-} !AlexInput
, AlexState -> Word64
asIntStore :: {-# UNPACK #-} !Word64
, 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 #-}
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 #-}
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 #-}
asCodeL :: Lens' AlexState AlexCode
asCommentDepthL, asQuasiquoterDepthL, asIndentationSizeL :: Lens' AlexState Int16
asPreprocessorDepthL :: Lens' AlexState Int16
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
= (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
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 =
ByteString -> (AlexInput -> Int -> (a, [Token])) -> (a, [Token])
forall a. ByteString -> (AlexInput -> Int -> a) -> a
withAlexInput ByteString
input ((AlexInput -> Int -> (a, [Token])) -> (a, [Token]))
-> (AlexInput -> Int -> (a, [Token])) -> (a, [Token])
forall a b. (a -> b) -> a -> b
$ \AlexInput
input' Int
inputSize ->
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'
in if Bool
trackPrefixesAndOffsets
then
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
!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
in [Token]
res [Token] -> (a, [Token]) -> (a, [Token])
forall a b. NFData a => a -> b -> b
`deepseq` (a
a, [Token]
res)
else
(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
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
} 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 #-}
aiLineL :: Lens' AlexInput 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 withAlexInput #-}
withAlexInput :: C8.ByteString -> (AlexInput -> Int -> a) -> a
withAlexInput :: ByteString -> (AlexInput -> Int -> a) -> a
withAlexInput ByteString
s AlexInput -> Int -> a
f =
case ByteString
s' of
BSI.PS ForeignPtr Word8
ptr Int
offset Int
len ->
IO a -> a
forall a. IO a -> a
BSI.accursedUnutterablePerformIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ 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
}
!res :: a
res = AlexInput -> Int -> a
f AlexInput
input (Int -> a) -> Int -> a
forall a b. (a -> b) -> a -> b
$ Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
offset
ForeignPtr Word8 -> IO ()
forall a. ForeignPtr a -> IO ()
touchForeignPtr ForeignPtr Word8
ptr
a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
res
where
initLine :: Line
initLine = Int -> Line
Line Int
0
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
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 Addr# -> Int# -> Word#
indexWord8OffAddr# Addr#
ptr# Int#
0# of
Word#
0## -> Addr#
ptr#
Word#
9## -> Addr#
ptr#
Word#
10## -> Addr#
ptr#
Word#
13## -> Addr#
ptr#
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 #-}
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 }
{-# 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'
where
ch0 :: Int#
!ch0 :: Int#
ch0 = Word# -> Int#
word2Int# (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# (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
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#
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 }
{-# INLINE fixChar #-}
fixChar :: Char# -> Word#
fixChar :: Char# -> Word#
fixChar = \case
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#
| 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##
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 Addr# -> Int# -> Word#
indexWord8OffAddr# Addr#
ptr# Int#
0# of
Word#
0## -> Addr#
ptr#
Word#
10## -> Addr#
ptr#
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 Addr# -> Int# -> Word#
indexWord8OffAddr# Addr#
ptr# Int#
0# of
Word#
0## -> (# Int
n, Addr# -> Ptr Word8
forall a. Addr# -> Ptr a
Ptr Addr#
ptr# #)
Word#
10## -> (# Int
n, Addr# -> Ptr Word8
forall a. Addr# -> Ptr a
Ptr Addr#
ptr# #)
Word#
92## ->
case 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#) #)
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 Addr# -> Int# -> Word#
indexWord8OffAddr# Addr#
ptr# Int#
0# of
Word#
0## -> Addr#
ptr#
Word#
10## -> Addr#
ptr#
Word#
c# | Int# -> Bool
isTrue# (Word#
c# Word# -> Word# -> Int#
`eqWord#` 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 Addr# -> Int# -> Word#
indexWord8OffAddr# Addr#
ptr# Int#
0# of
Word#
0## -> Addr#
ptr#
Word#
10## -> Addr#
ptr#
Word#
c# | Int# -> Bool
isTrue# ((Word#
c# Word# -> Word# -> Int#
`eqWord#` Word#
w1#) Int# -> Int# -> Int#
`orI#` (Word#
c# Word# -> Word# -> Int#
`eqWord#` 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
BSI.accursedUnutterablePerformIO (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
BSI.accursedUnutterablePerformIO (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
BSI.accursedUnutterablePerformIO (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 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#
{-# INLINE invalid# #-}
invalid# :: Int# -> (# Char#, Int# #)
invalid# :: Int# -> (# Char#, Int# #)
invalid# Int#
nBytes# = (# Char#
'\8'#, Int#
nBytes# #)
{-# INLINE readChar1# #-}
readChar1# :: Addr# -> Int# -> (# Char#, Int# #)
readChar1# :: Addr# -> Int# -> (# Char#, Int# #)
readChar1# Addr#
a# Int#
ch0 =
let !ch1 :: Int#
ch1 = Word# -> Int#
word2Int# (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# (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# (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# (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# (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# (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 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#