diff options
| -rw-r--r-- | Main.hs | 31 |
1 files changed, 24 insertions, 7 deletions
@@ -1,6 +1,6 @@ -{-# LANGUAGE LambdaCase, TupleSections #-} module Main where +import Control.Monad import System.Environment import System.Exit @@ -14,18 +14,35 @@ import VM usage :: IO () usage = do progname <- getProgName - putStrLn $ "Usage: " ++ progname ++ " [filename.lisp]" + 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 - (mfname, source) <- getArgs >>= \case - [] -> (Nothing,) <$> getContents - [arg] -> (Just arg,) <$> readFile arg - _ -> usage >> exitFailure + (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 - -- print opt + when (optIR opts) $ print opt vmRun opt |