summaryrefslogtreecommitdiff
path: root/main.hs
blob: b4a66d0ba6e6e97cfcd5aecff49dd0ef0710ffd6 (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
module Main where

import Control.Monad
import Control.Monad.Except
import Data.Either
import System.Environment
import System.Exit
import qualified LLVM.General as General
import qualified LLVM.General.Context 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

    General.withContext $ \context -> do
        assert $ General.withModuleFromAST context llvmMod $ \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