Compare commits

..

5 Commits

Author SHA1 Message Date
Ethan Reece cca9262fc3
Allow parsing signed integers 2023-09-30 02:54:48 -05:00
Ethan Reece 83aa5bd4d3
Update readme and examples 2023-09-30 02:00:51 -05:00
Ethan Reece 067150a682
Parse expr tokens to list 2023-09-30 01:52:31 -05:00
Ethan Reece e7083c1c40
Change Parser from string to text 2023-09-29 22:59:25 -05:00
Ethan Reece 7f588ec561
Reorganize program 2023-09-29 18:31:30 -05:00
14 changed files with 133 additions and 57 deletions

View File

@ -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.

View File

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

1
example/1.fs 100644
View File

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

View File

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

1
example/2.fs 100644
View File

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

View File

@ -1,28 +0,0 @@
{-# 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."

View File

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

View File

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

View File

@ -4,13 +4,11 @@
-- see https://gh.sudoer.ch/danieljharvey/mimsa/blob/trunk/llvm-calc/src/Calc/Compile/ToLLVM.hs
module Compiler.LLVMGen (llvmGen) where
-- import LLVM.Pretty
module Forth.LLVMGen (llvmGen) where
import Data.ByteString (ByteString)
import Debug.Trace
import LLVM (moduleLLVMAssembly, withModuleFromAST, writeLLVMAssemblyToFile)
import Forth.Types.Token as Token
import LLVM (moduleLLVMAssembly, withModuleFromAST)
import LLVM.AST hiding (function)
import LLVM.AST.Type
import LLVM.Context
@ -18,9 +16,8 @@ import LLVM.IRBuilder.Constant
import LLVM.IRBuilder.Instruction
import LLVM.IRBuilder.Module
import LLVM.IRBuilder.Monad
import Types.Expr as Expr
getLLVM :: Expr -> Module
getLLVM :: Token -> Module
getLLVM expr =
buildModule "program" $ mdo
-- TODO: better module name
@ -35,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
@ -58,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

View File

@ -0,0 +1,54 @@
-- 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

View File

@ -1,22 +1,24 @@
-- see https://markkarpov.com/tutorial/megaparsec.html
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE OverloadedStrings #-}
module Parser.Expr (parseExpr, ParseResult) where
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
import Types.Expr
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

View File

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

View File

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

23
src/Main.hs 100644
View File

@ -0,0 +1,23 @@
{-# 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."