66 lines
1.8 KiB
Haskell
66 lines
1.8 KiB
Haskell
{-# LANGUAGE FlexibleInstances #-}
|
|
|
|
module Mima.Load
|
|
( loadStateFromFile
|
|
, saveStateToFile
|
|
) where
|
|
|
|
import Control.Applicative
|
|
import Control.Monad
|
|
import Control.Monad.Trans.Class
|
|
import Control.Monad.Trans.Except
|
|
import Data.Binary
|
|
import qualified Data.ByteString.Lazy as BS
|
|
|
|
import Mima.IO
|
|
import Mima.State
|
|
import Mima.Word
|
|
|
|
-- To prevent orphan instances and keep the compiler happy
|
|
newtype LD t = LD { unLD :: t }
|
|
|
|
instance Binary (LD MimaWord) where
|
|
put mw = do
|
|
let (w1, w2, w3) = wordToBytes $ unLD mw
|
|
forM_ [w1, w2, w3] put
|
|
get = do
|
|
bytes <- (,,) <$> get <*> get <*> get
|
|
pure $ LD $ bytesToWord bytes
|
|
|
|
instance Binary (LD LargeValue) where
|
|
put = put . LD . largeValueToWord . unLD
|
|
get = LD . getLargeValue . unLD <$> get
|
|
|
|
instance Binary (LD MimaMemory) where
|
|
put = mapM_ (put . LD) . memoryToWords . unLD
|
|
get = LD . wordsToMemory . map unLD <$> many get
|
|
|
|
instance Binary (LD MimaState) where
|
|
put ldms = do
|
|
let ms = unLD ldms
|
|
put $ LD $ msIAR ms
|
|
put $ LD $ msACC ms
|
|
put $ LD $ msRA ms
|
|
put $ LD $ msSP ms
|
|
put $ LD $ msFP ms
|
|
put $ LD $ msMemory ms
|
|
get = do
|
|
iar <- unLD <$> get
|
|
acc <- unLD <$> get
|
|
ra <- unLD <$> get
|
|
sp <- unLD <$> get
|
|
fp <- unLD <$> get
|
|
mem <- unLD <$> get
|
|
pure $ LD $ MimaState iar acc ra sp fp mem
|
|
|
|
loadStateFromFile :: FilePath -> Run MimaState
|
|
loadStateFromFile path = do
|
|
bs <- lift $ BS.readFile path
|
|
case decodeOrFail bs of
|
|
Left ( _, _, e) -> throwE e
|
|
Right (bs', _, ldms)
|
|
| BS.null bs' -> pure $ unLD ldms
|
|
| otherwise -> throwE "Input was not consumed fully"
|
|
|
|
saveStateToFile :: FilePath -> MimaState -> Run ()
|
|
saveStateToFile path = lift . BS.writeFile path . encode . LD
|