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
|
module Main where
import Compiler
import Control.Monad (when)
import Control.Monad.State (evalState)
import qualified Data.Map as Map
import Data.Maybe (fromMaybe)
import Error (showErrorList, showParserError)
import Lexer (scan)
import Parser (parse, parseFromFile)
import System.Console.GetOpt
import System.Environment (getProgName)
import System.Environment.Blank (getArgs)
import System.Exit (exitFailure, exitSuccess)
import System.IO (hPutStr, hPutStrLn, stderr, stdout)
version = "0.1.0"
data Options = Options
{ optHelp :: Bool,
optVersion :: Bool
}
defOptions =
Options
{ optHelp = False,
optVersion = False
}
options :: [OptDescr (Options -> Options)]
options =
[ Option
['h']
["help"]
(NoArg (\opts -> opts {optHelp = True}))
"show help and exit",
Option
['v']
["version"]
(NoArg (\opts -> opts {optVersion = True}))
"output version and exit"
]
usage :: String -> [String] -> IO ()
usage progName errs
| null errs = do
putStrLn helpText
exitSuccess
| otherwise = do
hPutStrLn stderr ("error: " ++ concat errs ++ "Try " ++ progName ++ " -h for more information.")
exitFailure
where
header =
"Usage: "
++ progName
++ " [OPTION...] file"
helpText =
usageInfo header options
compileFile :: String -> IO ()
compileFile filename = do
res <- parseFromFile (scan parse) filename
case res of
Left err -> hPutStrLn stderr (showParserError err) >> exitFailure
Right ast -> do
res <- return $ evalState (compileAll ast) startState
case res of
Right _ -> print ast
Left errs -> hPutStr stderr (showErrorList errs) >> exitFailure
main :: IO ()
main = do
progName <- getProgName
argv <- getArgs
case getOpt Permute options argv of
(o, n, []) ->
do
when (optHelp opts) $ usage progName []
when (optVersion opts) $ putStrLn (progName ++ " " ++ version) >> exitSuccess
case n of
[filename] -> compileFile filename
_ -> usage progName []
where
opts = foldl (flip id) defOptions o
(_, _, errs) -> usage progName errs
|
