{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}
module Language.Sexp.LexerInterface
( LineCol(..)
, AlexInput(..)
, mkAlexInput
, alexInputPrevChar
, alexGetByte
) where
import Data.Int
import Data.ByteString.Lazy (ByteString, uncons)
import Data.ByteString.Lazy.UTF8 (decode)
import Data.Word (Word8)
data LineCol = LineCol {-# UNPACK #-} !Int {-# UNPACK #-} !Int
columnsInTab :: Int
columnsInTab = 8
advanceLineCol :: Char -> LineCol -> LineCol
advanceLineCol '\n' (LineCol line _) = LineCol (line + 1) 0
advanceLineCol '\t' (LineCol line col) = LineCol line (((col + columnsInTab - 1) `div` columnsInTab) * columnsInTab + 1)
advanceLineCol _ (LineCol line col) = LineCol line (col + 1)
data AlexInput = AlexInput
{ aiInput :: ByteString
, aiPrevChar :: {-# UNPACK #-} !Char
, aiCurChar :: {-# UNPACK #-} !Char
, aiBytesLeft :: {-# UNPACK #-} !Int64
, aiLineCol :: !LineCol
}
mkAlexInput :: LineCol -> ByteString -> AlexInput
mkAlexInput initPos source = alexNextChar $ AlexInput
{ aiInput = source
, aiPrevChar = '\n'
, aiCurChar = '\n'
, aiBytesLeft = 0
, aiLineCol = initPos
}
alexNextChar :: AlexInput -> AlexInput
alexNextChar input =
case decode (aiInput input) of
Just (c, n) -> input
{ aiPrevChar = aiCurChar input
, aiCurChar = c
, aiBytesLeft = n
}
Nothing -> input
{ aiPrevChar = aiCurChar input
, aiCurChar = '\n'
, aiBytesLeft = 0
}
alexPropagatePos :: AlexInput -> AlexInput
alexPropagatePos input =
input { aiLineCol = advanceLineCol (aiPrevChar input) (aiLineCol input) }
alexInputPrevChar :: AlexInput -> Char
alexInputPrevChar = aiPrevChar
alexGetByte :: AlexInput -> Maybe (Word8, AlexInput)
alexGetByte input
| aiBytesLeft input == 0 = go . alexPropagatePos . alexNextChar $ input
| otherwise = go input
where
go :: AlexInput -> Maybe (Word8, AlexInput)
go input =
case uncons (aiInput input) of
Just (w, rest) -> Just (w, input
{ aiBytesLeft = aiBytesLeft input - 1
, aiInput = rest
})
Nothing -> Nothing