~jojo/Carth

ref: e6079d2231c2bf3b5fbdd0f22b3014624d852314 Carth/app/Main.hs -rw-r--r-- 2.1 KiB
e6079d22JoJo infer FunMatch 2 years ago
                                                                                
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
{-# LANGUAGE LambdaCase #-}

module Main (main) where

import Data.Functor
import System.Exit
import System.FilePath
import qualified LLVM.AST

import Misc
import Literate
import qualified Ast
import qualified AnnotAst
import qualified MonoAst
import Check
import Config
import Interp
import Codegen
import Compile
import Mono
import Parse

main :: IO ()
main = do
    getConfig >>= \case
        ModeInterp infile -> interpretFile infile
        ModeCompile infile cfg -> compileFile infile cfg

interpretFile :: FilePath -> IO ()
interpretFile f =
    readFile f >>= parse' f >>= typecheck' >>= monomorphize' >>= interpret'

compileFile :: FilePath -> CompileConfig -> IO ()
compileFile f cfg =
    readFile f
        >>= parse' f
        >>= typecheck'
        >>= monomorphize'
        >>= codegen' f
        >>= compile' cfg

parse' :: FilePath -> String -> IO Ast.Program
parse' f src = do
    src' <- if takeExtension f == ".org"
        then do
            putStrLn "Untangling org..."
            let s = untangleOrg src
            writeFile "out.untangled" s
            pure s
        else pure src
    putStrLn "Parsing..."
    case parse f src' of
        Left e -> putStrLn ("Parse error:\n" ++ show e) >> exitFailure
        Right p -> writeFile "out.parsed" (show p) $> p

typecheck' :: Ast.Program -> IO AnnotAst.Program
typecheck' p = do
    putStrLn "Typechecking..."
    case typecheck p of
        Left e -> putStrLn ("Typecheck error:\n" ++ e) >> exitFailure
        Right p -> writeFile "out.checked" (show p) $> p

monomorphize' :: AnnotAst.Program -> IO MonoAst.Program
monomorphize' p = do
    putStrLn "Monomorphizing..."
    let p' = monomorphize p
    writeFile "out.mono" (show p')
    pure p'

codegen' :: FilePath -> MonoAst.Program -> IO LLVM.AST.Module
codegen' f p = do
    putStrLn "Codegen..."
    let m = codegen f p
    writeFile "out.dbgll" (pretty m)
    pure m

interpret' :: MonoAst.Program -> IO ()
interpret' pgm = do
    putStrLn "Interpreting..."
    interpret pgm

compile' :: CompileConfig -> LLVM.AST.Module -> IO ()
compile' cfg mod = do
    putStrLn "Compiling..."
    compile cfg mod