summaryrefslogtreecommitdiff
path: root/main.hs
blob: ca953a8daa8929650d59f4774b808c3e85f2e3b5 (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
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
module Main where

import Control.Monad
import Control.Monad.Except
import Data.Either
import System.Environment
import System.Exit
import qualified Data.ByteString as BS
import qualified LLVM.General as General
import qualified LLVM.General.Analysis as General
import qualified LLVM.General.Context as General
import qualified LLVM.General.PassManager as General
import qualified LLVM.General.Target as General

import Check
import Codegen
import Parser
import PShow


fromLeft :: Either a b -> a
fromLeft (Left a) = a
fromLeft (Right _) = error "Either is not a Left"

fromRight :: Either a b -> b
fromRight (Right b) = b
fromRight (Left _) = error "Either is not a Right"

dieShow :: (Show a) => a -> IO ()
dieShow = die . show


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
    args <- getArgs
    when (length args /= 1) $ die "Pass NL file name as a command-line parameter"

    let fname = args !! 0
    parseResult <- (\file -> parseProgram file fname) <$> readFile fname

    when (isLeft parseResult) $ dieShow $ fromLeft parseResult
    
    let ast = fromRight parseResult
    putStrLn $ pshow ast

    checked <- either die return $ checkProgram ast
    putStrLn "After checking:"
    putStrLn $ pshow checked

    llvmMod <- either die return $ codegen checked "Module" fname
    putStrLn "Module:"
    print llvmMod

    putStrLn "Calling withContext:"
    General.withContext $ \context -> do
        putStrLn "Calling withModuleFromAST:"
        assert $ General.withModuleFromAST context llvmMod $ \genmod -> do
            putStrLn "Calling withPassManager:"
            General.withPassManager (General.defaultCuratedPassSetSpec {General.optLevel = Just 1}) $ \pm -> do
                putStrLn "Calling moduleLLVMAssembly:"
                llvmasm1 <- General.moduleLLVMAssembly genmod
                putStr llvmasm1
                putStrLn ""

                putStrLn "Calling verify:"
                res <- runExceptT (General.verify genmod)
                either die return res

                putStrLn "Calling runPassManager:"
                modified <- General.runPassManager pm genmod
                if modified
                then putStrLn "Pass manager modified the module"
                else putStrLn "Pass manager had no effect on the module"

                putStrLn "Calling moduleLLVMAssembly:"
                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