Allow parsing signed integers

README.md

@@ -12,9 +12,17 @@ Main repo: https://git.sudoer.ch/me/really-bad-compiler-in-haskell
 
 ## Run Instructions
 
-- Use `stack run <file>` to run the program (for example, `stack run example/1`).
+- Use `stack run <file>` to run the program (for example, `stack run example/1.fs`).
 - The LLVM will be generated as `a.out.ll`, and the executable will be generated as `a.out`.
 
+## Language
+
+It is planned to be similar to Forth, unless it turns out that Forth does not have the features I am looking for.
+
+Currently, it supports positive integers, `+`, `-`, `*`, `/`, and `.` (pops from stack and outputs to console).
+
+The supported syntax for this compiler aims to be compatible with Gforth.
+
 ## To edit
 
 I recommend using VSCodium, which is preconfigured to have syntax highlighting and (currently broken) debugging features and will automatically suggest the Haskell extensions to install.

example/1

@@ -1 +0,0 @@
-5*3+2

example/1.fs

@@ -0,0 +1 @@
+5 3 * 2 + .

example/2

@@ -1 +0,0 @@
-6+8/3

example/2.fs

@@ -0,0 +1 @@
+6 8 3 / + .

really-bad-compiler-in-haskell.cabal

@@ -18,7 +18,7 @@ executable really-bad-compiler-in-haskell
   other-modules:
       Forth.LLVMGen
       Forth.Parser
-      Forth.Types.Expr
+      Forth.Types.Token
       Paths_really_bad_compiler_in_haskell
   hs-source-dirs:
       src

src/Forth/LLVMGen.hs

@@ -7,7 +7,7 @@
 module Forth.LLVMGen (llvmGen) where
 
 import Data.ByteString (ByteString)
-import Forth.Types.Expr as Expr
+import Forth.Types.Token as Token
 import LLVM (moduleLLVMAssembly, withModuleFromAST)
 import LLVM.AST hiding (function)
 import LLVM.AST.Type
@@ -17,7 +17,7 @@ import LLVM.IRBuilder.Instruction
 import LLVM.IRBuilder.Module
 import LLVM.IRBuilder.Monad
 
-getLLVM :: Expr -> Module
+getLLVM :: Token -> Module
 getLLVM expr =
   buildModule "program" $ mdo
     -- TODO: better module name
@@ -32,22 +32,22 @@ exprToLLVM ::
   ( MonadIRBuilder m,
     MonadModuleBuilder m
   ) =>
-  Expr ->
+  Token ->
   m Operand
 exprToLLVM (Lit prim) = pure $ primToLLVM prim
-exprToLLVM (Expr.Add a b) = mdo
+exprToLLVM (Token.Add a b) = mdo
   lhs <- exprToLLVM a
   rhs <- exprToLLVM b
   add lhs rhs
-exprToLLVM (Expr.Sub a b) = mdo
+exprToLLVM (Token.Sub a b) = mdo
   lhs <- exprToLLVM a
   rhs <- exprToLLVM b
   sub lhs rhs
-exprToLLVM (Expr.Mul a b) = mdo
+exprToLLVM (Token.Mul a b) = mdo
   lhs <- exprToLLVM a
   rhs <- exprToLLVM b
   mul lhs rhs
-exprToLLVM (Expr.Div a b) = mdo
+exprToLLVM (Token.Div a b) = mdo
   lhs <- exprToLLVM a
   rhs <- exprToLLVM b
   sdiv lhs rhs
@@ -55,7 +55,7 @@ exprToLLVM (Expr.Div a b) = mdo
 primToLLVM :: Int -> Operand
 primToLLVM i = int32 (fromIntegral i)
 
-llvmGen :: Expr -> IO ByteString
+llvmGen :: Token -> IO ByteString
 llvmGen expr = do
   let l = getLLVM expr
   withContext

src/Forth/Parser.hs

@@ -2,57 +2,53 @@
 {-# 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.signed (return ()) 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 =
+  try
+    ( 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
+parse :: Text -> [Token]
+parse t = do
+  case parseItems t of
+    Left err -> [] -- putStrLn $ errorBundlePretty err
+    Right tns -> tns

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

src/Forth/Types/Expr.hs.old

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

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
+    )

src/Main.hs

@@ -3,27 +3,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."