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
86
87
88
89
90
91
92
|
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
{ optParse :: Bool,
optHelp :: Bool,
optVersion :: Bool
}
defOptions =
Options
{ optParse = False,
optHelp = False,
optVersion = False
}
options :: [OptDescr (Options -> Options)]
options =
[ Option
['p']
["parse"]
(NoArg (\opts -> opts {optParse = True}))
"only parse, reporting any errors",
Option
['h']
["help"]
(NoArg (\opts -> opts {optHelp = True}))
"show help",
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 -> Bool -> IO ()
compileFile filename onlyParse = 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 _ -> if onlyParse then exitSuccess else 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 $ optParse opts
_ -> usage progName []
where
opts = foldl (flip id) defOptions o
(_, _, errs) -> usage progName errs
|
