README.md

@@ -12,17 +12,9 @@ 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.fs`).
+- Use `stack run <file>` to run the program (for example, `stack run example/1`).
 - 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

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

example/1.fs

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

example/2

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

example/2.fs

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

main/Compiler/LLVMGen.hs

@@ -4,11 +4,13 @@
 
 -- see https://gh.sudoer.ch/danieljharvey/mimsa/blob/trunk/llvm-calc/src/Calc/Compile/ToLLVM.hs
 
-module Forth.LLVMGen (llvmGen) where
+module Compiler.LLVMGen (llvmGen) where
+
+-- import LLVM.Pretty
 
 import Data.ByteString (ByteString)
-import Forth.Types.Token as Token
+import Debug.Trace
-import LLVM (moduleLLVMAssembly, withModuleFromAST)
+import LLVM (moduleLLVMAssembly, withModuleFromAST, writeLLVMAssemblyToFile)
 import LLVM.AST hiding (function)
 import LLVM.AST.Type
 import LLVM.Context
@@ -16,8 +18,9 @@ import LLVM.IRBuilder.Constant
 import LLVM.IRBuilder.Instruction
 import LLVM.IRBuilder.Module
 import LLVM.IRBuilder.Monad
+import Types.Expr as Expr
 
-getLLVM :: Token -> Module
+getLLVM :: Expr -> Module
 getLLVM expr =
   buildModule "program" $ mdo
     -- TODO: better module name
@@ -32,22 +35,22 @@ exprToLLVM ::
   ( MonadIRBuilder m,
     MonadModuleBuilder m
   ) =>
-  Token ->
+  Expr ->
   m Operand
 exprToLLVM (Lit prim) = pure $ primToLLVM prim
-exprToLLVM (Token.Add a b) = mdo
+exprToLLVM (Expr.Add a b) = mdo
   lhs <- exprToLLVM a
   rhs <- exprToLLVM b
   add lhs rhs
-exprToLLVM (Token.Sub a b) = mdo
+exprToLLVM (Expr.Sub a b) = mdo
   lhs <- exprToLLVM a
   rhs <- exprToLLVM b
   sub lhs rhs
-exprToLLVM (Token.Mul a b) = mdo
+exprToLLVM (Expr.Mul a b) = mdo
   lhs <- exprToLLVM a
   rhs <- exprToLLVM b
   mul lhs rhs
-exprToLLVM (Token.Div a b) = mdo
+exprToLLVM (Expr.Div a b) = mdo
   lhs <- exprToLLVM a
   rhs <- exprToLLVM b
   sdiv lhs rhs
@@ -55,7 +58,7 @@ exprToLLVM (Token.Div a b) = mdo
 primToLLVM :: Int -> Operand
 primToLLVM i = int32 (fromIntegral i)
 
-llvmGen :: Token -> IO ByteString
+llvmGen :: Expr -> IO ByteString
 llvmGen expr = do
   let l = getLLVM expr
   withContext

main/Main.hs

@@ -0,0 +1,28 @@
+{-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Main (main) where
+
+-- import Compiler.ExeGen
+import Compiler.LLVMGen
+import Data.ByteString.Char8 qualified as B
+import Data.Text.Lazy.IO qualified as T
+import Parser.Expr
+import System.Environment
+import System.Process
+import Types.Expr
+
+getRight :: ParseResult -> Expr
+getRight (Right r) = r
+
+main :: IO ()
+main = do
+  fileName <- fmap head getArgs
+  contents <- 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"
+  T.putStrLn "- Done."

main/Parser/Expr.hs

@@ -1,24 +1,22 @@
 -- see https://markkarpov.com/tutorial/megaparsec.html
 {-# LANGUAGE ImportQualifiedPost #-}
-{-# LANGUAGE OverloadedStrings #-}
 
-module Forth.Parser (parseExpr, ParseResult) where
+module Parser.Expr (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
+import Types.Expr
 
-type Parser = Parsec Void Text
+type Parser = Parsec Void String
 
 lexemeParser :: Parser a -> Parser a
 lexemeParser = L.lexeme C.space
 
-symbolParser :: Text -> Parser Text
+symbolParser :: String -> Parser String
 symbolParser = L.symbol C.space
 
 intParser :: Parser Int
@@ -34,25 +32,18 @@ table =
     ],
     [ binaryOp "+" Add,
       binaryOp "-" Sub
-      -- binaryOp "." Pop
     ]
   ]
 
-binaryOp :: Text -> (a -> a -> a) -> Operator (ParsecT Void Text Data.Functor.Identity.Identity) a
+binaryOp :: String -> (a -> a -> a) -> Operator (ParsecT Void String 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
+type ParseResult = Either (ParseErrorBundle String Void) Expr
 
-parseExpr :: Text -> ParseResult
+parseExpr :: String -> ParseResult
 parseExpr = MP.parse (C.space *> expr <* eof) ""
 
 -- parseE = parseExpr

main/Types/Expr.hs

@@ -1,4 +1,4 @@
-module Forth.Types.Expr (Expr (..)) where
+module Types.Expr (Expr (..)) where
 
 data Expr
   = Lit Int
@@ -6,7 +6,6 @@ data Expr
   | Sub Expr Expr
   | Mul Expr Expr
   | Div Expr Expr
-  | Pop Expr Expr
   deriving
     ( Show
     )

package.yaml

@@ -19,7 +19,7 @@ ghc-options: -threaded -Wall -j8 +RTS -A64M -RTS -fllvm
 #   source-dirs: src
 
 executable:
-  source-dirs: src
+  source-dirs: main
   main: Main.hs
 # tests:
 #   testall:

really-bad-compiler-in-haskell.cabal

@@ -16,12 +16,12 @@ tested-with:
 executable really-bad-compiler-in-haskell
   main-is: Main.hs
   other-modules:
-      Forth.LLVMGen
+      Compiler.LLVMGen
-      Forth.Parser
+      Parser.Expr
-      Forth.Types.Token
+      Types.Expr
       Paths_really_bad_compiler_in_haskell
   hs-source-dirs:
-      src
+      main
   default-extensions:
       OverloadedStrings, LambdaCase
   ghc-options: -threaded -Wall -j8 +RTS -A64M -RTS -fllvm

src/Forth/Parser.hs

@@ -1,54 +0,0 @@
--- see https://markkarpov.com/tutorial/megaparsec.html
-{-# LANGUAGE ImportQualifiedPost #-}
-{-# LANGUAGE OverloadedStrings #-}
-
-module Forth.Parser (parse) where
-
-import Data.Text
-import Data.Void (Void)
-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
-
-lexeme :: Parser a -> Parser a
-lexeme = L.lexeme C.space
-
-int :: Parser Int
-int = lexeme $ L.signed (return ()) L.decimal
-
-symbol :: Text -> Parser Text
-symbol = L.symbol C.space
-
-item :: Parser Token
-item =
-  try
-    ( Lit
-        <$> int
-    )
-    <|> Add
-    <$ symbol "+"
-      <|> Sub
-    <$ symbol "-"
-      <|> Mul
-    <$ symbol "*"
-      <|> Div
-    <$ symbol "/"
-      <|> Pop
-    <$ symbol "."
-
-items :: Parser [Token]
-items = many item
-
-parseItems :: Text -> Either (ParseErrorBundle Text Void) [Token]
-parseItems = MP.parse items ""
-
-parse :: Text -> [Token]
-parse t = do
-  case parseItems t of
-    Left err -> [] -- putStrLn $ errorBundlePretty err
-    Right tns -> tns

src/Forth/Types/Token.hs

@@ -1,12 +0,0 @@
-module Forth.Types.Token (Token (..)) where
-
-data Token
-  = Lit Int
-  | Add
-  | Sub
-  | Mul
-  | Div
-  | Pop
-  deriving
-    ( Show
-    )

src/Main.hs

@@ -1,23 +0,0 @@
-{-# LANGUAGE ImportQualifiedPost #-}
-{-# LANGUAGE OverloadedStrings #-}
-
-module Main (main) where
-
-import Data.ByteString.Char8 qualified as B
-import Data.Text.IO qualified as T
-import Forth.LLVMGen
-import Forth.Parser
-import System.Environment
-import System.Process
-
-main :: IO ()
-main = do
-  fileName <- fmap head getArgs
-  contents <- T.readFile fileName
-  T.putStrLn "- Parsing file..."
-  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."