diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/Eval.hs | 6 | ||||
-rw-r--r-- | src/Helper.hs | 1 | ||||
-rw-r--r-- | src/Parser.hs | 83 |
3 files changed, 45 insertions, 45 deletions
diff --git a/src/Eval.hs b/src/Eval.hs index a5c29bf..e0a36ad 100644 --- a/src/Eval.hs +++ b/src/Eval.hs @@ -15,7 +15,7 @@ import System.Console.Haskeline import System.Environment import System.Exit import System.IO -import Text.Parsec hiding ( State +import Text.Megaparsec hiding ( State , try ) @@ -61,7 +61,7 @@ evalTest exp1 exp2 = eval :: [String] -> Environment -> IO Environment eval [] env = pure env eval (line : ls) env = case parse parseLine "FILE" line of - Left err -> print err >> pure env + Left err -> print (errorBundlePretty err) >> pure env Right instr -> case instr of Define name exp -> let (res, env') = evalDefine name exp `runState` env @@ -116,7 +116,7 @@ evalFunc func env = do -- TODO: Generally improve eval code evalRepl :: String -> Environment -> InputT IO Environment evalRepl line env = case parse parseReplLine "REPL" line of - Left err -> outputStrLn (show err) >> pure env + Left err -> outputStrLn (errorBundlePretty err) >> pure env Right instr -> case instr of Define name exp -> let (res, env') = evalDefine name exp `runState` env diff --git a/src/Helper.hs b/src/Helper.hs index 60941be..0045bd1 100644 --- a/src/Helper.hs +++ b/src/Helper.hs @@ -1,7 +1,6 @@ module Helper where import Control.Monad.State -import Text.Parsec hiding ( State ) data Error = UndeclaredFunction String | DuplicateFunction String | InvalidIndex Int | FatalError String instance Show Error where diff --git a/src/Parser.hs b/src/Parser.hs index 6df479d..16f4202 100644 --- a/src/Parser.hs +++ b/src/Parser.hs @@ -5,71 +5,72 @@ module Parser import Control.Monad ( ap ) import Data.Functor.Identity +import Data.Void import Helper -import Text.Parsec hiding ( parseTest ) -import Text.Parsec.Language -import qualified Text.Parsec.Token as Token +import Text.Megaparsec hiding ( parseTest ) +import Text.Megaparsec.Char +import qualified Text.Megaparsec.Char.Lexer as L -languageDef :: GenLanguageDef String u Identity -languageDef = emptyDef { Token.commentLine = "#" - , Token.identStart = letter <|> char '_' - , Token.identLetter = alphaNum <|> oneOf "?!'_" - , Token.reservedOpNames = ["[", "]", "="] - } +type Parser = Parsec Void String -type Parser = Parsec String () +sc :: Parser () +sc = L.space space1 empty empty -lexer :: Token.GenTokenParser String u Identity -lexer = Token.makeTokenParser languageDef +lexeme :: Parser a -> Parser a +lexeme = L.lexeme sc -identifier :: Parser String -identifier = Token.identifier lexer +symbol :: String -> Parser String +symbol = L.symbol sc -reservedOp :: String -> Parser () -reservedOp = Token.reservedOp lexer +identifier :: Parser String +identifier = lexeme + ((:) <$> (letterChar <|> char '_') <*> many (alphaNumChar <|> oneOf "?!'_")) parens :: Parser a -> Parser a -parens = Token.parens lexer +parens = between (symbol "(") (symbol ")") almostAnything :: Parser String almostAnything = - many1 $ oneOf ".`#~@$%^&*_+-=|;',/?[]<>(){} " <|> letter <|> digit + some $ oneOf ".`#~@$%^&*_+-=|;',/?[]<>(){} " <|> letterChar <|> digitChar importPath :: Parser String -importPath = many1 $ oneOf "./_+-" <|> letter <|> digit +importPath = some $ oneOf "./_+-" <|> letterChar <|> digitChar parseAbstraction :: Parser Expression parseAbstraction = do - reservedOp "[" + symbol "[" exp <- parseExpression - reservedOp "]" + symbol "]" pure $ Abstraction exp parseApplication :: Parser Expression parseApplication = do - s <- sepBy1 parseSingleton spaces + s <- sepBy1 parseSingleton space pure $ foldl1 Application s parseBruijn :: Parser Expression parseBruijn = do - idx <- digit - spaces + idx <- digitChar + space pure $ Bruijn $ (read . pure) idx parseNumeral :: Parser Expression parseNumeral = do num <- number - spaces + space pure $ decimalToBinary num where - sign = (char '-' >> return negate) <|> (char '+' >> return id) - nat = read <$> many1 digit + sign :: Parser (Integer -> Integer) + sign = (char '-' >> return negate) <|> (char '+' >> return id) + nat :: Parser Integer + nat = read <$> some digitChar + number :: Parser Integer number = ap sign nat parseVariable :: Parser Expression parseVariable = do var <- identifier - spaces + space pure $ Variable var parseSingleton :: Parser Expression @@ -82,9 +83,9 @@ parseSingleton = parseExpression :: Parser Expression parseExpression = do - spaces + space expr <- parseApplication <|> parseSingleton - spaces + space pure expr parseEvaluate :: Parser Instruction @@ -93,15 +94,15 @@ parseEvaluate = Evaluate <$> parseExpression parseDefine :: Parser Instruction parseDefine = do var <- identifier - spaces + space Define var <$> parseExpression parseReplDefine :: Parser Instruction parseReplDefine = do var <- identifier - spaces - reservedOp "=" - spaces + space + symbol "=" + space Define var <$> parseExpression parseComment :: Parser Instruction @@ -110,26 +111,26 @@ parseComment = string "#" >> Comment <$> almostAnything parseImport :: Parser Instruction parseImport = do string ":import " - spaces + space path <- importPath - spaces + space pure $ Import $ path ++ ".bruijn" parsePrint :: Parser Instruction parsePrint = do string ":print " - spaces + space exp <- parseExpression - spaces + space pure $ Evaluate exp parseTest :: Parser Instruction parseTest = do string ":test " exp1 <- parseExpression - spaces - reservedOp "=" - spaces + space + symbol "=" + space exp2 <- parseExpression pure $ Test exp1 exp2 |