summaryrefslogtreecommitdiff
path: root/ll/gen.hs
blob: 907a489499b25c1a0a8352b64b11e353cfebe08b (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
import qualified LLVM.General.AST.Type as AST
import qualified LLVM.General.AST.Global as AST
import qualified LLVM.General.AST.Constant as AST.C
import qualified LLVM.General.AST.Operand as AST
import qualified LLVM.General.AST.Name as AST
import qualified LLVM.General.AST.Instruction as AST
import qualified LLVM.General.AST as AST
import qualified LLVM.General as General
import qualified LLVM.General.Context as General
import qualified LLVM.General.Target as General
import Control.Monad.Except
import qualified Data.ByteString as BS
import System.Exit


bb1 :: AST.BasicBlock
bb1 = AST.BasicBlock (AST.Name "bb1")
                     [AST.Name "s" AST.:= AST.Add False False
                                                  (AST.LocalReference AST.i32 (AST.Name "argc"))
                                                  (AST.ConstantOperand (AST.C.Int 32 1))
                                                  []]
                     (AST.Do $ AST.Ret (Just $ AST.LocalReference AST.i32 (AST.Name "s")) [])

func :: AST.Global
func = AST.functionDefaults {
        AST.returnType = AST.i32,
        AST.name = AST.Name "main",
        AST.parameters =
            ([AST.Parameter AST.i32 (AST.Name "argc") [],
              AST.Parameter (AST.ptr (AST.ptr AST.i8)) (AST.Name "argv") []],
             False),
        AST.basicBlocks = [bb1]
    }

topmod :: AST.Module
topmod = AST.defaultModule {AST.moduleDefinitions = [AST.GlobalDefinition func]}


assert :: ExceptT String IO a -> IO a
assert ex = do
    e <- runExceptT ex
    either die return e >> (return $ (\(Right r) -> r) e)

main :: IO ()
main = do
    General.withContext $ \context -> do
        assert $ General.withModuleFromAST context topmod $ \genmod -> do
            llvmasm <- General.moduleLLVMAssembly genmod
            putStr llvmasm
            putStrLn ""
            assert $ General.withHostTargetMachine $ \machine -> do
                General.getTargetMachineTriple machine >>= putStrLn
                putStrLn ""
                assert (General.moduleTargetAssembly machine genmod)
                    >>= putStr
                bs <- assert $ General.moduleObject machine genmod
                BS.writeFile "output_gen.o" bs