Rakarake/churf
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Made compiler state more generic, and compile no longer outputs IO and instead returns the result.

Browse source
This commit is contained in:
Samuel Hammersberg 2023-02-11 14:12:27 +01:00
parent e7ef268c12
commit 5d5a610cca
3 changed files with 31 additions and 32 deletions
Download patch file Download diff file Expand all files Collapse all files

1
language.cabal
View file

@ -31,6 +31,7 @@ executable language
Grammar.Par Grammar.Par
Grammar.Print Grammar.Print
Grammar.Skel Grammar.Skel
Grammar.ErrM
Compiler.Compiler Compiler.Compiler
Compiler.StandardLLVMLibrary Compiler.StandardLLVMLibrary
Compiler.TH Compiler.TH

52
src/Compiler/Compiler.hs
View file

@ -1,47 +1,45 @@
module Compiler.Compiler where module Compiler.Compiler where
import Compiler.LLVMIr (LLVMIr (..), LLVMType (..),
Value (..), llvmIrToString)
import Compiler.StandardLLVMLibrary (standardLLVMLibrary) import Compiler.StandardLLVMLibrary (standardLLVMLibrary)
import Control.Monad.State (State, execState, gets, modify) import Control.Monad.State (StateT, execStateT, gets, modify)
import Data.Set as Set import Grammar.Abs (Def (..), Exp (..), Ident (..),
import Grammar.Abs (Def (..), Exp (..), Ident (..) Program (..), Type (..))
, Program (..), Type (..)) import Grammar.ErrM (Err)
import Grammar.Print (printTree) import Grammar.Print (printTree)
import Compiler.LLVMIr (LLVMIr(..), Value(..)
, printLLVMIr, LLVMType(..))
-- | The record used as the code generator state -- | The record used as the code generator state
data CodeGenerator = CodeGenerator data CodeGenerator = CodeGenerator
{ instructions :: [LLVMIr] { instructions :: [LLVMIr]
, methods :: [Ident] , methods :: [Ident]
, block :: Set Ident
, variableCount :: Integer } , variableCount :: Integer }
type CompilerState = State CodeGenerator () type CompilerState a = StateT CodeGenerator Err a
-- | An empty instance of CodeGenerator -- | An empty instance of CodeGenerator
defaultCodeGenerator :: CodeGenerator defaultCodeGenerator :: CodeGenerator
defaultCodeGenerator = CodeGenerator defaultCodeGenerator = CodeGenerator
{ instructions = [] { instructions = []
, methods = [] , methods = []
, block = Set.empty
, variableCount = 0 } , variableCount = 0 }
-- | Adds a instruction to the CodeGenerator state -- | Adds a instruction to the CodeGenerator state
emit :: LLVMIr -> CompilerState emit :: LLVMIr -> CompilerState ()
emit l = modify (\t -> t {instructions = instructions t ++ [l]}) emit l = modify (\t -> t {instructions = instructions t ++ [l]})
-- | Increases the variable counter in the Codegenerator state -- | Increases the variable counter in the Codegenerator state
increaseVarCount :: CompilerState increaseVarCount :: CompilerState ()
increaseVarCount = modify (\t -> t {variableCount = variableCount t + 1}) increaseVarCount = modify (\t -> t {variableCount = variableCount t + 1})
compile :: Program -> IO () compile :: Program -> Err String
compile (Program prg) = do compile (Program prg) = do
let s = defaultCodeGenerator {instructions = [ let s = defaultCodeGenerator {instructions = [
Comment (show $ printTree (Program prg)), Comment (show $ printTree (Program prg)),
UnsafeRaw $ standardLLVMLibrary <> "\n" UnsafeRaw $ standardLLVMLibrary <> "\n"
]} ]}
let fin = execState (goDef prg) s fin <- execStateT (goDef prg) s
let ins = instructions fin let ins = instructions fin
putStrLn $ concatMap printLLVMIr ins pure $ concatMap llvmIrToString ins
where where
mainContent var = mainContent var =
[ SetVariable (Ident "print_res") [ SetVariable (Ident "print_res")
@ -53,7 +51,7 @@ compile (Program prg) = do
, Ret I64 (VInteger 0) , Ret I64 (VInteger 0)
] ]
goDef :: [Def] -> CompilerState goDef :: [Def] -> CompilerState ()
goDef [] = return () goDef [] = return ()
goDef (DExp id@(Ident str) t _id2 args exp : xs) = do goDef (DExp id@(Ident str) t _id2 args exp : xs) = do
let (rt, argTypes) = flattenFuncType t let (rt, argTypes) = flattenFuncType t
@ -67,7 +65,7 @@ compile (Program prg) = do
modify (\s -> s {variableCount = 0}) modify (\s -> s {variableCount = 0})
goDef xs goDef xs
go :: Exp -> CompilerState go :: Exp -> CompilerState ()
go (EInt int) = emitInt int go (EInt int) = emitInt int
go (EAdd e1 e2) = emitAdd e1 e2 go (EAdd e1 e2) = emitAdd e1 e2
go (ESub e1 e2) = emitSub e1 e2 go (ESub e1 e2) = emitSub e1 e2
@ -79,17 +77,17 @@ compile (Program prg) = do
go (EAbs id t e) = emitAbs id t e go (EAbs id t e) = emitAbs id t e
--- aux functions --- --- aux functions ---
emitAbs :: Ident -> Type -> Exp -> CompilerState emitAbs :: Ident -> Type -> Exp -> CompilerState ()
emitAbs id t e = do emitAbs id t e = do
emit $ Comment $ concat [ "EAbs (", show id, ", ", show t, ", " emit $ Comment $ concat [ "EAbs (", show id, ", ", show t, ", "
, show e, ") is not implemented!"] , show e, ") is not implemented!"]
emitApp :: Exp -> Exp -> CompilerState emitApp :: Exp -> Exp -> CompilerState ()
emitApp e1 e2 = do emitApp e1 e2 = do
emit $ Comment $ concat [ "EApp (", show e1, ", ", show e2 emit $ Comment $ concat [ "EApp (", show e1, ", ", show e2
, ") is not implemented!"] , ") is not implemented!"]
emitArg :: Ident -> CompilerState emitArg :: Ident -> CompilerState ()
emitArg id = do emitArg id = do
-- !!this should never happen!! -- !!this should never happen!!
increaseVarCount increaseVarCount
@ -97,7 +95,7 @@ compile (Program prg) = do
emit $ SetVariable (Ident $ show varCount) emit $ SetVariable (Ident $ show varCount)
emit $ Add I64 (VIdent id) (VInteger 0) emit $ Add I64 (VIdent id) (VInteger 0)
emitInt :: Integer -> CompilerState emitInt :: Integer -> CompilerState ()
emitInt i = do emitInt i = do
-- !!this should never happen!! -- !!this should never happen!!
increaseVarCount increaseVarCount
@ -105,7 +103,7 @@ compile (Program prg) = do
emit $ SetVariable $ Ident (show varCount) emit $ SetVariable $ Ident (show varCount)
emit $ Add I64 (VInteger i) (VInteger 0) emit $ Add I64 (VInteger i) (VInteger 0)
emitAdd :: Exp -> Exp -> CompilerState emitAdd :: Exp -> Exp -> CompilerState ()
emitAdd e1 e2 = do emitAdd e1 e2 = do
(v1,v2) <- binExprToValues e1 e2 (v1,v2) <- binExprToValues e1 e2
increaseVarCount increaseVarCount
@ -113,7 +111,7 @@ compile (Program prg) = do
emit $ SetVariable $ Ident $ show v emit $ SetVariable $ Ident $ show v
emit $ Add I64 v1 v2 emit $ Add I64 v1 v2
emitMul :: Exp -> Exp -> CompilerState emitMul :: Exp -> Exp -> CompilerState ()
emitMul e1 e2 = do emitMul e1 e2 = do
(v1,v2) <- binExprToValues e1 e2 (v1,v2) <- binExprToValues e1 e2
increaseVarCount increaseVarCount
@ -121,7 +119,7 @@ compile (Program prg) = do
emit $ SetVariable $ Ident $ show v emit $ SetVariable $ Ident $ show v
emit $ Mul I64 v1 v2 emit $ Mul I64 v1 v2
emitMod :: Exp -> Exp -> CompilerState emitMod :: Exp -> Exp -> CompilerState ()
emitMod e1 e2 = do emitMod e1 e2 = do
-- `let m a b = rem (abs $ b + a) b` -- `let m a b = rem (abs $ b + a) b`
(v1,v2) <- binExprToValues e1 e2 (v1,v2) <- binExprToValues e1 e2
@ -142,7 +140,7 @@ compile (Program prg) = do
emit $ SetVariable $ Ident $ show v emit $ SetVariable $ Ident $ show v
emit $ Srem I64 (VIdent (Ident $ show vabs)) v2 emit $ Srem I64 (VIdent (Ident $ show vabs)) v2
emitDiv :: Exp -> Exp -> CompilerState emitDiv :: Exp -> Exp -> CompilerState ()
emitDiv e1 e2 = do emitDiv e1 e2 = do
(v1,v2) <- binExprToValues e1 e2 (v1,v2) <- binExprToValues e1 e2
increaseVarCount increaseVarCount
@ -150,7 +148,7 @@ compile (Program prg) = do
emit $ SetVariable $ Ident $ show v emit $ SetVariable $ Ident $ show v
emit $ Div I64 v1 v2 emit $ Div I64 v1 v2
emitSub :: Exp -> Exp -> CompilerState emitSub :: Exp -> Exp -> CompilerState ()
emitSub e1 e2 = do emitSub e1 e2 = do
(v1,v2) <- binExprToValues e1 e2 (v1,v2) <- binExprToValues e1 e2
increaseVarCount increaseVarCount
@ -158,7 +156,7 @@ compile (Program prg) = do
emit $ SetVariable $ Ident $ show v emit $ SetVariable $ Ident $ show v
emit $ Sub I64 v1 v2 emit $ Sub I64 v1 v2
exprToValue :: Exp -> State CodeGenerator Value exprToValue :: Exp -> CompilerState Value
exprToValue (EInt i) = return $ VInteger i exprToValue (EInt i) = return $ VInteger i
exprToValue (EId i) = return $ VIdent i exprToValue (EId i) = return $ VIdent i
exprToValue e = do exprToValue e = do
@ -166,7 +164,7 @@ compile (Program prg) = do
v <- gets variableCount v <- gets variableCount
return $ VIdent $ Ident $ show v return $ VIdent $ Ident $ show v
binExprToValues :: Exp -> Exp -> State CodeGenerator (Value, Value) binExprToValues :: Exp -> Exp -> CompilerState (Value, Value)
binExprToValues e1 e2 = do binExprToValues e1 e2 = do
v1 <- exprToValue e1 v1 <- exprToValue e1
v2 <- exprToValue e2 v2 <- exprToValue e2

8
src/Compiler/LLVMIr.hs
View file

@ -1,7 +1,7 @@
{-# LANGUAGE LambdaCase #-} {-# LANGUAGE LambdaCase #-}
module Compiler.LLVMIr where module Compiler.LLVMIr where
import Grammar.Abs (Ident (Ident)) import Data.List (intercalate)
import Data.List (intercalate) import Grammar.Abs (Ident (Ident))
-- | A datatype which represents some basic LLVM types -- | A datatype which represents some basic LLVM types
data LLVMType = I1 | I8 | I32 | I64 | Ptr data LLVMType = I1 | I8 | I32 | I64 | Ptr
@ -53,8 +53,8 @@ data LLVMIr = Define LLVMType Ident Params
deriving (Show) deriving (Show)
-- | Converts a LLVM inststruction to a String, allowing for printing etc. -- | Converts a LLVM inststruction to a String, allowing for printing etc.
printLLVMIr :: LLVMIr -> String llvmIrToString :: LLVMIr -> String
printLLVMIr = \case llvmIrToString = \case
(Define t (Ident i) params) -> concat ["define ", show t, " @", i, "(" (Define t (Ident i) params) -> concat ["define ", show t, " @", i, "("
, intercalate "," (fmap (\(x,Ident y) -> unwords [show x, "%"<>y]) params) , intercalate "," (fmap (\(x,Ident y) -> unwords [show x, "%"<>y]) params)
,") {\n"] ,") {\n"]