module Language.Lua.LexerUtils where
import Control.DeepSeq (NFData(..))
import Data.Char (ord)
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Word (Word8)
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative (Applicative(..))
#endif
import Language.Lua.Token
data LexToken a = LexToken
{ ltokToken :: Token
, ltokPos :: a
, ltokLexeme :: Text
} deriving (Show,Eq)
instance Functor LexToken where
fmap f l = l { ltokPos = f (ltokPos l) }
abortMode :: Maybe SourcePos -> Mode -> [LexToken SourcePos]
abortMode mb mode =
case mode of
QuoteMode (AlexInput start rest) _ True ->
[ LexToken{ltokToken=TokUntermComment, ltokPos=start, ltokLexeme=keep start rest} ]
QuoteMode (AlexInput start rest) _ False ->
[ LexToken{ltokToken=TokUntermString, ltokPos=start, ltokLexeme=keep start rest} ]
SingleQuoteMode (AlexInput start rest) ->
[ LexToken{ltokToken=TokUntermString, ltokPos=start, ltokLexeme=keep start rest} ]
DoubleQuoteMode (AlexInput start rest) ->
[ LexToken{ltokToken=TokUntermString, ltokPos=start, ltokLexeme=keep start rest} ]
_ -> []
where
keep start str =
case mb of
Nothing -> str
Just end -> Text.take (sourcePosIndex end sourcePosIndex start) str
unexpectedChar :: Action
unexpectedChar len (AlexInput posn s) mode = (NormalMode, abortMode (Just posn) mode ++ [t])
where
t = LexToken
{ ltokToken = TokUnexpected
, ltokPos = posn
, ltokLexeme = Text.take len s
}
type Action =
Int ->
AlexInput ->
Mode ->
(Mode, [LexToken SourcePos])
enterLongString :: Action
enterLongString len inp _ = (QuoteMode inp len False, [])
enterSingleString :: Action
enterSingleString _ inp _ = (SingleQuoteMode inp, [])
enterDoubleString :: Action
enterDoubleString _ inp _ = (DoubleQuoteMode inp, [])
enterLongComment :: Action
enterLongComment len inp _ = (QuoteMode inp (len 2) True, [])
enterComment :: Action
enterComment _ inp _ = (CommentMode inp, [])
longToken ::
AlexInput ->
SourcePos ->
Int ->
Token ->
LexToken SourcePos
longToken (AlexInput start text) posn len t = LexToken
{ ltokToken = t
, ltokPos = start
, ltokLexeme = str
}
where
commentLength = sourcePosIndex posn sourcePosIndex start + len
str = Text.take commentLength text
endStringPredicate ::
Mode ->
AlexInput ->
Int ->
AlexInput ->
Bool
endStringPredicate mode _ len _ =
case mode of
QuoteMode _ startlen _ -> len == startlen
_ -> False
endMode :: Action
endMode len (AlexInput posn _) mode = (NormalMode, [lexeme])
where
lexeme =
case mode of
SingleQuoteMode inp -> longToken inp posn len TokSLit
DoubleQuoteMode inp -> longToken inp posn len TokSLit
CommentMode inp -> longToken inp posn len TokComment
QuoteMode inp _ isComment -> longToken inp posn len
$ if isComment then TokComment
else TokSLit
NormalMode -> error "endMode: internal lexer error"
tok :: Token -> Action
tok token len (AlexInput posn s) mode = (mode, [t])
where
t = LexToken
{ ltokToken = token
, ltokPos = posn
, ltokLexeme = Text.take len s
}
dropSpecialComment :: Text -> Text
dropSpecialComment text
| "#" `Text.isPrefixOf` text = Text.dropWhile (/='\n') text
| otherwise = text
dropWhiteSpace :: [LexToken a] -> [LexToken a]
dropWhiteSpace = filter (not . isWhite . ltokToken)
where
isWhite TokWhiteSpace = True
isWhite TokComment = True
isWhite _ = False
data SourcePos = SourcePos
{ sourcePosName :: String
, sourcePosIndex, sourcePosLine, sourcePosColumn :: !Int
}
deriving (Show,Eq)
instance NFData SourcePos where
rnf (SourcePos _ _ _ _) = ()
startPos :: String -> SourcePos
startPos n = SourcePos n 0 1 1
alexInputPrevChar :: a -> ()
alexInputPrevChar _ = ()
alexGetByte :: AlexInput -> Maybe (Word8,AlexInput)
alexGetByte (AlexInput p text) =
do (c,text') <- Text.uncons text
let p' = move p c
x = fromIntegral (min 127 (ord c))
inp = AlexInput p' text'
x `seq` inp `seq` return (x, inp)
move :: SourcePos -> Char -> SourcePos
move (SourcePos name index line column) c =
case c of
'\t' -> SourcePos name (index+1) line (((column + 7) `div` 8) * 8 + 1)
'\n' -> SourcePos name (index+1) (line + 1) 1
_ -> SourcePos name (index+1) line (column + 1)
data AlexInput = AlexInput
{ input_pos :: !SourcePos
, input_text :: !Text
}
data Mode
= NormalMode
| SingleQuoteMode AlexInput
| DoubleQuoteMode AlexInput
| CommentMode AlexInput
| QuoteMode AlexInput
Int
Bool