diff --git a/language.cabal b/language.cabal index 0017feb..61bb4aa 100644 --- a/language.cabal +++ b/language.cabal @@ -34,6 +34,7 @@ executable language Compiler.Compiler Compiler.StandardLLVMLibrary Compiler.TH + Compiler.LLVMIr Interpreter hs-source-dirs: src diff --git a/src/Compiler/Compiler.hs b/src/Compiler/Compiler.hs index fc72cf8..26dc980 100644 --- a/src/Compiler/Compiler.hs +++ b/src/Compiler/Compiler.hs @@ -1,42 +1,13 @@ -{-# LANGUAGE LambdaCase #-} module Compiler.Compiler where import Compiler.StandardLLVMLibrary (standardLLVMLibrary) import Control.Monad.State (State, execState, gets, modify) -import Data.List (intercalate) import Data.Set as Set -import Grammar.Abs (Def (..), Exp (..), Ident (..), - Program (..), Type (..)) +import Grammar.Abs (Def (..), Exp (..), Ident (..) + , Program (..), Type (..)) import Grammar.Print (printTree) - --- | A datatype which represents some basic LLVM types -data LLType = I1 | I8 | I32 | I64 | Ptr - | Ref LLType | Array Integer LLType | CustomType Ident - -instance Show LLType where - show :: LLType -> String - show t = case t of - I1 -> "i1" - I8 -> "i8" - I32 -> "i32" - I64 -> "i64" - Ptr -> "ptr" - Ref ty -> show ty <> "*" - Array n ty -> concat ["[", show n, " x ", show ty, "]"] - CustomType (Ident ty) -> ty - -type Params = [(LLType, Ident)] -type Args = [(LLType, Value)] - --- | Represents a LLVM "value", as in an integer, a register variable, --- or a string contstant -data Value = VInteger Integer | VIdent Ident | VConstant String -instance Show Value where - show :: Value -> String - show v = case v of - VInteger i -> show i - VIdent (Ident i) -> "%" <> i - VConstant s -> "c" <> show s +import Compiler.LLVMIr (LLVMIr(..), Value(..) + , printLLVMIr, LLVMType(..)) -- | The record used as the code generator state data CodeGenerator = CodeGenerator @@ -54,64 +25,6 @@ defaultCodeGenerator = CodeGenerator , block = Set.empty , variableCount = 0 } --- | A datatype which represents different instructions in LLVM -data LLVMIr = Define LLType Ident Params - | DefineEnd - | Declare LLType Ident Params - | SetVariable Ident - | Add LLType Value Value - | Sub LLType Value Value - | Div LLType Value Value - | Mul LLType Value Value - | Srem LLType Value Value - | Call LLType Ident Args - | Alloca LLType - | Store LLType Ident LLType Ident - | Bitcast LLType Ident LLType - | Ret LLType Value - | Comment String - | UnsafeRaw String -- This should generally be avoided, and proper - -- instructions should be used in its place - deriving (Show) - --- | Converts a LLVM inststruction to a String, allowing for printing etc. -printLLVMIr :: LLVMIr -> String -printLLVMIr = \case - (Define t (Ident i) params) -> concat ["define ", show t, " @", i, "(" - , intercalate "," (fmap (\(x,Ident y) -> unwords [show x, "%"<>y]) params) - ,") {\n"] - DefineEnd -> "}\n" - (Declare _t (Ident _i) _params) -> undefined - (SetVariable (Ident i)) -> concat ["%", i, " = "] - (Add t v1 v2) -> concat ["add ", show t, " " - , show v1, ", ", show v2 - , "\n"] - (Sub t v1 v2) -> concat ["sub ", show t, " " - , show v1, ", " - , show v2, "\n"] - (Div t v1 v2) -> concat ["sdiv ", show t, " " - , show v1, ", " - , show v2, "\n"] - (Mul t v1 v2) -> concat ["mul ", show t, " " - , show v1, ", " - , show v2, "\n"] - (Srem t v1 v2) -> concat ["srem ", show t, " " - , show v1, ", " - , show v2, "\n"] - (Call t (Ident i) arg) -> concat ["call ", show t, " @", i, "(" - , intercalate ", " $ Prelude.map (\(x,y) -> show x <> " " <> show y) arg - , ")\n"] - (Alloca t) -> unwords ["alloca", show t, "\n"] - (Store t1 (Ident id1) t2 (Ident id2)) -> concat ["store ", show t1, " %" - , id1, ", ", show t2, " %" - , id2, "\n"] - (Bitcast t1 (Ident i) t2) -> concat ["bitcast ", show t1, " %" - , i, " to ", show t2, "\n"] - (Ret t v) -> concat ["ret ", show t - , " ", show v, "\n"] - (UnsafeRaw s) -> s - (Comment s) -> "; " <> s <> "\n" - -- | Adds a instruction to the CodeGenerator state emit :: LLVMIr -> CompilerState emit l = modify (\t -> t {instructions = instructions t ++ [l]}) @@ -262,7 +175,7 @@ compile (Program prg) = do -- | A pretty nasty function to flatten out function types, -- as they are currently represented by a recursive data type. -flattenFuncType :: Type -> (LLType, [LLType]) +flattenFuncType :: Type -> (LLVMType, [LLVMType]) flattenFuncType xs = do let res = go xs (last res, init res) diff --git a/src/Compiler/LLVMIr.hs b/src/Compiler/LLVMIr.hs new file mode 100644 index 0000000..3e83e9d --- /dev/null +++ b/src/Compiler/LLVMIr.hs @@ -0,0 +1,91 @@ +{-# LANGUAGE LambdaCase #-} +module Compiler.LLVMIr where +import Grammar.Abs (Ident (Ident)) +import Data.List (intercalate) + +-- | A datatype which represents some basic LLVM types +data LLVMType = I1 | I8 | I32 | I64 | Ptr + | Ref LLVMType | Array Integer LLVMType | CustomType Ident + +instance Show LLVMType where + show :: LLVMType -> String + show t = case t of + I1 -> "i1" + I8 -> "i8" + I32 -> "i32" + I64 -> "i64" + Ptr -> "ptr" + Ref ty -> show ty <> "*" + Array n ty -> concat ["[", show n, " x ", show ty, "]"] + CustomType (Ident ty) -> ty + +-- | Represents a LLVM "value", as in an integer, a register variable, +-- or a string contstant +data Value = VInteger Integer | VIdent Ident | VConstant String +instance Show Value where + show :: Value -> String + show v = case v of + VInteger i -> show i + VIdent (Ident i) -> "%" <> i + VConstant s -> "c" <> show s + +type Params = [(LLVMType, Ident)] +type Args = [(LLVMType, Value)] + +-- | A datatype which represents different instructions in LLVM +data LLVMIr = Define LLVMType Ident Params + | DefineEnd + | Declare LLVMType Ident Params + | SetVariable Ident + | Add LLVMType Value Value + | Sub LLVMType Value Value + | Div LLVMType Value Value + | Mul LLVMType Value Value + | Srem LLVMType Value Value + | Call LLVMType Ident Args + | Alloca LLVMType + | Store LLVMType Ident LLVMType Ident + | Bitcast LLVMType Ident LLVMType + | Ret LLVMType Value + | Comment String + | UnsafeRaw String -- This should generally be avoided, and proper + -- instructions should be used in its place + deriving (Show) + +-- | Converts a LLVM inststruction to a String, allowing for printing etc. +printLLVMIr :: LLVMIr -> String +printLLVMIr = \case + (Define t (Ident i) params) -> concat ["define ", show t, " @", i, "(" + , intercalate "," (fmap (\(x,Ident y) -> unwords [show x, "%"<>y]) params) + ,") {\n"] + DefineEnd -> "}\n" + (Declare _t (Ident _i) _params) -> undefined + (SetVariable (Ident i)) -> concat ["%", i, " = "] + (Add t v1 v2) -> concat ["add ", show t, " " + , show v1, ", ", show v2 + , "\n"] + (Sub t v1 v2) -> concat ["sub ", show t, " " + , show v1, ", " + , show v2, "\n"] + (Div t v1 v2) -> concat ["sdiv ", show t, " " + , show v1, ", " + , show v2, "\n"] + (Mul t v1 v2) -> concat ["mul ", show t, " " + , show v1, ", " + , show v2, "\n"] + (Srem t v1 v2) -> concat ["srem ", show t, " " + , show v1, ", " + , show v2, "\n"] + (Call t (Ident i) arg) -> concat ["call ", show t, " @", i, "(" + , intercalate ", " $ Prelude.map (\(x,y) -> show x <> " " <> show y) arg + , ")\n"] + (Alloca t) -> unwords ["alloca", show t, "\n"] + (Store t1 (Ident id1) t2 (Ident id2)) -> concat ["store ", show t1, " %" + , id1, ", ", show t2, " %" + , id2, "\n"] + (Bitcast t1 (Ident i) t2) -> concat ["bitcast ", show t1, " %" + , i, " to ", show t2, "\n"] + (Ret t v) -> concat ["ret ", show t + , " ", show v, "\n"] + (UnsafeRaw s) -> s + (Comment s) -> "; " <> s <> "\n" \ No newline at end of file