Splat LLVM Ir into its own file.
This commit is contained in:
Samuel Hammersberg
parent
1637dcd495
commit
e7ef268c12
3 changed files with 97 additions and 92 deletions
|
|
@ -34,6 +34,7 @@ executable language
|
|||
Compiler.Compiler
|
||||
Compiler.StandardLLVMLibrary
|
||||
Compiler.TH
|
||||
Compiler.LLVMIr
|
||||
Interpreter
|
||||
|
||||
hs-source-dirs: src
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
91
src/Compiler/LLVMIr.hs
Normal file
91
src/Compiler/LLVMIr.hs
Normal file
|
|
@ -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"
|
||||
Loading…
Add table
Add a link
Reference in a new issue