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 ## 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`. - 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 ## 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. 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 # source-dirs: src
executable: executable:
source-dirs: main source-dirs: src
main: Main.hs main: Main.hs
# tests: # tests:
# testall: # testall:

View File

@ -16,12 +16,12 @@ tested-with:
executable really-bad-compiler-in-haskell executable really-bad-compiler-in-haskell
main-is: Main.hs main-is: Main.hs
other-modules: other-modules:
Compiler.LLVMGen Forth.LLVMGen
Parser.Expr Forth.Parser
Types.Expr Forth.Types.Token
Paths_really_bad_compiler_in_haskell Paths_really_bad_compiler_in_haskell
hs-source-dirs: hs-source-dirs:
main src
default-extensions: default-extensions:
OverloadedStrings, LambdaCase OverloadedStrings, LambdaCase
ghc-options: -threaded -Wall -j8 +RTS -A64M -RTS -fllvm 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 -- see https://gh.sudoer.ch/danieljharvey/mimsa/blob/trunk/llvm-calc/src/Calc/Compile/ToLLVM.hs
module Compiler.LLVMGen (llvmGen) where module Forth.LLVMGen (llvmGen) where
-- import LLVM.Pretty
import Data.ByteString (ByteString) import Data.ByteString (ByteString)
import Debug.Trace import Forth.Types.Token as Token
import LLVM (moduleLLVMAssembly, withModuleFromAST, writeLLVMAssemblyToFile) import LLVM (moduleLLVMAssembly, withModuleFromAST)
import LLVM.AST hiding (function) import LLVM.AST hiding (function)
import LLVM.AST.Type import LLVM.AST.Type
import LLVM.Context import LLVM.Context
@ -18,9 +16,8 @@ import LLVM.IRBuilder.Constant
import LLVM.IRBuilder.Instruction import LLVM.IRBuilder.Instruction
import LLVM.IRBuilder.Module import LLVM.IRBuilder.Module
import LLVM.IRBuilder.Monad import LLVM.IRBuilder.Monad
import Types.Expr as Expr
getLLVM :: Expr -> Module getLLVM :: Token -> Module
getLLVM expr = getLLVM expr =
buildModule "program" $ mdo buildModule "program" $ mdo
-- TODO: better module name -- TODO: better module name
@ -35,22 +32,22 @@ exprToLLVM ::
( MonadIRBuilder m, ( MonadIRBuilder m,
MonadModuleBuilder m MonadModuleBuilder m
) => ) =>
Expr -> Token ->
m Operand m Operand
exprToLLVM (Lit prim) = pure $ primToLLVM prim exprToLLVM (Lit prim) = pure $ primToLLVM prim
exprToLLVM (Expr.Add a b) = mdo exprToLLVM (Token.Add a b) = mdo
lhs <- exprToLLVM a lhs <- exprToLLVM a
rhs <- exprToLLVM b rhs <- exprToLLVM b
add lhs rhs add lhs rhs
exprToLLVM (Expr.Sub a b) = mdo exprToLLVM (Token.Sub a b) = mdo
lhs <- exprToLLVM a lhs <- exprToLLVM a
rhs <- exprToLLVM b rhs <- exprToLLVM b
sub lhs rhs sub lhs rhs
exprToLLVM (Expr.Mul a b) = mdo exprToLLVM (Token.Mul a b) = mdo
lhs <- exprToLLVM a lhs <- exprToLLVM a
rhs <- exprToLLVM b rhs <- exprToLLVM b
mul lhs rhs mul lhs rhs
exprToLLVM (Expr.Div a b) = mdo exprToLLVM (Token.Div a b) = mdo
lhs <- exprToLLVM a lhs <- exprToLLVM a
rhs <- exprToLLVM b rhs <- exprToLLVM b
sdiv lhs rhs sdiv lhs rhs
@ -58,7 +55,7 @@ exprToLLVM (Expr.Div a b) = mdo
primToLLVM :: Int -> Operand primToLLVM :: Int -> Operand
primToLLVM i = int32 (fromIntegral i) primToLLVM i = int32 (fromIntegral i)
llvmGen :: Expr -> IO ByteString llvmGen :: Token -> IO ByteString
llvmGen expr = do llvmGen expr = do
let l = getLLVM expr let l = getLLVM expr
withContext 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 -- see https://markkarpov.com/tutorial/megaparsec.html
{-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE OverloadedStrings #-}
module Parser.Expr (parseExpr, ParseResult) where module Forth.Parser (parseExpr, ParseResult) where
import Control.Monad.Combinators.Expr import Control.Monad.Combinators.Expr
import Data.Functor.Identity qualified import Data.Functor.Identity qualified
import Data.Text.Lazy
import Data.Void (Void) import Data.Void (Void)
import Forth.Types.Expr
import Text.Megaparsec as MP import Text.Megaparsec as MP
import Text.Megaparsec.Char as C import Text.Megaparsec.Char as C
import Text.Megaparsec.Char.Lexer as L 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 :: Parser a -> Parser a
lexemeParser = L.lexeme C.space lexemeParser = L.lexeme C.space
symbolParser :: String -> Parser String symbolParser :: Text -> Parser Text
symbolParser = L.symbol C.space symbolParser = L.symbol C.space
intParser :: Parser Int intParser :: Parser Int
@ -32,18 +34,25 @@ table =
], ],
[ binaryOp "+" Add, [ binaryOp "+" Add,
binaryOp "-" Sub 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) 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 :: Parser Expr
expr = makeExprParser term table 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) "" parseExpr = MP.parse (C.space *> expr <* eof) ""
-- parseE = parseExpr -- parseE = parseExpr

View File

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