src/Forth/Parser.hs

@@ -1,22 +1,24 @@
 -- 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 String
+type Parser = Parsec Void Text
 
 lexemeParser :: Parser a -> Parser a
 lexemeParser = L.lexeme C.space
 
-symbolParser :: String -> Parser String
+symbolParser :: Text -> Parser Text
 symbolParser = L.symbol C.space
 
 intParser :: Parser Int
@@ -32,18 +34,25 @@ table =
     ],
     [ binaryOp "+" Add,
       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)
 
+-- 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 String Void) Expr
+type ParseResult = Either (ParseErrorBundle Text Void) Expr
 
-parseExpr :: String -> ParseResult
+parseExpr :: Text -> ParseResult
 parseExpr = MP.parse (C.space *> expr <* eof) ""
 
 -- parseE = parseExpr

src/Forth/Types/Expr.hs

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

src/Main.hs

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