diff --git a/app/MimaAsm/Main.hs b/app/MimaAsm/Main.hs index 9550948..a15f9b7 100644 --- a/app/MimaAsm/Main.hs +++ b/app/MimaAsm/Main.hs @@ -1,10 +1,11 @@ module Main where -import Options.Applicative +import Control.Monad.Trans.Class +import Options.Applicative -import Mima.Assembler.Parser -import Mima.IO -import Mima.Load +import Mima.Assembler.Parser +import Mima.IO +import Mima.Load data Settings = Settings { infile :: String @@ -28,14 +29,12 @@ opts :: ParserInfo Settings opts = info (helper <*> settingsParser) $ fullDesc <> failureCode 1 main :: IO () -main = do - settings <- execParser opts +main = doRun $ do + settings <- lift $ execParser opts - putStrLn $ "Loading assembly file at " ++ infile settings - asm <- parseFile parseState (infile settings) - case asm of - Nothing -> pure () - Just (state, _) -> do - putStrLn "Parsing successful" - putStrLn $ "Writing result to " ++ outfile settings - saveStateToFile (outfile settings) state + lift $ putStrLn $ "Loading assembly file at " ++ infile settings + (state, _) <- parseFile parseState (infile settings) + lift $ putStrLn "Parsing successful" + + lift $ putStrLn $ "Writing result to " ++ outfile settings + saveStateToFile (outfile settings) state diff --git a/app/MimaRun/Main.hs b/app/MimaRun/Main.hs index a3d7e31..c67b78d 100644 --- a/app/MimaRun/Main.hs +++ b/app/MimaRun/Main.hs @@ -1,10 +1,12 @@ module Main where import Control.Monad +import Control.Monad.Trans.Class import qualified Data.Text.IO as T import Options.Applicative import Mima.Flag +import Mima.IO import Mima.Load import Mima.State import Mima.Util @@ -12,12 +14,18 @@ import Mima.Util import PrintState data Settings = Settings - { infile :: String - , steps :: Maybe Integer - , memoryDump :: Maybe FilePath - , quiet :: Bool - , sparse :: Bool - , norun :: Bool + -- General guff + { infile :: FilePath + , outfile :: Maybe FilePath + , autodiscover :: Bool + , flagfile :: Maybe FilePath + , symbolfile :: Maybe FilePath + -- Run-specific guff + , steps :: Maybe Integer + , norun :: Bool + -- Output format guff + , quiet :: Bool + , sparse :: Bool } deriving (Show) {- Command-line parameters -} @@ -26,17 +34,35 @@ settingsParser :: Parser Settings settingsParser = Settings <$> strArgument (metavar "INFILE" - <> help "The binary memory dump to load and execute") + <> help "The memory dump to load and execute") + <*> (optional . strOption) + (long "out" + <> short 'o' + <> metavar "OUTFILE" + <> help "If specified, write the memory dump to this file after execution is finished") + <*> flag True False + (long "autodiscover" + <> short 'a' + <> help "Automatically try to find the .mima-flags and .mima-symbols files corresponding to the input files") + <*> (optional . strOption) + (long "flags" + <> short 'f' + <> metavar "FLAGFILE" + <> help "A file containing extension memory flags, specified in the .mima-flags format") + <*> (optional . strOption) + (long "symbols" + <> short 's' + <> metavar "SYMBOLFILE" + <> help "A file containing label names and addresses, specified in the .mima-symbols format") <*> (optional . option auto) (long "steps" <> short 'n' <> metavar "N" <> help "How many instructions to execute (if not specified, runs until HALT or execution exception)") - <*> (optional . strOption) - (long "dump" - <> short 'd' - <> metavar "OUTFILE" - <> help "If specified, write the MiMa's binary memory dump to this file after execution is finished") + <*> flag False True + (long "norun" + <> short 'r' + <> help "Don't run the MiMa. Use the initial state for all further actions. Roughly equivalent to -n 0") <*> flag False True (long "quiet" <> short 'q' @@ -45,10 +71,6 @@ settingsParser = Settings (long "sparse" <> short 's' <> help "Don't print memory locations containing only 0x000000 in the memory dump") - <*> flag False True - (long "norun" - <> short 'r' - <> help "Don't run the MiMa. Use the initial state for all further actions. Roughly equivalent to -n 0") opts :: ParserInfo Settings opts = info (helper <*> settingsParser) $ fullDesc <> failureCode 1 @@ -74,22 +96,19 @@ runMima settings s = -- TODO exception handling main :: IO () -main = do - settings <- execParser opts +main = doRun $ do + settings <- lift $ execParser opts - putStrLn $ "Loading memdump at " ++ infile settings + lift $ putStrLn $ "Loading memdump at " ++ infile settings ms <- loadStateFromFile (infile settings) - case ms of - Left errorMsg -> putStrLn errorMsg - Right s -> do - s' <- if norun settings then pure s else runMima settings s + ms' <- if norun settings then pure ms else lift (runMima settings ms) - unless (quiet settings) $ do - putStrLn "" - putStrLn "Dump of MiMa state:" - printStateLn (sparse settings) s' - putStrLn "" + unless (quiet settings) $ do + lift $ putStrLn "" + lift $ putStrLn "Dump of MiMa state:" + lift $ printStateLn (sparse settings) ms' + lift $ putStrLn "" - forM_ (memoryDump settings) $ \path -> do - putStrLn $ "Saving memdump at " ++ path - saveStateToFile path s' + forM_ (outfile settings) $ \path -> do + lift $ putStrLn $ "Saving memdump at " ++ path + saveStateToFile path ms' diff --git a/src/Mima/IO.hs b/src/Mima/IO.hs index 589eb8b..be06831 100644 --- a/src/Mima/IO.hs +++ b/src/Mima/IO.hs @@ -1,17 +1,32 @@ module Mima.IO - ( parseFile + ( Run + , doRun + , failWith + , parseFile ) where +import Control.Monad.Trans.Class +import Control.Monad.Trans.Except import qualified Data.Text.IO as T import Text.Megaparsec import Mima.Parser.Common -parseFile :: Parser a -> FilePath -> IO (Maybe a) +type Run a = ExceptT String IO a + +doRun :: Run () -> IO () +doRun r = do + result <- runExceptT r + case result of + Left errorMsg -> putStrLn errorMsg + Right () -> pure () + +failWith :: String -> Run a +failWith = except . Left + +parseFile :: Parser a -> FilePath -> Run a parseFile parser filepath = do - content <- T.readFile filepath + content <- lift $ T.readFile filepath case parse parser filepath content of - Right a -> pure $ Just a - Left errorBundle -> do - putStrLn $ errorBundlePretty errorBundle - pure Nothing + Right a -> pure a + Left errorBundle -> failWith $ errorBundlePretty errorBundle diff --git a/src/Mima/Load.hs b/src/Mima/Load.hs index 97516e7..992dfab 100644 --- a/src/Mima/Load.hs +++ b/src/Mima/Load.hs @@ -7,11 +7,13 @@ module Mima.Load import Control.Applicative import Control.Monad +import Control.Monad.Trans.Class import Data.Binary import qualified Data.ByteString.Lazy as BS -import Mima.Word +import Mima.IO import Mima.State +import Mima.Word -- To prevent orphan instances and keep the compiler happy newtype LD t = LD { unLD :: t } @@ -50,14 +52,14 @@ instance Binary (LD MimaState) where mem <- unLD <$> get pure $ LD $ MimaState iar acc ra sp fp mem -loadStateFromFile :: FilePath -> IO (Either String MimaState) +loadStateFromFile :: FilePath -> Run MimaState loadStateFromFile path = do - bs <- BS.readFile path - pure $ case decodeOrFail bs of - Left ( _, _, e) -> Left e + bs <- lift $ BS.readFile path + case decodeOrFail bs of + Left ( _, _, e) -> failWith e Right (bs', _, ldms) - | BS.null bs' -> Right $ unLD ldms - | otherwise -> Left "Input was not consumed fully" + | BS.null bs' -> pure $ unLD ldms + | otherwise -> failWith "Input was not consumed fully" -saveStateToFile :: FilePath -> MimaState -> IO () -saveStateToFile path = BS.writeFile path . encode . LD +saveStateToFile :: FilePath -> MimaState -> Run () +saveStateToFile path = lift . BS.writeFile path . encode . LD