From 72e21d6ff2b2e6d4f954864a09eb702c9c5eeb6c Mon Sep 17 00:00:00 2001 From: Joscha Date: Mon, 25 Nov 2019 09:57:39 +0000 Subject: [PATCH] Properly load flag and symbol files --- app/MimaAsm/Main.hs | 2 +- app/MimaRun/Main.hs | 80 +++++++++++++++++++++--------------- src/Mima/IO.hs | 39 +++++++++++++++--- src/Mima/Parse/SymbolFile.hs | 9 ++-- 4 files changed, 85 insertions(+), 45 deletions(-) diff --git a/app/MimaAsm/Main.hs b/app/MimaAsm/Main.hs index 3f5e81d..dab0bc1 100644 --- a/app/MimaAsm/Main.hs +++ b/app/MimaAsm/Main.hs @@ -33,7 +33,7 @@ main = doRun_ $ do settings <- lift $ execParser opts lift $ putStrLn $ "Loading assembly file at " ++ infile settings - (state, _, _) <- loadFile readAssembly (infile settings) + (state, _, _) <- loadFile' readAssembly (infile settings) lift $ putStrLn "Parsing successful" lift $ putStrLn $ "Writing result to " ++ outfile settings diff --git a/app/MimaRun/Main.hs b/app/MimaRun/Main.hs index 432359b..4908736 100644 --- a/app/MimaRun/Main.hs +++ b/app/MimaRun/Main.hs @@ -1,8 +1,11 @@ +{-# LANGUAGE OverloadedStrings #-} + module Main where import Control.Monad import Control.Monad.Trans.Class -import Control.Monad.Trans.Except +import Data.Maybe +import qualified Data.Text as T import qualified Data.Text.IO as T import Options.Applicative import System.FilePath @@ -14,6 +17,7 @@ import Mima.Label import Mima.Load import Mima.Options import Mima.Parse.FlagFile +import Mima.Parse.SymbolFile import Mima.State import Mima.Util import Mima.Word @@ -33,6 +37,26 @@ data Settings = Settings , formatConf :: FormatConfig } deriving (Show) +getFlagFile :: Settings -> File +getFlagFile settings = + case flagFile settings of + Just path -> RequiredFile path + Nothing -> case discover settings of + False -> NoFile + True -> OptionalFile discoveredPath + where + discoveredPath = dropExtension (infile settings) ++ ".mima-flags" + +getSymbolFile :: Settings -> File +getSymbolFile settings = + case symbolFile settings of + Just path -> RequiredFile path + Nothing -> case discover settings of + False -> NoFile + True -> OptionalFile discoveredPath + where + discoveredPath = dropExtension (infile settings) ++ ".mima-symbols" + {- Command-line parameters -} settingsParser :: Parser Settings @@ -74,40 +98,30 @@ settingsParser = Settings opts :: ParserInfo Settings opts = info (helper <*> settingsParser) $ fullDesc <> failureCode 1 <> footer flagFooter -{- Loading the flag file -} +{- Loading supplemental files -} --- If explicit file name: --- Try to load file --- Fail if loading fails --- Elif discover: --- Try to load file --- Use defaults if loading fails --- Else: --- Use defaults - -loadFlagFile :: FilePath -> Run (Flags (MimaAddress -> Bool)) -loadFlagFile filename = do - lift $ putStrLn $ "Loading flags from " ++ filename - (interpretFlagSpec . getFlagSpec) <$> loadFile readFlagFile filename - -withDefaultFlags :: Run (Flags (MimaAddress -> Bool)) -> Run (Flags (MimaAddress -> Bool)) -withDefaultFlags p = do - result <- tryRun p - case result of - Just flags -> pure flags - Nothing -> do - lift $ putStrLn "Using default flags" - pure noFlags +printFile :: T.Text -> File -> Run () +printFile name NoFile = + lift $ T.putStrLn $ "Not loading " <> name <> ": No file specified and discovery turned off" +printFile name (OptionalFile path) = + lift $ T.putStrLn $ "Attempting to load " <> name <> " from " <> T.pack path +printFile name (RequiredFile path) = + lift $ T.putStrLn $ "Loading " <> name <> " from " <> T.pack path loadFlags :: Settings -> Run (Flags (MimaAddress -> Bool)) -loadFlags settings = - case flagFile settings of - Just filename -> loadFlagFile filename - Nothing -> withDefaultFlags $ if discover settings - then loadFlagFile discovered - else throwE "File not specified and discovery turned off" - where - discovered = dropExtension (infile settings) ++ ".mima-flags" +loadFlags settings = do + let file = getFlagFile settings + printFile "flags" file + mRawFlags <- loadFile readFlagFile file + pure $ case mRawFlags of + Nothing -> noFlags + Just flagSpec -> interpretFlagSpec $ getFlagSpec flagSpec + +loadSymbols :: Settings -> Run LabelSpec +loadSymbols settings = do + let file = getSymbolFile settings + printFile "symbols" file + fromMaybe noLabels <$> loadFile readSymbolFile file {- Other functions -} @@ -150,7 +164,7 @@ main = doRun_ $ do ms <- loadStateFromFile (infile settings) flags <- loadFlags settings - labels <- pure noLabels -- loadSymbolFile settings + labels <- loadSymbols settings ms' <- if norun settings then pure ms diff --git a/src/Mima/IO.hs b/src/Mima/IO.hs index 57007d1..5e599f7 100644 --- a/src/Mima/IO.hs +++ b/src/Mima/IO.hs @@ -1,12 +1,15 @@ {-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE TupleSections #-} module Mima.IO ( Run , doRun , doRun_ , tryRun + , File(..) , readTextFile , loadFile + , loadFile' ) where import Control.Monad.Trans.Class @@ -39,6 +42,12 @@ tryRun r = do lift $ putStrLn e pure Nothing +data File + = NoFile + | OptionalFile FilePath + | RequiredFile FilePath + deriving (Show) + readTextFile :: FilePath -> Run T.Text readTextFile filepath = do eitherContent <- lift $ catchIOError (Right <$> T.readFile filepath) handleError @@ -49,9 +58,27 @@ readTextFile filepath = do then pure $ Left $ "Can't load file " ++ filepath ++ ": " ++ ioeGetErrorString e else ioError e -- This error does not concern us -loadFile :: (FilePath -> T.Text -> Either WeedErrorBundle a) -> FilePath -> Run a -loadFile f filepath = do - content <- readTextFile filepath - case f filepath content of - Left errorBundle -> throwE $ errorBundlePretty errorBundle - Right a -> pure a +loadTextFile :: File -> Run (Maybe (FilePath, T.Text)) +loadTextFile NoFile = pure Nothing +loadTextFile (OptionalFile path) = do + mContent <- tryRun $ readTextFile path + pure $ (path,) <$> mContent +loadTextFile (RequiredFile path) = do + content <- readTextFile path + pure $ Just (path, content) + +loadFile :: (FilePath -> T.Text -> Either WeedErrorBundle a) -> File -> Run (Maybe a) +loadFile f file = do + mContent <- loadTextFile file + case mContent of + Nothing -> pure Nothing + Just (path, content) -> case f path content of + Left errorBundle -> throwE $ errorBundlePretty errorBundle + Right result -> pure $ Just result + +loadFile' :: (FilePath -> T.Text -> Either WeedErrorBundle a) -> FilePath -> Run a +loadFile' f path = do + content <- readTextFile path + case f path content of + Left errorBundle -> throwE $ errorBundlePretty errorBundle + Right result -> pure result diff --git a/src/Mima/Parse/SymbolFile.hs b/src/Mima/Parse/SymbolFile.hs index 630f0d2..e167a38 100644 --- a/src/Mima/Parse/SymbolFile.hs +++ b/src/Mima/Parse/SymbolFile.hs @@ -47,13 +47,12 @@ parseSymbolFile = space *> many lNewline *> (combineLines <$> many lLine) <* eof {- Weeding -} -wBuildMap :: [(WithOffset LabelName, MimaAddress)] - -> Weed WeedError (Map.Map LabelName MimaAddress) +wBuildMap :: [(WithOffset LabelName, MimaAddress)] -> Weed WeedError LabelSpec wBuildMap = foldM helper Map.empty where helper :: Map.Map LabelName MimaAddress -> (WithOffset LabelName, MimaAddress) - -> Weed WeedError (Map.Map LabelName MimaAddress) + -> Weed WeedError LabelSpec helper m (l, addr) | name `Map.member` m = do harmless $ errorAt l "label was specified more than once" @@ -62,12 +61,12 @@ wBuildMap = foldM helper Map.empty where name = woValue l weedSymbolFile :: Map.Map MimaAddress [WithOffset LabelName] - -> Weed WeedError (Map.Map LabelName MimaAddress) + -> Weed WeedError LabelSpec weedSymbolFile m = let pairs = [(l, a) | (a, ls) <- Map.assocs m, l <- ls] in wBuildMap pairs -readSymbolFile :: FilePath -> T.Text -> Either WeedErrorBundle (Map.Map LabelName MimaAddress) +readSymbolFile :: FilePath -> T.Text -> Either WeedErrorBundle LabelSpec readSymbolFile filename input = do unweeded <- parse parseSymbolFile filename input runWeedBundle filename input $ weedSymbolFile unweeded