diff --git a/language.cabal b/language.cabal index 7a9c2f8..a49dc5f 100644 --- a/language.cabal +++ b/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 - , mtl - , containers - , either - , array - , template-haskell + base >=4.16.0.0 + , mtl + , containers + , either + , array + , template-haskell + --, llvm-tf default-language: GHC2021 diff --git a/src/Compiler/Compiler.hs b/src/Compiler/Compiler.hs index 84fb3af..b31fc9e 100644 --- a/src/Compiler/Compiler.hs +++ b/src/Compiler/Compiler.hs @@ -1,34 +1,126 @@ module Compiler.Compiler where -import Control.Applicative (Applicative) -import Control.Monad.Except (Except, MonadError (throwError), - liftEither) -import Data.Either.Combinators (maybeToRight) -import Data.Map (Map) -import qualified Data.Map as Map +import Compiler.StandardLLVMLibrary (standardLLVMLibrary) +import Control.Applicative (Applicative) +import Control.Monad.Except (Except, MonadError (throwError), + liftEither) +import Control.Monad.State +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 System.Exit (exitFailure) +import Grammar.Par (myLexer, pProgram) +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 - putStrLn $ printTree cor - compile cor + Right cor -> compile cor --- data Compiler = Compiler --- { data :: [LLVMIr] } --- --- data LLVMIr = LLVMIr +data Type = I8 | I32 | I64 | Ptr | Ref Type | Array Integer Type +instance Show Type where + show :: Type -> String + 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" \ No newline at end of file +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 diff --git a/src/Compiler/standard_library.ll b/src/Compiler/standard_library.ll index 1957058..cd0faf5 100644 --- a/src/Compiler/standard_library.ll +++ b/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) { diff --git a/src/Main.hs b/src/Main.hs index ed753f2..fbfe0eb 100644 --- a/src/Main.hs +++ b/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 - Left err -> do - putStrLn "INTERPRETER ERROR" - putStrLn err - exitFailure - Right i -> do - print i - exitSuccess + Right prg -> compile prg diff --git a/test/simple.sf b/test/simple.sf index 209b013..1d6e15f 100644 --- a/test/simple.sf +++ b/test/simple.sf @@ -2,4 +2,4 @@ -main = -12321 +main = 451512 diff --git a/test/simple_goal.s b/test/simple_goal.s deleted file mode 100644 index c90b572..0000000 --- a/test/simple_goal.s +++ /dev/null @@ -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