summaryrefslogtreecommitdiff
path: root/src/Main.hs
blob: aff5360ea9db6e8a7fdaeead292ced18f05da275 (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
{- This Source Code Form is subject to the terms of the Mozilla Public License,
   v. 2.0. If a copy of the MPL was not distributed with this file, You can
   obtain one at https://mozilla.org/MPL/2.0/. -}

module Main
    ( main
    ) where

import Language.Elna.CommandLine (CommandLine(..), commandLine, execParser)
import Language.Elna.Object.ElfCoder (elfObject)
import Language.Elna.Backend.Allocator (allocate)
import Language.Elna.Glue (glue)
import Language.Elna.Frontend.NameAnalysis (nameAnalysis)
import Language.Elna.Frontend.Parser (programP)
import Language.Elna.Frontend.TypeAnalysis (typeAnalysis)
import Language.Elna.RiscV.CodeGenerator (generateRiscV, riscVConfiguration)
import Language.Elna.RiscV.ElfWriter (riscv32Elf)
import Data.Maybe (fromMaybe)
import System.FilePath (replaceExtension, takeFileName)
import Text.Megaparsec (runParser, errorBundlePretty)
import qualified Data.Text.IO as Text
import System.Exit (ExitCode(..), exitWith)
import Control.Exception (IOException, catch)

-- * Error codes
--
-- 1 - Command line parsing failed and other errors.
-- 2 - The input could not be read.
-- 3 - Parse error.
-- 4 - Name analysis error.
-- 5 - Type error.
-- 6 - Register allocation error.

main :: IO ()
main = execParser commandLine >>= withCommandLine
  where
    withCommandLine CommandLine{..} =
        let defaultOutputName = replaceExtension (takeFileName input) "o"
            outputName = fromMaybe defaultOutputName output
         in catch (Text.readFile input) (printAndExit 2 :: IOException -> IO a)
            >>= withParsedInput outputName
            . runParser programP input
    withParsedInput output (Right program)
        = either (printAndExit 4) (withSymbolTable output program)
        $ nameAnalysis program
    withParsedInput _ (Left errorBundle)
        = putStrLn (errorBundlePretty errorBundle)
        >> exitWith (ExitFailure 3)
    withSymbolTable output program symbolTable
        | Just typeError <- typeAnalysis symbolTable program =
            printAndExit 5 typeError
        | otherwise =
            let makeObject = elfObject output . riscv32Elf . generateRiscV
             in either (printAndExit 6) makeObject
                $ allocate riscVConfiguration symbolTable
                $ glue symbolTable program
    printAndExit :: Show b => forall a. Int -> b -> IO a
    printAndExit failureCode e = print e >> exitWith (ExitFailure failureCode)