{-# OPTIONS_GHC -funbox-strict-fields #-}
module Language.Futhark.Parser.Lexer.Wrapper
( runAlex,
Alex,
AlexInput,
alexInputPrevChar,
Byte,
LexerError (..),
alexSetInput,
alexGetInput,
alexGetByte,
alexGetStartCode,
alexError,
alexGetPos,
)
where
import Control.Applicative (liftA)
import Data.ByteString.Internal qualified as BS (w2c)
import Data.ByteString.Lazy qualified as BS
import Data.Int (Int64)
import Data.Loc (Loc, Pos (..))
import Data.Text qualified as T
import Data.Word (Word8)
type Byte = Word8
type AlexInput =
( Pos,
Char,
BS.ByteString,
Int64
)
alexInputPrevChar :: AlexInput -> Char
alexInputPrevChar :: AlexInput -> Char
alexInputPrevChar (Pos
_, Char
prev, ByteString
_, Int64
_) = Char
prev
{-# INLINE alexGetByte #-}
alexGetByte :: AlexInput -> Maybe (Byte, AlexInput)
alexGetByte :: AlexInput -> Maybe (Byte, AlexInput)
alexGetByte (Pos
p, Char
_, ByteString
cs, Int64
n) =
case ByteString -> Maybe (Byte, ByteString)
BS.uncons ByteString
cs of
Maybe (Byte, ByteString)
Nothing -> forall a. Maybe a
Nothing
Just (Byte
b, ByteString
cs') ->
let c :: Char
c = Byte -> Char
BS.w2c Byte
b
p' :: Pos
p' = Pos -> Char -> Pos
alexMove Pos
p Char
c
n' :: Int64
n' = Int64
n forall a. Num a => a -> a -> a
+ Int64
1
in Pos
p' seq :: forall a b. a -> b -> b
`seq` ByteString
cs' seq :: forall a b. a -> b -> b
`seq` Int64
n' seq :: forall a b. a -> b -> b
`seq` forall a. a -> Maybe a
Just (Byte
b, (Pos
p', Char
c, ByteString
cs', Int64
n'))
tabSize :: Int
tabSize :: Int
tabSize = Int
8
{-# INLINE alexMove #-}
alexMove :: Pos -> Char -> Pos
alexMove :: Pos -> Char -> Pos
alexMove (Pos !FilePath
f !Int
l !Int
c !Int
a) Char
'\t' = FilePath -> Int -> Int -> Int -> Pos
Pos FilePath
f Int
l (Int
c forall a. Num a => a -> a -> a
+ Int
tabSize forall a. Num a => a -> a -> a
- ((Int
c forall a. Num a => a -> a -> a
- Int
1) forall a. Integral a => a -> a -> a
`mod` Int
tabSize)) (Int
a forall a. Num a => a -> a -> a
+ Int
1)
alexMove (Pos !FilePath
f !Int
l Int
_ !Int
a) Char
'\n' = FilePath -> Int -> Int -> Int -> Pos
Pos FilePath
f (Int
l forall a. Num a => a -> a -> a
+ Int
1) Int
1 (Int
a forall a. Num a => a -> a -> a
+ Int
1)
alexMove (Pos !FilePath
f !Int
l !Int
c !Int
a) Char
_ = FilePath -> Int -> Int -> Int -> Pos
Pos FilePath
f Int
l (Int
c forall a. Num a => a -> a -> a
+ Int
1) (Int
a forall a. Num a => a -> a -> a
+ Int
1)
data AlexState = AlexState
{ AlexState -> Pos
alex_pos :: !Pos,
AlexState -> Int64
alex_bpos :: !Int64,
AlexState -> ByteString
alex_inp :: BS.ByteString,
AlexState -> Char
alex_chr :: !Char,
AlexState -> Int
alex_scd :: !Int
}
runAlex :: Pos -> BS.ByteString -> Alex a -> Either LexerError a
runAlex :: forall a. Pos -> ByteString -> Alex a -> Either LexerError a
runAlex Pos
start_pos ByteString
input (Alex AlexState -> Either LexerError (AlexState, a)
f) =
case AlexState -> Either LexerError (AlexState, a)
f
( AlexState
{ alex_pos :: Pos
alex_pos = Pos
start_pos,
alex_bpos :: Int64
alex_bpos = Int64
0,
alex_inp :: ByteString
alex_inp = ByteString
input,
alex_chr :: Char
alex_chr = Char
'\n',
alex_scd :: Int
alex_scd = Int
0
}
) of
Left LexerError
msg -> forall a b. a -> Either a b
Left LexerError
msg
Right (AlexState
_, a
a) -> forall a b. b -> Either a b
Right a
a
newtype Alex a = Alex {forall a. Alex a -> AlexState -> Either LexerError (AlexState, a)
unAlex :: AlexState -> Either LexerError (AlexState, a)}
data LexerError = LexerError Loc T.Text
instance Show LexerError where
show :: LexerError -> FilePath
show (LexerError Loc
_ Text
s) = Text -> FilePath
T.unpack Text
s
instance Functor Alex where
fmap :: forall a b. (a -> b) -> Alex a -> Alex b
fmap = forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b
liftA
instance Applicative Alex where
pure :: forall a. a -> Alex a
pure a
a = forall a. (AlexState -> Either LexerError (AlexState, a)) -> Alex a
Alex forall a b. (a -> b) -> a -> b
$ \AlexState
s -> forall a b. b -> Either a b
Right (AlexState
s, a
a)
Alex (a -> b)
fa <*> :: forall a b. Alex (a -> b) -> Alex a -> Alex b
<*> Alex a
a = forall a. (AlexState -> Either LexerError (AlexState, a)) -> Alex a
Alex forall a b. (a -> b) -> a -> b
$ \AlexState
s -> case forall a. Alex a -> AlexState -> Either LexerError (AlexState, a)
unAlex Alex (a -> b)
fa AlexState
s of
Left LexerError
msg -> forall a b. a -> Either a b
Left LexerError
msg
Right (AlexState
s', a -> b
f) -> case forall a. Alex a -> AlexState -> Either LexerError (AlexState, a)
unAlex Alex a
a AlexState
s' of
Left LexerError
msg -> forall a b. a -> Either a b
Left LexerError
msg
Right (AlexState
s'', a
b) -> forall a b. b -> Either a b
Right (AlexState
s'', a -> b
f a
b)
instance Monad Alex where
Alex a
m >>= :: forall a b. Alex a -> (a -> Alex b) -> Alex b
>>= a -> Alex b
k = forall a. (AlexState -> Either LexerError (AlexState, a)) -> Alex a
Alex forall a b. (a -> b) -> a -> b
$ \AlexState
s -> case forall a. Alex a -> AlexState -> Either LexerError (AlexState, a)
unAlex Alex a
m AlexState
s of
Left LexerError
msg -> forall a b. a -> Either a b
Left LexerError
msg
Right (AlexState
s', a
a) -> forall a. Alex a -> AlexState -> Either LexerError (AlexState, a)
unAlex (a -> Alex b
k a
a) AlexState
s'
alexGetInput :: Alex AlexInput
alexGetInput :: Alex AlexInput
alexGetInput =
forall a. (AlexState -> Either LexerError (AlexState, a)) -> Alex a
Alex forall a b. (a -> b) -> a -> b
$ \s :: AlexState
s@AlexState {alex_pos :: AlexState -> Pos
alex_pos = Pos
pos, alex_bpos :: AlexState -> Int64
alex_bpos = Int64
bpos, alex_chr :: AlexState -> Char
alex_chr = Char
c, alex_inp :: AlexState -> ByteString
alex_inp = ByteString
inp} ->
forall a b. b -> Either a b
Right (AlexState
s, (Pos
pos, Char
c, ByteString
inp, Int64
bpos))
alexSetInput :: AlexInput -> Alex ()
alexSetInput :: AlexInput -> Alex ()
alexSetInput (Pos
pos, Char
c, ByteString
inp, Int64
bpos) =
forall a. (AlexState -> Either LexerError (AlexState, a)) -> Alex a
Alex forall a b. (a -> b) -> a -> b
$ \AlexState
s -> case AlexState
s
{ alex_pos :: Pos
alex_pos = Pos
pos,
alex_bpos :: Int64
alex_bpos = Int64
bpos,
alex_chr :: Char
alex_chr = Char
c,
alex_inp :: ByteString
alex_inp = ByteString
inp
} of
state :: AlexState
state@AlexState {} -> forall a b. b -> Either a b
Right (AlexState
state, ())
alexError :: Loc -> T.Text -> Alex a
alexError :: forall a. Loc -> Text -> Alex a
alexError Loc
loc Text
message = forall a. (AlexState -> Either LexerError (AlexState, a)) -> Alex a
Alex forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Loc -> Text -> LexerError
LexerError Loc
loc Text
message
alexGetStartCode :: Alex Int
alexGetStartCode :: Alex Int
alexGetStartCode = forall a. (AlexState -> Either LexerError (AlexState, a)) -> Alex a
Alex forall a b. (a -> b) -> a -> b
$ \s :: AlexState
s@AlexState {alex_scd :: AlexState -> Int
alex_scd = Int
sc} -> forall a b. b -> Either a b
Right (AlexState
s, Int
sc)
alexGetPos :: Alex Pos
alexGetPos :: Alex Pos
alexGetPos = forall a. (AlexState -> Either LexerError (AlexState, a)) -> Alex a
Alex forall a b. (a -> b) -> a -> b
$ \AlexState
s -> forall a b. b -> Either a b
Right (AlexState
s, AlexState -> Pos
alex_pos AlexState
s)