James Eversole
7ae470a4ae
Implemented evaluation of tree calculus terms alongside referentially transparent variable identifiers. Implemented evaluation of defined functions into tree calculus.
82 lines
1.7 KiB
Haskell
82 lines
1.7 KiB
Haskell
module Lexer where
|
|
|
|
import Research
|
|
import Text.Megaparsec
|
|
import Text.Megaparsec.Char
|
|
import Data.Void
|
|
|
|
type Lexer = Parsec Void String
|
|
data LToken
|
|
= LKeywordT
|
|
| LIdentifier String
|
|
| LIntegerLiteral Int
|
|
| LStringLiteral String
|
|
| LAssign
|
|
| LOpenParen
|
|
| LCloseParen
|
|
| LOpenBracket
|
|
| LCloseBracket
|
|
| LNewline
|
|
deriving (Show, Eq, Ord)
|
|
|
|
keywordT :: Lexer LToken
|
|
keywordT = string "t" *> notFollowedBy alphaNumChar *> pure LKeywordT
|
|
|
|
identifier :: Lexer LToken
|
|
identifier = do
|
|
name <- some (letterChar <|> char '_' <|> char '-')
|
|
if name == "t"
|
|
then fail "Keyword 't' cannot be used as an identifier"
|
|
else return (LIdentifier name)
|
|
|
|
integerLiteral :: Lexer LToken
|
|
integerLiteral = do
|
|
num <- some digitChar
|
|
return (LIntegerLiteral (read num))
|
|
|
|
stringLiteral :: Lexer LToken
|
|
stringLiteral = do
|
|
char '"'
|
|
content <- many (noneOf ['"'])
|
|
char '"' --"
|
|
return (LStringLiteral content)
|
|
|
|
assign :: Lexer LToken
|
|
assign = char '=' *> pure LAssign
|
|
|
|
openParen :: Lexer LToken
|
|
openParen = char '(' *> pure LOpenParen
|
|
|
|
closeParen :: Lexer LToken
|
|
closeParen = char ')' *> pure LCloseParen
|
|
|
|
openBracket :: Lexer LToken
|
|
openBracket = char '[' *> pure LOpenBracket
|
|
|
|
closeBracket :: Lexer LToken
|
|
closeBracket = char ']' *> pure LCloseBracket
|
|
|
|
lnewline :: Lexer LToken
|
|
lnewline = char '\n' *> pure LNewline
|
|
|
|
sc :: Lexer ()
|
|
sc = skipMany (char ' ' <|> char '\t')
|
|
|
|
saplingLexer :: Lexer [LToken]
|
|
saplingLexer = many (sc *> choice
|
|
[ try keywordT
|
|
, try identifier
|
|
, try integerLiteral
|
|
, try stringLiteral
|
|
, assign
|
|
, openParen
|
|
, closeParen
|
|
, openBracket
|
|
, closeBracket
|
|
, lnewline
|
|
]) <* eof
|
|
|
|
lexSapling input = case runParser saplingLexer "" input of
|
|
Left err -> error "Failed to lex input"
|
|
Right tokens -> tokens
|