From 495809bd86a25dee84dc275162f95a5474f79fde Mon Sep 17 00:00:00 2001 From: Joscha Date: Fri, 27 Mar 2020 21:02:05 +0000 Subject: [PATCH] Clean up storage implementation Also switch to lazy byte strings in Mima.Run because they appear to be used in all libraries used. --- package.yaml | 1 + src/Mima/Run.hs | 2 +- src/Mima/Vm/State.hs | 44 ++++++++++++++++++++++++ src/Mima/Vm/Storage.hs | 76 +++++++++++------------------------------- 4 files changed, 65 insertions(+), 58 deletions(-) diff --git a/package.yaml b/package.yaml index 4cccaa7..1b9e9a7 100644 --- a/package.yaml +++ b/package.yaml @@ -16,6 +16,7 @@ dependencies: - OddWord >= 1.0 && < 1.1 - aeson - aeson-pretty + - binary - bytestring - containers - text diff --git a/src/Mima/Run.hs b/src/Mima/Run.hs index 66ba107..ba1cfb4 100644 --- a/src/Mima/Run.hs +++ b/src/Mima/Run.hs @@ -17,7 +17,7 @@ module Mima.Run import Control.Monad.IO.Class import Control.Monad.Trans.Except -import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as BS import qualified Data.Text as T import qualified Data.Text.IO as T import System.IO.Error diff --git a/src/Mima/Vm/State.hs b/src/Mima/Vm/State.hs index 847742c..da717ae 100644 --- a/src/Mima/Vm/State.hs +++ b/src/Mima/Vm/State.hs @@ -10,7 +10,10 @@ module Mima.Vm.State , runN ) where +import Control.Applicative +import Data.Binary import Data.Bits +import Data.Foldable import qualified Data.Text as T import Mima.Format @@ -27,6 +30,47 @@ data MimaState = MimaState , msMemory :: !MimaMemory } deriving (Show) +putWord :: MimaWord -> Put +putWord w = putList [b1, b2, b3] + where + (b1, b2, b3) = wordToBytes w + +putAddress :: MimaAddress -> Put +putAddress = putWord . largeValueToWord + +putMemory :: MimaMemory -> Put +putMemory = traverse_ putWord . memoryToWords + +getWord :: Get MimaWord +getWord = do + b1 <- get + b2 <- get + b3 <- get + pure $ bytesToWord (b1, b2, b3) + +getAddress :: Get MimaAddress +getAddress = getLargeValue <$> getWord + +getMemory :: Get MimaMemory +getMemory = wordsToMemory <$> many getWord + +instance Binary MimaState where + put ms = do + putAddress $ msIar ms + putWord $ msAcc ms + putAddress $ msRa ms + putAddress $ msSp ms + putAddress $ msFp ms + putMemory $ msMemory ms + + get = MimaState + <$> getAddress + <*> getWord + <*> getAddress + <*> getAddress + <*> getAddress + <*> getMemory + basicState :: MimaMemory -> MimaState basicState = MimaState zeroBits zeroBits zeroBits zeroBits zeroBits diff --git a/src/Mima/Vm/Storage.hs b/src/Mima/Vm/Storage.hs index ccb558d..b4fda91 100644 --- a/src/Mima/Vm/Storage.hs +++ b/src/Mima/Vm/Storage.hs @@ -1,78 +1,40 @@ -{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE OverloadedStrings #-} module Mima.Vm.Storage - ( - -- * Methods for loading/storing 'Metadata' - loadMetadata + ( loadMetadata , saveMetadata + , loadMimaState , saveMimaState - -- * Test methods - , roundTripFile - , saveInterestingState ) where -import Data.Aeson -import Data.Aeson.Encode.Pretty -import qualified Data.ByteString.Lazy as BSL -import qualified Data.Map.Strict as Map +import qualified Data.Aeson as A +import qualified Data.Aeson.Encode.Pretty as A +import qualified Data.Binary as B import qualified Data.Text as T + import Mima.Run -import Mima.Vm.Memory import Mima.Vm.Metadata import Mima.Vm.State -import Mima.Vm.Word -- | Loads 'Metadata' from a given file path. loadMetadata :: FilePath -> Run Metadata loadMetadata path = do file <- readFileBS path - case eitherDecode $ BSL.fromStrict file of - Left msg -> throw (T.pack msg) + case A.eitherDecode file of + Left msg -> throw $ T.pack msg Right metadata -> pure metadata -- | Stores prettified 'Metadata' in a given file. saveMetadata :: FilePath -> Metadata -> Run () -saveMetadata path metadata = writeFileBS path (BSL.toStrict (encodePretty metadata)) +saveMetadata path = writeFileBS path . A.encodePretty + +loadMimaState :: FilePath -> Run MimaState +loadMimaState path = do + bs <- readFileBS path + case B.decodeOrFail bs of + Right ("", 0, a) -> pure a + Right _ -> throw "invalid file format" + Left (_, _, e) -> throw $ T.pack e saveMimaState :: FilePath -> MimaState -> Run () -saveMimaState path state = do - let stateBS = saveMimaSateBS state - writeFileBS path (BSL.toStrict stateBS) - -saveMimaSateBS :: MimaState -> BSL.ByteString -saveMimaSateBS state = mimaRegistersToBS state <> mimaMemoryToBS (msMemory state) - -mimaRegistersToBS :: MimaState -> BSL.ByteString -mimaRegistersToBS MimaState{..} - = mimaWordToBS (largeValueToWord msIar) - <> mimaWordToBS msAcc - <> mimaWordToBS (largeValueToWord msRa) - <> mimaWordToBS (largeValueToWord msSp) - <> mimaWordToBS (largeValueToWord msFp) - -mimaMemoryToBS :: MimaMemory -> BSL.ByteString -mimaMemoryToBS memory = foldl appendWord mempty (memoryToWords memory) - where - appendWord string word = string <> mimaWordToBS word - -mimaWordToBS :: MimaWord -> BSL.ByteString -mimaWordToBS = BSL.pack . tripleToList . wordToBytes - where - tripleToList (a, b, c) = [a, b, c] - --- | A garbage test method that resds the input file, parses it and writes the --- prettified result back in the output file. --- --- Can be used with the example file: --- --- > roundTripFile "test/files/SimpleMetadataFile.json" "/tmp/test.json" -roundTripFile :: FilePath -- ^ The input file - -> FilePath -- ^ The output file - -> Run () -roundTripFile input output = loadMetadata input >>= saveMetadata output - -saveInterestingState :: FilePath -> Run () -saveInterestingState path = saveMimaState path withRegisters - where - state = basicState $ mapToMemory $ Map.fromList $ zip [1..100] [1..100] - withRegisters = state{msIar = 5, msAcc = -2, msRa = 46565, msSp = 20} +saveMimaState path = writeFileBS path . B.encode