From 5d5a610cca598c9d71cb652ddd16e51355ca090f Mon Sep 17 00:00:00 2001 From: Samuel Hammersberg Date: Sat, 11 Feb 2023 14:12:27 +0100 Subject: [PATCH] Made compiler state more generic, and `compile` no longer outputs IO and instead returns the result. --- language.cabal | 1 + src/Compiler/Compiler.hs | 52 +++++++++++++++++++--------------------- src/Compiler/LLVMIr.hs | 10 ++++---- 3 files changed, 31 insertions(+), 32 deletions(-) diff --git a/language.cabal b/language.cabal index 61bb4aa..4ffb4f3 100644 --- a/language.cabal +++ b/language.cabal @@ -31,6 +31,7 @@ executable language Grammar.Par Grammar.Print Grammar.Skel + Grammar.ErrM Compiler.Compiler Compiler.StandardLLVMLibrary Compiler.TH diff --git a/src/Compiler/Compiler.hs b/src/Compiler/Compiler.hs index 26dc980..a09f502 100644 --- a/src/Compiler/Compiler.hs +++ b/src/Compiler/Compiler.hs @@ -1,47 +1,45 @@ module Compiler.Compiler where +import Compiler.LLVMIr (LLVMIr (..), LLVMType (..), + Value (..), llvmIrToString) import Compiler.StandardLLVMLibrary (standardLLVMLibrary) -import Control.Monad.State (State, execState, gets, modify) -import Data.Set as Set -import Grammar.Abs (Def (..), Exp (..), Ident (..) - , Program (..), Type (..)) +import Control.Monad.State (StateT, execStateT, gets, modify) +import Grammar.Abs (Def (..), Exp (..), Ident (..), + Program (..), Type (..)) +import Grammar.ErrM (Err) import Grammar.Print (printTree) -import Compiler.LLVMIr (LLVMIr(..), Value(..) - , printLLVMIr, LLVMType(..)) -- | The record used as the code generator state data CodeGenerator = CodeGenerator { instructions :: [LLVMIr] , methods :: [Ident] - , block :: Set Ident , variableCount :: Integer } -type CompilerState = State CodeGenerator () +type CompilerState a = StateT CodeGenerator Err a -- | An empty instance of CodeGenerator defaultCodeGenerator :: CodeGenerator defaultCodeGenerator = CodeGenerator { instructions = [] , methods = [] - , block = Set.empty , variableCount = 0 } -- | Adds a instruction to the CodeGenerator state -emit :: LLVMIr -> CompilerState +emit :: LLVMIr -> CompilerState () emit l = modify (\t -> t {instructions = instructions t ++ [l]}) -- | Increases the variable counter in the Codegenerator state -increaseVarCount :: CompilerState +increaseVarCount :: CompilerState () increaseVarCount = modify (\t -> t {variableCount = variableCount t + 1}) -compile :: Program -> IO () +compile :: Program -> Err String compile (Program prg) = do let s = defaultCodeGenerator {instructions = [ Comment (show $ printTree (Program prg)), UnsafeRaw $ standardLLVMLibrary <> "\n" ]} - let fin = execState (goDef prg) s + fin <- execStateT (goDef prg) s let ins = instructions fin - putStrLn $ concatMap printLLVMIr ins + pure $ concatMap llvmIrToString ins where mainContent var = [ SetVariable (Ident "print_res") @@ -53,7 +51,7 @@ compile (Program prg) = do , Ret I64 (VInteger 0) ] - goDef :: [Def] -> CompilerState + goDef :: [Def] -> CompilerState () goDef [] = return () goDef (DExp id@(Ident str) t _id2 args exp : xs) = do let (rt, argTypes) = flattenFuncType t @@ -67,7 +65,7 @@ compile (Program prg) = do modify (\s -> s {variableCount = 0}) goDef xs - go :: Exp -> CompilerState + go :: Exp -> CompilerState () go (EInt int) = emitInt int go (EAdd e1 e2) = emitAdd 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 --- aux functions --- - emitAbs :: Ident -> Type -> Exp -> CompilerState + emitAbs :: Ident -> Type -> Exp -> CompilerState () emitAbs id t e = do emit $ Comment $ concat [ "EAbs (", show id, ", ", show t, ", " , show e, ") is not implemented!"] - emitApp :: Exp -> Exp -> CompilerState + emitApp :: Exp -> Exp -> CompilerState () emitApp e1 e2 = do emit $ Comment $ concat [ "EApp (", show e1, ", ", show e2 , ") is not implemented!"] - emitArg :: Ident -> CompilerState + emitArg :: Ident -> CompilerState () emitArg id = do -- !!this should never happen!! increaseVarCount @@ -97,7 +95,7 @@ compile (Program prg) = do emit $ SetVariable (Ident $ show varCount) emit $ Add I64 (VIdent id) (VInteger 0) - emitInt :: Integer -> CompilerState + emitInt :: Integer -> CompilerState () emitInt i = do -- !!this should never happen!! increaseVarCount @@ -105,7 +103,7 @@ compile (Program prg) = do emit $ SetVariable $ Ident (show varCount) emit $ Add I64 (VInteger i) (VInteger 0) - emitAdd :: Exp -> Exp -> CompilerState + emitAdd :: Exp -> Exp -> CompilerState () emitAdd e1 e2 = do (v1,v2) <- binExprToValues e1 e2 increaseVarCount @@ -113,7 +111,7 @@ compile (Program prg) = do emit $ SetVariable $ Ident $ show v emit $ Add I64 v1 v2 - emitMul :: Exp -> Exp -> CompilerState + emitMul :: Exp -> Exp -> CompilerState () emitMul e1 e2 = do (v1,v2) <- binExprToValues e1 e2 increaseVarCount @@ -121,7 +119,7 @@ compile (Program prg) = do emit $ SetVariable $ Ident $ show v emit $ Mul I64 v1 v2 - emitMod :: Exp -> Exp -> CompilerState + emitMod :: Exp -> Exp -> CompilerState () emitMod e1 e2 = do -- `let m a b = rem (abs $ b + a) b` (v1,v2) <- binExprToValues e1 e2 @@ -142,7 +140,7 @@ compile (Program prg) = do emit $ SetVariable $ Ident $ show v emit $ Srem I64 (VIdent (Ident $ show vabs)) v2 - emitDiv :: Exp -> Exp -> CompilerState + emitDiv :: Exp -> Exp -> CompilerState () emitDiv e1 e2 = do (v1,v2) <- binExprToValues e1 e2 increaseVarCount @@ -150,7 +148,7 @@ compile (Program prg) = do emit $ SetVariable $ Ident $ show v emit $ Div I64 v1 v2 - emitSub :: Exp -> Exp -> CompilerState + emitSub :: Exp -> Exp -> CompilerState () emitSub e1 e2 = do (v1,v2) <- binExprToValues e1 e2 increaseVarCount @@ -158,7 +156,7 @@ compile (Program prg) = do emit $ SetVariable $ Ident $ show v emit $ Sub I64 v1 v2 - exprToValue :: Exp -> State CodeGenerator Value + exprToValue :: Exp -> CompilerState Value exprToValue (EInt i) = return $ VInteger i exprToValue (EId i) = return $ VIdent i exprToValue e = do @@ -166,7 +164,7 @@ compile (Program prg) = do v <- gets variableCount return $ VIdent $ Ident $ show v - binExprToValues :: Exp -> Exp -> State CodeGenerator (Value, Value) + binExprToValues :: Exp -> Exp -> CompilerState (Value, Value) binExprToValues e1 e2 = do v1 <- exprToValue e1 v2 <- exprToValue e2 diff --git a/src/Compiler/LLVMIr.hs b/src/Compiler/LLVMIr.hs index 3e83e9d..c503b61 100644 --- a/src/Compiler/LLVMIr.hs +++ b/src/Compiler/LLVMIr.hs @@ -1,7 +1,7 @@ {-# LANGUAGE LambdaCase #-} 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 data LLVMType = I1 | I8 | I32 | I64 | Ptr @@ -53,8 +53,8 @@ data LLVMIr = Define LLVMType Ident Params deriving (Show) -- | Converts a LLVM inststruction to a String, allowing for printing etc. -printLLVMIr :: LLVMIr -> String -printLLVMIr = \case +llvmIrToString :: LLVMIr -> String +llvmIrToString = \case (Define t (Ident i) params) -> concat ["define ", show t, " @", i, "(" , intercalate "," (fmap (\(x,Ident y) -> unwords [show x, "%"<>y]) params) ,") {\n"] @@ -88,4 +88,4 @@ printLLVMIr = \case (Ret t v) -> concat ["ret ", show t , " ", show v, "\n"] (UnsafeRaw s) -> s - (Comment s) -> "; " <> s <> "\n" \ No newline at end of file + (Comment s) -> "; " <> s <> "\n"