Made a simple code generator that outputs to LLVM IR

language.cabal

@@ -12,6 +12,7 @@ build-type:         Simple
 
 extra-doc-files:    CHANGELOG.md
 
+
 extra-source-files:
   Grammar.cf
 
@@ -38,11 +39,12 @@ executable language
     hs-source-dirs:   src
 
     build-depends:    
-        base ^>=4.17.0.0
+        base >=4.16.0.0
-      , mtl
+        , mtl
-      , containers
+        , containers
-      , either
+        , either
-      , array
+        , array
-      , template-haskell
+        , template-haskell
+        --, llvm-tf
 
     default-language: GHC2021

src/Compiler/Compiler.hs

@@ -1,34 +1,126 @@
 module Compiler.Compiler where
 
-import           Control.Applicative     (Applicative)
+import           Compiler.StandardLLVMLibrary (standardLLVMLibrary)
-import           Control.Monad.Except    (Except, MonadError (throwError),
+import           Control.Applicative          (Applicative)
-                                          liftEither)
+import           Control.Monad.Except         (Except, MonadError (throwError),
-import           Data.Either.Combinators (maybeToRight)
+                                               liftEither)
-import           Data.Map                (Map)
+import           Control.Monad.State
-import qualified Data.Map                as Map
+import           Data.Either.Combinators      (maybeToRight)
+import           Data.List                    (intercalate)
+import           Data.Set                     (Set)
+import           Data.Set                     as Set
 import           Grammar.Abs
-import           Grammar.Print           (printTree)
+import           Grammar.Par                  (myLexer, pProgram)
-import Grammar.Par (myLexer,pProgram)
+import           System.Exit                  (exitFailure)
-import System.Exit (exitFailure)
+--import LLVM.AST
 
 compileFile :: String -> IO ()
-compileFile file = do 
+compileFile file = do
     input <- readFile file
-    case pProgram (myLexer input) of 
+    case pProgram (myLexer input) of
         Left err -> do
             putStrLn "SYNTAX ERROR"
             putStrLn err
             exitFailure
-        Right cor -> do
+        Right cor -> compile cor
-            putStrLn $ printTree cor
-            compile cor
 
--- data Compiler = Compiler 
+data Type = I8 | I32 | I64 | Ptr | Ref Type | Array Integer Type
---     { data :: [LLVMIr] }
+instance Show Type where
--- 
+    show :: Type -> String
--- data LLVMIr = LLVMIr
+    show t = case t of
+        I8         -> "i8"
+        I32        -> "i32"
+        I64        -> "i64"
+        Ptr        -> "ptr"
+        Ref ty     -> show ty <> "*"
+        Array n ty -> concat ["[", show n, " x ", show ty, "]"]
 
+type Params = [Type]
+type Args = [(Type, Value)]
 
+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
+
+data CodeGenerator = CodeGenerator
+                   { instructions  :: [LLVMIr]
+                   , methods       :: [Ident]
+                   , blocks        :: [Set Ident]
+                   , variableCount :: Integer }
+    deriving Show
+defaultCodeGenerator :: CodeGenerator
+defaultCodeGenerator = CodeGenerator {instructions=[], methods=[], blocks=[], variableCount=0}
+
+data LLVMIr = Define Type Ident Params
+            | DefineEnd
+            | Declare Type Ident Params
+            | Variable Ident
+            | Add Type Value Value
+            | Call Type Ident Args
+            | Alloca Type
+            | Store Type Ident Type Ident
+            | Bitcast Type Ident Type
+            | Ret Type Value
+            | UnsafeRaw String
+    deriving (Show)
+
+printLLVMIr :: LLVMIr -> String
+printLLVMIr (Define t (Ident i) params)           = concat ["define ", show t, " @", i, "(", intercalate "," (fmap show params),") {\n"]
+printLLVMIr DefineEnd                             = "}\n"
+printLLVMIr (Declare t (Ident i) params)          = undefined
+printLLVMIr (Variable (Ident i))                  = concat ["%", i, " = "]
+printLLVMIr (Add t v1 v2)                         = concat ["add ", show t, " ", show v1, ", ", show v2, "\n"]
+printLLVMIr (Call t (Ident i) arg)                = concat ["call ", show t, " @", i, "("
+                                                           , concatMap (\(x,y) -> show x <> " " <> show y) arg
+                                                           , ")\n"]
+printLLVMIr (Alloca t)                            = unwords ["alloca", show t, "\n"]
+printLLVMIr (Store t1 (Ident id1) t2 (Ident id2)) = concat ["store ", show t1, " %", id1
+                                                           , ", ", show t2, " %", id2, "\n"]
+printLLVMIr (Bitcast t1 (Ident i) t2)             = concat ["bitcast ", show t1, " %", i, " to ", show t2, "\n"]
+printLLVMIr (Ret t v)                             = concat ["ret ", show t, " ", show v, "\n"]
+printLLVMIr (UnsafeRaw s)                         = s
+
+emit :: LLVMIr -> State CodeGenerator ()
+emit l = modify (\t -> t {instructions = instructions t ++ [l]})
+
+increaseVarCount :: State CodeGenerator ()
+increaseVarCount = modify (\t -> t {variableCount = variableCount t + 1})
 
 compile :: Program -> IO ()
-compile p = print "hej"
+compile (Program e) = do
+    --Asp
+    let s = defaultCodeGenerator {instructions = [
+        UnsafeRaw $ standardLLVMLibrary <> "\n",
+        --UnsafeRaw "declare i32 @puts(i8* nocapture) nounwind\n",
+        --UnsafeRaw "declare [21 x i8] @i64ToString(i64)\n",
+        Define I32 (Ident "main") []
+    ]}
+    let fin = execState (go e) s
+    let ins = instructions fin
+    let var = variableCount fin
+    putStrLn $ concatMap printLLVMIr (ins ++
+        [ Variable (Ident "print_res")
+        , Call (Array 21 I8) (Ident "i64ToString") [(I64, VIdent $ Ident $ show var)]
+        , Variable (Ident "print_ptr"), Alloca (Array 21 I8)
+        , Store (Array 21 I8) (Ident "print_res") (Ref (Array 21 I8)) (Ident "print_ptr")
+        , Variable (Ident "printable"), Bitcast (Ref (Array 21 I8)) (Ident "print_ptr") (Ref I8)
+        , Call I32 (Ident "puts") [(Ref I8, VIdent (Ident "printable"))]
+        , Ret I32 (VInteger 0)
+        , DefineEnd
+        ])
+    where
+        go :: Exp -> State CodeGenerator ()
+        go (EId  id)    = undefined
+        go (EInt int)   = do
+            increaseVarCount
+            varCount <- gets variableCount
+            emit $ Variable $ Ident (show varCount)
+            emit $ Add I64 (VInteger int) (VInteger 0)
+
+        go (EApp e1 e2) = undefined
+        go (EAdd e1 e2) = undefined
+        go (EAbs id e)  = undefined

src/Compiler/standard_library.ll

@@ -1,4 +1,5 @@
 declare i64 @llvm.abs.i64(i64, i1 immarg) 
+declare i32 @puts(i8* nocapture) nounwind
 
 
 define [21 x i8] @i64ToString(i64 %val_org) {

src/Main.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE LambdaCase #-}
 module Main where
 
+import           Compiler.Compiler    (compile)
 import           Control.Monad.Except (runExcept)
 import           Grammar.Par          (myLexer, pProgram)
 import           Interpreter          (interpret)
@@ -17,14 +18,7 @@ main = getArgs >>= \case
        putStrLn "SYNTAX ERROR"
        putStrLn err
        exitFailure
-      Right prg -> case runExcept $ interpret prg of
+      Right prg -> compile prg
-        Left err -> do
-          putStrLn "INTERPRETER ERROR"
-          putStrLn err
-          exitFailure
-        Right i -> do
-          print i
-          exitSuccess
 
 
 

test/simple.sf

@@ -2,4 +2,4 @@
 
 
 
-main = -12321
+main = 451512

test/simple_goal.s

@@ -1,120 +0,0 @@
-	.text
-	.file	"simple_goal.ll"
-	.globl	i64ToString                     # -- Begin function i64ToString
-	.p2align	4, 0x90
-	.type	i64ToString,@function
-i64ToString:                            # @i64ToString
-	.cfi_startproc
-# %bb.0:
-	pushq	%rbp
-	.cfi_def_cfa_offset 16
-	pushq	%r15
-	.cfi_def_cfa_offset 24
-	pushq	%r14
-	.cfi_def_cfa_offset 32
-	pushq	%r13
-	.cfi_def_cfa_offset 40
-	pushq	%r12
-	.cfi_def_cfa_offset 48
-	pushq	%rbx
-	.cfi_def_cfa_offset 56
-	subq	$40, %rsp
-	.cfi_def_cfa_offset 96
-	.cfi_offset %rbx, -56
-	.cfi_offset %r12, -48
-	.cfi_offset %r13, -40
-	.cfi_offset %r14, -32
-	.cfi_offset %r15, -24
-	.cfi_offset %rbp, -16
-	movq	%rsi, %r12
-	movq	%rdi, %r14
-	movabsq	$7810763617093968238, %rax      # imm = 0x6C656820656E616E
-	movq	%rax, 22(%rsp)
-	movabsq	$7017206772232710740, %rax      # imm = 0x616220616E656A54
-	movq	%rax, 14(%rsp)
-	movw	$10, 34(%rsp)
-	movl	$1634955116, 30(%rsp)           # imm = 0x61736F6C
-	movl	$0, 36(%rsp)
-	leaq	14(%rsp), %rax
-	testq	%rsi, %rsi
-	js	.LBB0_1
-# %bb.2:                                # %negative_check_false
-	movb	$43, (%rax)
-	jmp	.LBB0_3
-.LBB0_1:                                # %negative_check_true
-	movb	$45, (%rax)
-.LBB0_3:                                # %negative_check_done
-	movabsq	$7378697629483820647, %r13      # imm = 0x6666666666666667
-	leaq	14(%rsp), %r15
-	.p2align	4, 0x90
-.LBB0_4:                                # %while_point
-                                        # =>This Inner Loop Header: Depth=1
-	movq	%r12, %rax
-	imulq	%r13
-	movq	%rdx, %rbx
-	movq	%rdx, %rbp
-	shrq	$63, %rbp
-	sarq	$2, %rbx
-	movq	%r15, %rdi
-	callq	puts@PLT
-	addq	%rbp, %rbx
-	jne	.LBB0_4
-# %bb.5:                                # %while_break
-	movq	14(%rsp), %rax
-	movq	22(%rsp), %rcx
-	movl	30(%rsp), %edx
-	movzwl	34(%rsp), %esi
-	movw	%si, 20(%r14)
-	movl	%edx, 16(%r14)
-	movq	%rcx, 8(%r14)
-	movq	%rax, (%r14)
-	movq	%r14, %rax
-	addq	$40, %rsp
-	.cfi_def_cfa_offset 56
-	popq	%rbx
-	.cfi_def_cfa_offset 48
-	popq	%r12
-	.cfi_def_cfa_offset 40
-	popq	%r13
-	.cfi_def_cfa_offset 32
-	popq	%r14
-	.cfi_def_cfa_offset 24
-	popq	%r15
-	.cfi_def_cfa_offset 16
-	popq	%rbp
-	.cfi_def_cfa_offset 8
-	retq
-.Lfunc_end0:
-	.size	i64ToString, .Lfunc_end0-i64ToString
-	.cfi_endproc
-                                        # -- End function
-	.globl	main                            # -- Begin function main
-	.p2align	4, 0x90
-	.type	main,@function
-main:                                   # @main
-	.cfi_startproc
-# %bb.0:
-	subq	$56, %rsp
-	.cfi_def_cfa_offset 64
-	leaq	12(%rsp), %rdi
-	movl	$200, %esi
-	callq	i64ToString@PLT
-	movzwl	32(%rsp), %eax
-	movl	28(%rsp), %ecx
-	movq	12(%rsp), %rdx
-	movq	20(%rsp), %rsi
-	movq	%rdx, 34(%rsp)
-	movq	%rsi, 42(%rsp)
-	movl	%ecx, 50(%rsp)
-	movw	%ax, 54(%rsp)
-	leaq	34(%rsp), %rdi
-	callq	puts@PLT
-	xorl	%eax, %eax
-	addq	$56, %rsp
-	.cfi_def_cfa_offset 8
-	retq
-.Lfunc_end1:
-	.size	main, .Lfunc_end1-main
-	.cfi_endproc
-                                        # -- End function
-	.section	".note.GNU-stack","",@progbits