module Language.GroteTrap.Lexer (
Token(..),
TokenPos,
tokenize, isWhite
) where
import Language.GroteTrap.Language
import Language.GroteTrap.Range
import Text.ParserCombinators.Parsec
data Token
= TId String
| TInt Int
| TOperator String
| TFunction String
| TOpen
| TClose
| TComma
| TWhite Int
deriving (Eq, Show)
isWhite :: Token -> Bool
isWhite (TWhite _) = True
isWhite _ = False
type TokenPos = (Pos, Token)
tokenize :: Language a -> Parser [TokenPos]
tokenize = many . pToken
pToken :: Language a -> Parser TokenPos
pToken lang = choice [try $ pFunction $ functions lang, pId, pInt, pOperator $ operators lang, pOpen, pClose, pComma, pWhite]
savePos :: GenParser tok st t -> GenParser tok st (Pos, t)
savePos p = do pos <- getPos; v <- p; return (pos, v)
getPos = do
pos <- getPosition
return $ sourceColumn pos 1
pId :: Parser TokenPos
pId = savePos $ do
c <- letter
cs <- many $ choice [letter, digit, char '_']
return $ TId (c:cs)
pInt :: Parser TokenPos
pInt = savePos $ many1 digit >>= (return . TInt . read)
pOperator :: [Operator a] -> Parser TokenPos
pOperator = choice . map pOneOperator
pOneOperator :: Operator a -> Parser TokenPos
pOneOperator op = savePos $ string (opToken op) >> return (TOperator (opToken op))
pFunction :: [Function a] -> Parser TokenPos
pFunction = choice . map pOneFunction
pOneFunction :: Function a -> Parser TokenPos
pOneFunction fun = savePos $ string (fnName fun) >> return (TFunction (fnName fun))
pOpen :: Parser TokenPos
pOpen = savePos $ char '(' >> return TOpen
pClose :: Parser TokenPos
pClose = savePos $ char ')' >> return TClose
pComma :: Parser TokenPos
pComma = savePos $ char ',' >> return TComma
pWhite :: Parser TokenPos
pWhite = savePos $ do spaces <- many1 space; return $ TWhite $ length spaces