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

Added the trait ToIr.

Browse source
This commit is contained in:
Samuel Hammersberg 2023-03-23 16:13:59 +01:00
parent 129a70e051
commit bf0064db86
2 changed files with 66 additions and 63 deletions
Download patch file Download diff file Expand all files Collapse all files

6
src/Codegen/Codegen.hs
View file

@ -181,7 +181,7 @@ compileScs [] = do
enumerateOneM_ (\i (GA.Ident arg_n, arg_t) -> do enumerateOneM_ (\i (GA.Ident arg_n, arg_t) -> do
let arg_t' = type2LlvmType arg_t let arg_t' = type2LlvmType arg_t
emit $ Comment (show arg_t' <>" "<> arg_n <> " " <> show i ) emit $ Comment (toIr arg_t' <>" "<> arg_n <> " " <> show i )
elemPtr <- getNewVar elemPtr <- getNewVar
emit $ SetVariable elemPtr ( emit $ SetVariable elemPtr (
GetElementPtr (CustomType id) (Ref (CustomType id)) GetElementPtr (CustomType id) (Ref (CustomType id))
@ -233,7 +233,7 @@ mainContent var =
-- " %3 = bitcast %Craig* %2 to i72*\n" <> -- " %3 = bitcast %Craig* %2 to i72*\n" <>
-- " %4 = load i72, ptr %3\n" <> -- " %4 = load i72, ptr %3\n" <>
-- " call i32 (ptr, ...) @printf(ptr noundef @.str, i72 noundef %4)\n" -- " call i32 (ptr, ...) @printf(ptr noundef @.str, i72 noundef %4)\n"
"call i32 (ptr, ...) @printf(ptr noundef @.str, i64 noundef " <> show var <> ")\n" "call i32 (ptr, ...) @printf(ptr noundef @.str, i64 noundef " <> toIr var <> ")\n"
, -- , SetVariable (GA.Ident "p") (Icmp LLEq I64 (VInteger 2) (VInteger 2)) , -- , SetVariable (GA.Ident "p") (Icmp LLEq I64 (VInteger 2) (VInteger 2))
-- , BrCond (VIdent (GA.Ident "p")) (GA.Ident "b_1") (GA.Ident "b_2") -- , BrCond (VIdent (GA.Ident "p")) (GA.Ident "b_1") (GA.Ident "b_2")
-- , Label (GA.Ident "b_1") -- , Label (GA.Ident "b_1")
@ -323,7 +323,7 @@ emitECased t e cases = do
LInt l -> emit $ Icmp LLEq I64 (VIdent testVar Ptr) (VInteger l) LInt l -> emit $ Icmp LLEq I64 (VIdent testVar Ptr) (VInteger l)
LChar c -> emit $ Icmp LLEq I8 (VIdent testVar Ptr) (VChar c) LChar c -> emit $ Icmp LLEq I8 (VIdent testVar Ptr) (VChar c)
CatchAll -> emit . Comment $ "Catch all" CatchAll -> emit . Comment $ "Catch all"
emit . Comment $ "return this " <> show val emit . Comment $ "return this " <> toIr val
emit . Comment . show $ c emit . Comment . show $ c
emit . Comment . show $ i emit . Comment . show $ i
) cs ) cs

123
src/Codegen/LlvmIr.hs
View file

@ -7,19 +7,20 @@ module Codegen.LlvmIr (
LLVMValue (..), LLVMValue (..),
LLVMComp (..), LLVMComp (..),
Visibility (..), Visibility (..),
CallingConvention (..) CallingConvention (..),
ToIr(..)
) where ) where
import Data.List (intercalate) import Data.List (intercalate)
import Grammar.Abs (Ident (..)) import Grammar.Abs (Ident (..))
data CallingConvention = TailCC | FastCC | CCC | ColdCC data CallingConvention = TailCC | FastCC | CCC | ColdCC
instance Show CallingConvention where instance ToIr CallingConvention where
show :: CallingConvention -> String toIr :: CallingConvention -> String
show TailCC = "tailcc" toIr TailCC = "tailcc"
show FastCC = "fastcc" toIr FastCC = "fastcc"
show CCC = "ccc" toIr CCC = "ccc"
show ColdCC = "coldcc" toIr ColdCC = "coldcc"
-- | A datatype which represents some basic LLVM types -- | A datatype which represents some basic LLVM types
data LLVMType data LLVMType
@ -33,17 +34,20 @@ data LLVMType
| Array Integer LLVMType | Array Integer LLVMType
| CustomType Ident | CustomType Ident
instance Show LLVMType where class ToIr a where
show :: LLVMType -> String toIr :: a -> String
show = \case
instance ToIr LLVMType where
toIr :: LLVMType -> String
toIr = \case
I1 -> "i1" I1 -> "i1"
I8 -> "i8" I8 -> "i8"
I32 -> "i32" I32 -> "i32"
I64 -> "i64" I64 -> "i64"
Ptr -> "ptr" Ptr -> "ptr"
Ref ty -> show ty <> "*" Ref ty -> toIr ty <> "*"
Function t xs -> show t <> " (" <> intercalate ", " (map show xs) <> ")*" Function t xs -> toIr t <> " (" <> intercalate ", " (map toIr xs) <> ")*"
Array n ty -> concat ["[", show n, " x ", show ty, "]"] Array n ty -> concat ["[", show n, " x ", toIr ty, "]"]
CustomType (Ident ty) -> "%" <> ty CustomType (Ident ty) -> "%" <> ty
data LLVMComp data LLVMComp
@ -57,9 +61,9 @@ data LLVMComp
| LLSge | LLSge
| LLSlt | LLSlt
| LLSle | LLSle
instance Show LLVMComp where instance ToIr LLVMComp where
show :: LLVMComp -> String toIr :: LLVMComp -> String
show = \case toIr = \case
LLEq -> "eq" LLEq -> "eq"
LLNe -> "ne" LLNe -> "ne"
LLUgt -> "ugt" LLUgt -> "ugt"
@ -72,10 +76,10 @@ instance Show LLVMComp where
LLSle -> "sle" LLSle -> "sle"
data Visibility = Local | Global data Visibility = Local | Global
instance Show Visibility where instance ToIr Visibility where
show :: Visibility -> String toIr :: Visibility -> String
show Local = "%" toIr Local = "%"
show Global = "@" toIr Global = "@"
-- | Represents a LLVM "value", as in an integer, a register variable, -- | Represents a LLVM "value", as in an integer, a register variable,
-- or a string contstant -- or a string contstant
@ -86,13 +90,13 @@ data LLVMValue
| VConstant String | VConstant String
| VFunction Ident Visibility LLVMType | VFunction Ident Visibility LLVMType
instance Show LLVMValue where instance ToIr LLVMValue where
show :: LLVMValue -> String toIr :: LLVMValue -> String
show v = case v of toIr v = case v of
VInteger i -> show i VInteger i -> show i
VChar i -> show i VChar i -> show i
VIdent (Ident n) _ -> "%" <> n VIdent (Ident n) _ -> "%" <> n
VFunction (Ident n) vis _ -> show vis <> n VFunction (Ident n) vis _ -> toIr vis <> n
VConstant s -> "c" <> show s VConstant s -> "c" <> show s
type Params = [(Ident, LLVMType)] type Params = [(Ident, LLVMType)]
@ -128,7 +132,6 @@ data LLVMIr
| Comment String | Comment String
| UnsafeRaw String -- This should generally be avoided, and proper | UnsafeRaw String -- This should generally be avoided, and proper
-- instructions should be used in its place -- instructions should be used in its place
deriving (Show)
-- | Converts a list of LLVMIr instructions to a string -- | Converts a list of LLVMIr instructions to a string
llvmIrToString :: [LLVMIr] -> String llvmIrToString :: [LLVMIr] -> String
@ -152,31 +155,31 @@ llvmIrToString = go 0
(GetElementPtr t1 t2 p t3 v1 t4 v2) -> do (GetElementPtr t1 t2 p t3 v1 t4 v2) -> do
-- getelementptr inbounds %Foo, %Foo* %x, i32 0, i32 0 -- getelementptr inbounds %Foo, %Foo* %x, i32 0, i32 0
concat concat
[ "getelementptr ", show t1, ", " , show t2 [ "getelementptr ", toIr t1, ", " , toIr t2
, " ", show p, ", ", show t3, " ", show v1 , " ", toIr p, ", ", toIr t3, " ", toIr v1
, ", ", show t4, " ", show v2, "\n" , ", ", toIr t4, " ", toIr v2, "\n"
] ]
(ExtractValue t1 v i) -> do (ExtractValue t1 v i) -> do
concat concat
[ "extractvalue ", show t1, " " [ "extractvalue ", toIr t1, " "
, show v, ", ", show i, "\n" , toIr v, ", ", show i, "\n"
] ]
(GetElementPtrInbounds t1 t2 p t3 v1 t4 v2) -> do (GetElementPtrInbounds t1 t2 p t3 v1 t4 v2) -> do
-- getelementptr inbounds %Foo, %Foo* %x, i32 0, i32 0 -- getelementptr inbounds %Foo, %Foo* %x, i32 0, i32 0
concat concat
[ "getelementptr inbounds ", show t1, ", " , show t2 [ "getelementptr inbounds ", toIr t1, ", " , toIr t2
, " ", show p, ", ", show t3, " ", show v1, , " ", toIr p, ", ", toIr t3, " ", toIr v1,
", ", show t4, " ", show v2, "\n" ] ", ", toIr t4, " ", toIr v2, "\n" ]
(Type (Ident n) types) -> (Type (Ident n) types) ->
concat concat
[ "%", n, " = type { " [ "%", n, " = type { "
, intercalate ", " (map show types) , intercalate ", " (map toIr types)
, " }\n" , " }\n"
] ]
(Define c t (Ident i) params) -> (Define c t (Ident i) params) ->
concat concat
[ "define ", show c, " ", show t, " @", i [ "define ", toIr c, " ", toIr t, " @", i
, "(", intercalate ", " (map (\(Ident y, x) -> unwords [show x, "%" <> y]) params) , "(", intercalate ", " (map (\(Ident y, x) -> unwords [toIr x, "%" <> y]) params)
, ") {\n" , ") {\n"
] ]
DefineEnd -> "}\n" DefineEnd -> "}\n"
@ -184,67 +187,67 @@ llvmIrToString = go 0
(SetVariable (Ident i) ir) -> concat ["%", i, " = ", insToString 0 ir] (SetVariable (Ident i) ir) -> concat ["%", i, " = ", insToString 0 ir]
(Add t v1 v2) -> (Add t v1 v2) ->
concat concat
[ "add ", show t, " ", show v1 [ "add ", toIr t, " ", toIr v1
, ", ", show v2, "\n" , ", ", toIr v2, "\n"
] ]
(Sub t v1 v2) -> (Sub t v1 v2) ->
concat concat
[ "sub ", show t, " ", show v1, ", " [ "sub ", toIr t, " ", toIr v1, ", "
, show v2, "\n" , toIr v2, "\n"
] ]
(Div t v1 v2) -> (Div t v1 v2) ->
concat concat
[ "sdiv ", show t, " ", show v1, ", " [ "sdiv ", toIr t, " ", toIr v1, ", "
, show v2, "\n" , toIr v2, "\n"
] ]
(Mul t v1 v2) -> (Mul t v1 v2) ->
concat concat
[ "mul ", show t, " ", show v1 [ "mul ", toIr t, " ", toIr v1
, ", ", show v2, "\n" , ", ", toIr v2, "\n"
] ]
(Srem t v1 v2) -> (Srem t v1 v2) ->
concat concat
[ "srem ", show t, " ", show v1, ", " [ "srem ", toIr t, " ", toIr v1, ", "
, show v2, "\n" , toIr v2, "\n"
] ]
(Call c t vis (Ident i) arg) -> (Call c t vis (Ident i) arg) ->
concat concat
[ "call ", show c, " ", show t, " ", show vis, i, "(" [ "call ", toIr c, " ", toIr t, " ", toIr vis, i, "("
, intercalate ", " $ Prelude.map (\(x, y) -> show x <> " " <> show y) arg , intercalate ", " $ Prelude.map (\(x, y) -> toIr x <> " " <> toIr y) arg
, ")\n" , ")\n"
] ]
(Alloca t) -> unwords ["alloca", show t, "\n"] (Alloca t) -> unwords ["alloca", toIr t, "\n"]
(Store t1 val t2 (Ident id2)) -> (Store t1 val t2 (Ident id2)) ->
concat concat
[ "store ", show t1, " ", show val [ "store ", toIr t1, " ", toIr val
, ", ", show t2 , " %", id2, "\n" , ", ", toIr t2 , " %", id2, "\n"
] ]
(Load t1 t2 (Ident addr)) -> (Load t1 t2 (Ident addr)) ->
concat concat
[ "load ", show t1, ", " [ "load ", toIr t1, ", "
, show t2, " %", addr, "\n" , toIr t2, " %", addr, "\n"
] ]
(Bitcast t1 v t2) -> (Bitcast t1 v t2) ->
concat concat
[ "bitcast ", show t1, " " [ "bitcast ", toIr t1, " "
, show v, " to ", show t2, "\n" , toIr v, " to ", toIr t2, "\n"
] ]
(Icmp comp t v1 v2) -> (Icmp comp t v1 v2) ->
concat concat
[ "icmp ", show comp, " ", show t [ "icmp ", toIr comp, " ", toIr t
, " ", show v1, ", ", show v2, "\n" , " ", toIr v1, ", ", toIr v2, "\n"
] ]
(Ret t v) -> (Ret t v) ->
concat concat
[ "ret ", show t, " " [ "ret ", toIr t, " "
, show v, "\n" , toIr v, "\n"
] ]
(UnsafeRaw s) -> s (UnsafeRaw s) -> s
(Label (Ident s)) -> "\n" <> lblPfx <> s <> ":\n" (Label (Ident s)) -> "\n" <> lblPfx <> s <> ":\n"
(Br (Ident s)) -> "br label %" <> lblPfx <> s <> "\n" (Br (Ident s)) -> "br label %" <> lblPfx <> s <> "\n"
(BrCond val (Ident s1) (Ident s2)) -> (BrCond val (Ident s1) (Ident s2)) ->
concat concat
[ "br i1 ", show val, ", ", "label %" [ "br i1 ", toIr val, ", ", "label %"
, lblPfx, s1, ", ", "label %", lblPfx, s2, "\n" , lblPfx, s1, ", ", "label %", lblPfx, s2, "\n"
] ]
(Comment s) -> "; " <> s <> "\n" (Comment s) -> "; " <> s <> "\n"