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
|
module Main where
import Control.Monad
import System.Environment
import System.Exit
import Compiler
import CompilerMacros
import Optimiser
import Parser
import VM
usage :: IO ()
usage = do
progname <- getProgName
putStrLn $ "Usage: " ++ progname ++ " [-h] [-ast] [-ir] [filename.lisp]"
putStrLn $ "When no filename is given, will read from stdin."
putStrLn $ " -h Show this help"
putStrLn $ " -ast Print AST after compiler macro's"
putStrLn $ " -ir Print IR after optimisation"
data Options = Options { optAST :: Bool, optIR :: Bool }
parseOptions' :: (Options, Maybe FilePath) -> [String] -> IO (Options, Maybe FilePath)
parseOptions' pair [] = return pair
parseOptions' _ ("-h":_) = usage >> exitSuccess
parseOptions' (opt, fp) ("-ast":as) = parseOptions' (opt { optAST = True }, fp) as
parseOptions' (opt, fp) ("-ir":as) = parseOptions' (opt { optIR = True }, fp) as
parseOptions' _ (('-':a):_) = putStrLn ("Unknown option '" ++ a ++ "'") >> usage >> exitFailure
parseOptions' (opt, Nothing) (f:as) = parseOptions' (opt, Just f) as
parseOptions' (_, Just _) (_:_) = putStrLn "At most one filename argument expected" >> usage >> exitFailure
parseOptions :: [String] -> IO (Options, Maybe FilePath)
parseOptions = parseOptions' (Options False False, Nothing)
main :: IO ()
main = do
(opts, mfname) <- getArgs >>= parseOptions
source <- maybe getContents readFile mfname
prog <- parseProgram mfname source >>= either (die . show) return
let prog' = compilerMacros prog
when (optAST opts) $ print prog'
irprog <- either die return (compileProgram prog')
let opt = optimise irprog
when (optIR opts) $ print opt
vmRun opt
|
