diff options
| -rw-r--r-- | bruijn.cabal | 6 | ||||
| -rw-r--r-- | package.yaml | 2 | ||||
| -rw-r--r-- | src/Eval.hs | 6 | ||||
| -rw-r--r-- | src/Helper.hs | 1 | ||||
| -rw-r--r-- | src/Parser.hs | 83 |
5 files changed, 49 insertions, 49 deletions
diff --git a/bruijn.cabal b/bruijn.cabal index 999d6ab..67239d3 100644 --- a/bruijn.cabal +++ b/bruijn.cabal @@ -41,8 +41,8 @@ library , bytestring , containers , haskeline + , megaparsec , mtl - , parsec default-language: Haskell2010 executable bruijn @@ -61,8 +61,8 @@ executable bruijn , bytestring , containers , haskeline + , megaparsec , mtl - , parsec default-language: Haskell2010 test-suite bruijn-test @@ -82,6 +82,6 @@ test-suite bruijn-test , bytestring , containers , haskeline + , megaparsec , mtl - , parsec default-language: Haskell2010 diff --git a/package.yaml b/package.yaml index c864ddf..3be1804 100644 --- a/package.yaml +++ b/package.yaml @@ -26,7 +26,7 @@ dependencies: - base >= 4.7 && < 5 - mtl - haskeline -- parsec +- megaparsec - containers - bytestring - bitstring 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 |