Change Parser from string to text
parent
7f588ec561
commit
e7083c1c40
|
@ -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
|
|
@ -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
|
||||||
)
|
)
|
|
@ -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'..."
|
||||||
|
|
Reference in New Issue