{-# OPTIONS_GHC -funbox-strict-fields #-}

-- | Utility definitions used by the lexer.  None of the default Alex
-- "wrappers" are precisely what we need.  The code here is highly
-- minimalistic.  Lexers should not be complicated!
module Language.Futhark.Parser.Lexer.Wrapper
  ( initialLexerState,
    AlexInput,
    alexInputPrevChar,
    LexerError (..),
    alexGetByte,
    alexGetPos,
  )
where

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

-- | The input type.  Contains:
--
-- 1. current position
--
-- 2. previous char
--
-- 3. current input string
--
-- 4. bytes consumed so far
type AlexInput =
  ( Pos, -- current position,
    Char, -- previous char
    BS.ByteString, -- current input string
    Int64 -- bytes consumed so far
  )

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 -> Maybe (Byte, AlexInput)
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 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
1
       in Pos
p' Pos -> Maybe (Byte, AlexInput) -> Maybe (Byte, AlexInput)
forall a b. a -> b -> b
`seq` ByteString
cs' ByteString -> Maybe (Byte, AlexInput) -> Maybe (Byte, AlexInput)
forall a b. a -> b -> b
`seq` Int64
n' Int64 -> Maybe (Byte, AlexInput) -> Maybe (Byte, AlexInput)
forall a b. a -> b -> b
`seq` (Byte, AlexInput) -> Maybe (Byte, AlexInput)
forall a. a -> Maybe a
Just (Byte
b, (Pos
p', Char
c, ByteString
cs', Int64
n'))

alexGetPos :: AlexInput -> Pos
alexGetPos :: AlexInput -> Pos
alexGetPos (Pos
pos, Char
_, ByteString
_, Int64
_) = Pos
pos

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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
tabSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- ((Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
tabSize)) (Int
a Int -> Int -> Int
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
1 (Int
a Int -> Int -> Int
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

initialLexerState :: Pos -> BS.ByteString -> AlexInput
initialLexerState :: Pos -> ByteString -> AlexInput
initialLexerState Pos
start_pos ByteString
input =
  (Pos
start_pos, Char
'\n', ByteString
input, Int64
0)

data LexerError = LexerError Loc T.Text

instance Show LexerError where
  show :: LexerError -> FilePath
show (LexerError Loc
_ Text
s) = Text -> FilePath
T.unpack Text
s