~jojo/Carth

ref: b4a02375519fd3dfe2c97e43f4cf234bac7db02c Carth/app/Main.hs -rw-r--r-- 2.1 KiB
b4a02375JoJo fix tests: Readd Pretty impls for Ast & inst Arbitrary for ConstructorDefs 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" (pretty 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