From 067150a6824b3a85472e7dfd696e938e2366de2c Mon Sep 17 00:00:00 2001 From: sudoer777 Date: Sat, 30 Sep 2023 01:52:31 -0500 Subject: [PATCH] Parse expr tokens to list --- really-bad-compiler-in-haskell.cabal | 1 + src/Forth/Parser.hs | 80 +++++++++++++--------------- src/Forth/Parser.hs.old | 58 ++++++++++++++++++++ src/Forth/Types/Expr.hs | 4 +- src/Forth/Types/Token.hs | 12 +++++ src/Main.hs | 15 +++--- 6 files changed, 116 insertions(+), 54 deletions(-) create mode 100644 src/Forth/Parser.hs.old create mode 100644 src/Forth/Types/Token.hs diff --git a/really-bad-compiler-in-haskell.cabal b/really-bad-compiler-in-haskell.cabal index d55ad95..b068795 100644 --- a/really-bad-compiler-in-haskell.cabal +++ b/really-bad-compiler-in-haskell.cabal @@ -19,6 +19,7 @@ executable really-bad-compiler-in-haskell Forth.LLVMGen Forth.Parser Forth.Types.Expr + Forth.Types.Token Paths_really_bad_compiler_in_haskell hs-source-dirs: src diff --git a/src/Forth/Parser.hs b/src/Forth/Parser.hs index 32247ba..ecef115 100644 --- a/src/Forth/Parser.hs +++ b/src/Forth/Parser.hs @@ -2,57 +2,51 @@ {-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE OverloadedStrings #-} -module Forth.Parser (parseExpr, ParseResult) where +module Forth.Parser (parse) where -import Control.Monad.Combinators.Expr -import Data.Functor.Identity qualified -import Data.Text.Lazy +import Data.Text import Data.Void (Void) -import Forth.Types.Expr -import Text.Megaparsec as MP -import Text.Megaparsec.Char as C -import Text.Megaparsec.Char.Lexer as L +import Forth.Types.Token +import Text.Megaparsec as MP hiding (Token, parse) +import Text.Megaparsec qualified as MP +import Text.Megaparsec.Char qualified as C +import Text.Megaparsec.Char.Lexer qualified as L +import Prelude hiding (div) type Parser = Parsec Void Text -lexemeParser :: Parser a -> Parser a -lexemeParser = L.lexeme C.space +lexeme :: Parser a -> Parser a +lexeme = L.lexeme C.space -symbolParser :: Text -> Parser Text -symbolParser = L.symbol C.space +int :: Parser Int +int = lexeme L.decimal -intParser :: Parser Int -intParser = lexemeParser L.decimal +symbol :: Text -> Parser Text +symbol = L.symbol C.space -term :: Parser Expr -term = Lit <$> intParser +item :: Parser Token +item = + Lit + <$> int + <|> Add + <$ symbol "+" + <|> Sub + <$ symbol "-" + <|> Mul + <$ symbol "*" + <|> Div + <$ symbol "/" + <|> Pop + <$ symbol "." -table :: [[Operator Parser Expr]] -table = - [ [ binaryOp "*" Mul, - binaryOp "/" Div - ], - [ binaryOp "+" Add, - binaryOp "-" Sub - -- binaryOp "." Pop - ] - ] +items :: Parser [Token] +items = many item -binaryOp :: Text -> (a -> a -> a) -> Operator (ParsecT Void Text Data.Functor.Identity.Identity) a -binaryOp name f = InfixL (f <$ symbolParser name) +parseItems :: Text -> Either (ParseErrorBundle Text Void) [Token] +parseItems = MP.parse items "" --- 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 = makeExprParser term table - -type ParseResult = Either (ParseErrorBundle Text Void) Expr - -parseExpr :: Text -> ParseResult -parseExpr = MP.parse (C.space *> expr <* eof) "" - --- parseE = parseExpr \ No newline at end of file +parse :: Text -> [Token] +parse t = do + case parseItems t of + Left err -> [] -- putStrLn $ errorBundlePretty err + Right tns -> tns diff --git a/src/Forth/Parser.hs.old b/src/Forth/Parser.hs.old new file mode 100644 index 0000000..32247ba --- /dev/null +++ b/src/Forth/Parser.hs.old @@ -0,0 +1,58 @@ +-- see https://markkarpov.com/tutorial/megaparsec.html +{-# LANGUAGE ImportQualifiedPost #-} +{-# LANGUAGE OverloadedStrings #-} + +module Forth.Parser (parseExpr, ParseResult) where + +import Control.Monad.Combinators.Expr +import Data.Functor.Identity qualified +import Data.Text.Lazy +import Data.Void (Void) +import Forth.Types.Expr +import Text.Megaparsec as MP +import Text.Megaparsec.Char as C +import Text.Megaparsec.Char.Lexer as L + +type Parser = Parsec Void Text + +lexemeParser :: Parser a -> Parser a +lexemeParser = L.lexeme C.space + +symbolParser :: Text -> Parser Text +symbolParser = L.symbol C.space + +intParser :: Parser Int +intParser = lexemeParser L.decimal + +term :: Parser Expr +term = Lit <$> intParser + +table :: [[Operator Parser Expr]] +table = + [ [ binaryOp "*" Mul, + binaryOp "/" Div + ], + [ binaryOp "+" Add, + binaryOp "-" Sub + -- binaryOp "." Pop + ] + ] + +binaryOp :: Text -> (a -> a -> a) -> Operator (ParsecT Void Text Data.Functor.Identity.Identity) a +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 = makeExprParser term table + +type ParseResult = Either (ParseErrorBundle Text Void) Expr + +parseExpr :: Text -> ParseResult +parseExpr = MP.parse (C.space *> expr <* eof) "" + +-- parseE = parseExpr \ No newline at end of file diff --git a/src/Forth/Types/Expr.hs b/src/Forth/Types/Expr.hs index 71dbcec..1b8ba1d 100644 --- a/src/Forth/Types/Expr.hs +++ b/src/Forth/Types/Expr.hs @@ -6,7 +6,7 @@ data Expr | Sub Expr Expr | Mul Expr Expr | Div Expr Expr + | Pop Expr Expr deriving - ( -- | Pop Expr Expr - Show + ( Show ) \ No newline at end of file diff --git a/src/Forth/Types/Token.hs b/src/Forth/Types/Token.hs new file mode 100644 index 0000000..6198d99 --- /dev/null +++ b/src/Forth/Types/Token.hs @@ -0,0 +1,12 @@ +module Forth.Types.Token (Token (..)) where + +data Token + = Lit Int + | Add + | Sub + | Mul + | Div + | Pop + deriving + ( Show + ) \ No newline at end of file diff --git a/src/Main.hs b/src/Main.hs index 4bfc1b6..4cf4dde 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -6,24 +6,21 @@ module Main (main) where -- import Compiler.ExeGen import Data.ByteString.Char8 qualified as B -import Data.Text.Lazy.IO qualified as T +import Data.Text.IO qualified as T import Forth.LLVMGen import Forth.Parser import Forth.Types.Expr import System.Environment import System.Process -getRight :: ParseResult -> Expr -getRight (Right r) = r - main :: IO () main = do fileName <- fmap head getArgs contents <- T.readFile fileName T.putStrLn "- Parsing file..." - let parsed = getRight (parseExpr contents) - T.putStrLn "- Generating LLVM to './a.out.ll'..." - llvmGen parsed >>= B.writeFile "a.out.ll" - T.putStrLn "- Compiling to executable './a.out'..." - callCommand "clang a.out.ll" + let parsed = parse contents + -- T.putStrLn "- Generating LLVM to './a.out.ll'..." + -- llvmGen parsed >>= B.writeFile "a.out.ll" + -- T.putStrLn "- Compiling to executable './a.out'..." + -- callCommand "clang a.out.ll" T.putStrLn "- Done."