Change Parser from string to text

archive/forth
Ethan Reece 2023-09-29 22:59:25 -05:00
parent 7f588ec561
commit e7083c1c40
Signed by: me
GPG Key ID: D3993665FF92E1C3
3 changed files with 17 additions and 7 deletions

View File

@ -1,22 +1,24 @@
-- see https://markkarpov.com/tutorial/megaparsec.html -- see https://markkarpov.com/tutorial/megaparsec.html
{-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE OverloadedStrings #-}
module Forth.Parser (parseExpr, ParseResult) where module Forth.Parser (parseExpr, ParseResult) where
import Control.Monad.Combinators.Expr import Control.Monad.Combinators.Expr
import Data.Functor.Identity qualified import Data.Functor.Identity qualified
import Data.Text.Lazy
import Data.Void (Void) import Data.Void (Void)
import Forth.Types.Expr import Forth.Types.Expr
import Text.Megaparsec as MP import Text.Megaparsec as MP
import Text.Megaparsec.Char as C import Text.Megaparsec.Char as C
import Text.Megaparsec.Char.Lexer as L import Text.Megaparsec.Char.Lexer as L
type Parser = Parsec Void String type Parser = Parsec Void Text
lexemeParser :: Parser a -> Parser a lexemeParser :: Parser a -> Parser a
lexemeParser = L.lexeme C.space lexemeParser = L.lexeme C.space
symbolParser :: String -> Parser String symbolParser :: Text -> Parser Text
symbolParser = L.symbol C.space symbolParser = L.symbol C.space
intParser :: Parser Int intParser :: Parser Int
@ -32,18 +34,25 @@ table =
], ],
[ binaryOp "+" Add, [ binaryOp "+" Add,
binaryOp "-" Sub binaryOp "-" Sub
-- binaryOp "." Pop
] ]
] ]
binaryOp :: String -> (a -> a -> a) -> Operator (ParsecT Void String Data.Functor.Identity.Identity) a binaryOp :: Text -> (a -> a -> a) -> Operator (ParsecT Void Text Data.Functor.Identity.Identity) a
binaryOp name f = InfixL (f <$ symbolParser name) binaryOp name f = InfixL (f <$ symbolParser name)
-- prefixOp :: Text -> (a -> a) -> Operator (ParsecT Void Text Data.Functor.Identity.Identity) a
-- prefixOp name f = Prefix (f <$ symbolParser name)
-- postfixOp :: Text -> (a -> a) -> Operator (ParsecT Void Text Data.Functor.Identity.Identity) a
-- postfixOp name f = Postfix (f <$ symbolParser name)
expr :: Parser Expr expr :: Parser Expr
expr = makeExprParser term table expr = makeExprParser term table
type ParseResult = Either (ParseErrorBundle String Void) Expr type ParseResult = Either (ParseErrorBundle Text Void) Expr
parseExpr :: String -> ParseResult parseExpr :: Text -> ParseResult
parseExpr = MP.parse (C.space *> expr <* eof) "" parseExpr = MP.parse (C.space *> expr <* eof) ""
-- parseE = parseExpr -- parseE = parseExpr

View File

@ -7,5 +7,6 @@ data Expr
| Mul Expr Expr | Mul Expr Expr
| Div Expr Expr | Div Expr Expr
deriving deriving
( Show ( -- | Pop Expr Expr
Show
) )

View File

@ -19,7 +19,7 @@ getRight (Right r) = r
main :: IO () main :: IO ()
main = do main = do
fileName <- fmap head getArgs fileName <- fmap head getArgs
contents <- readFile fileName contents <- T.readFile fileName
T.putStrLn "- Parsing file..." T.putStrLn "- Parsing file..."
let parsed = getRight (parseExpr contents) let parsed = getRight (parseExpr contents)
T.putStrLn "- Generating LLVM to './a.out.ll'..." T.putStrLn "- Generating LLVM to './a.out.ll'..."