~jojo/Carth

ref: 2d64043ef7cdff3d025dfe01dfc69e9c69236b68 Carth/app/Main.hs -rw-r--r-- 1.7 KiB
2d64043eJoJo Verify LLVM module before compiling to catch errors 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
{-# LANGUAGE LambdaCase #-}

module Main (main) where

import Data.Functor
import System.Exit
import System.FilePath

import Misc
import Literate
import qualified TypeErr
import qualified Ast
import qualified DesugaredAst
import qualified MonoAst
import Check
import Config
import Compile
import Mono
import qualified Parse
import Parse (Source)

main :: IO ()
main = uncurry compileFile =<< getConfig

compileFile :: FilePath -> CompileConfig -> IO ()
compileFile f cfg = do
    putStrLn ("   Compiling " ++ f ++ "\n")
    src <- readFile f
    parse' f src >>= typecheck' f src >>= monomorphize' >>= compile f 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
    case Parse.parse f src' of
        Left e -> putStrLn (formatParseErr e) >> abort f
        Right p -> writeFile "out.parsed" (pretty p) $> p
  where
    formatParseErr e =
        let ss = lines e in (unlines ((head ss ++ " Error:") : tail ss))

typecheck' :: FilePath -> Source -> Ast.Program -> IO DesugaredAst.Program
typecheck' f src p = case typecheck p of
    Left e -> putStrLn (TypeErr.prettyErr e src) >> abort f
    Right p -> writeFile "out.checked" (show p) $> p

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

abort :: FilePath -> IO a
abort f = do
    putStrLn "Error: Aborting due to previous error."
    putStrLn $ "Error: Could not compile " ++ f ++ "."
    exitFailure