content: {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
  module Utility.MapMemory where
  import Spec.Memory
  import Utility.Utility
  import Data.Maybe
  import Data.Word
  import Data.Bits
  import qualified Data.Map.Strict as S
  import Prelude
  import Data.List as L
  readM :: (S.Map Int Word8) -> Int -> Word8
  readM mem addr = fromMaybe 0 (S.lookup addr mem)
  
  writeM :: (S.Map Int Word8) -> Int -> Word8 -> (S.Map Int Word8)
  writeM mem addr 0 = S.delete addr mem
  writeM mem addr val = S.insert addr val mem
  
  helpLoad :: (Bits b, Integral b) => (S.Map Int Word8) -> Int -> Int -> b
  helpLoad mem addr numBytes =
    combineBytes $ fmap (\a -> readM mem a) [addr..(addr + numBytes - 1)]
  
  helpStore :: (S.Map Int Word8) -> Int -> [Word8] -> (S.Map Int Word8)
  helpStore mem addr bytes =
    L.foldr (\(b,a) m -> writeM m a b) mem $ L.zip bytes [addr + i | i <- [0..]]
  
  data MapMemory a = MapMemory { bytes :: S.Map a Word8, reservation :: Maybe a }
    deriving (Eq, Show)
  
  instance Memory (MapMemory Int) Int where
    loadByte mem addr = readM (bytes mem) addr
    loadHalf mem addr = helpLoad (bytes mem) addr 2
    loadWord mem addr = helpLoad (bytes mem) addr 4
    loadDouble mem addr = helpLoad (bytes mem) addr 8
    storeByte mem addr val = mem { bytes = writeM (bytes mem) addr val }
    storeHalf mem addr val = mem { bytes = helpStore (bytes mem) addr (splitHalf val) }
    storeWord mem addr val = mem { bytes = helpStore (bytes mem) addr (splitWord val) }
    storeDouble mem addr val = mem { bytes = helpStore (bytes mem) addr (splitDouble val) }
    makeReservation mem addr = mem { reservation = Just addr }
    checkReservation mem addr = (reservation mem) == Just addr
    clearReservation mem addr = mem { reservation = Nothing }
  