Improve formatting of various elements

Couldn't think of a better commit message

src/Mima/Instruction.hs

@@ -63,7 +63,7 @@ data Instruction
   deriving (Show, Eq)
 
 instance ToText Instruction where
-  toText (SmallInstruction oc addr) = toText oc <> " " <> toText addr
+  toText (SmallInstruction oc addr) = toText oc <> " 0x" <> addrToHex addr
   toText (LargeInstruction oc)      = toText oc
 
 

src/Mima/State.hs

@@ -1,7 +1,10 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 module Mima.State
   ( MimaMemory
   , wordsToMemory
   , memoryToWords
+  , memoryToText
   , readAt
   , writeAt
   , MimaState(..)
@@ -18,18 +21,35 @@ import           Data.Maybe
 import qualified Data.Text as T
 
 import           Mima.Instruction
+import           Mima.Util
 import           Mima.Word
 
 newtype MimaMemory = MimaMemory (Map.Map MimaAddress MimaWord)
   deriving (Show)
 
+addressRange :: MimaMemory -> [MimaAddress]
+addressRange (MimaMemory m) =
+  let maxAddr = fromMaybe minBound $ fst <$> Map.lookupMax m
+  in  [minBound..maxAddr]
+
 wordsToMemory :: [MimaWord] -> MimaMemory
 wordsToMemory = MimaMemory . Map.fromAscList . zip [minBound..]
 
 memoryToWords :: MimaMemory -> [MimaWord]
-memoryToWords mem@(MimaMemory m) =
+memoryToWords mem = map (\addr -> readAt addr mem) $ addressRange mem
-  let maxAddr = fromMaybe minBound $ fst <$> Map.lookupMax m
+
-  in  map (\addr -> readAt addr mem) [minBound..maxAddr]
+addressWordToText :: MimaAddress -> MimaWord -> T.Text
+addressWordToText addr word =
+  addrToHex addr <> " (" <> addrToDec addr <> ") - " <> wordToHex word <> " (" <> wordToDec word <> ")"
+
+memoryToText :: Bool -> MimaMemory -> T.Text
+memoryToText sparse mem@(MimaMemory m)
+  = T.intercalate "\n"
+  $ map (\addr -> addressWordToText addr (readAt addr mem))
+  $ addresses sparse
+  where
+    addresses False = addressRange mem
+    addresses True  = Map.keys m
 
 readAt :: MimaAddress -> MimaMemory -> MimaWord
 readAt addr (MimaMemory m) = Map.findWithDefault zeroBits addr m
@@ -55,9 +75,18 @@ initialState mem = MimaState
 data AbortReason = Halted | InvalidInstruction T.Text | InvalidNextIpAddress
   deriving (Show)
 
+instance ToText AbortReason where
+  toText Halted = "Halted"
+  toText (InvalidInstruction t) = "Invalid instruction: " <> t
+  toText InvalidNextIpAddress = "Invalid next IP address"
+
 data ExecException = ExecException MimaAddress MimaWord AbortReason
   deriving (Show)
 
+instance ToText ExecException where
+  toText (ExecException addr word reason) =
+    "Exception at " <> addrToHexDec addr <> " with word " <> wordToHexDec word <> ": " <> toText reason
+
 incrementIp :: MimaState -> Either ExecException MimaState
 incrementIp ms =
   let addr = msIp ms
@@ -81,7 +110,7 @@ step ms = do
     (LargeInstruction oc)           -> executeLargeOpcode oc ms
 
 executeSmallOpcode :: SmallOpcode -> MimaAddress -> MimaState -> Either ExecException MimaState
-executeSmallOpcode LDC  addr ms = incrementIp ms{msAcc = addressToWord addr}
+executeSmallOpcode LDC  addr ms = incrementIp ms{msAcc = addrToWord addr}
 executeSmallOpcode LDV  addr ms = incrementIp ms{msAcc = readAt addr (msMemory ms)}
 executeSmallOpcode STV  addr ms = incrementIp ms{msMemory = writeAt addr (msAcc ms) (msMemory ms)}
 executeSmallOpcode ADD  addr ms = incrementIp ms{msAcc = addWords (msAcc ms) (readAt addr $ msMemory ms)}

src/Mima/Util.hs

@@ -1,5 +1,6 @@
 module Mima.Util
   ( ToText(..)
+  , toDec
   , toHex
   ) where
 
@@ -19,5 +20,8 @@ import qualified Numeric as N
 class ToText a where
   toText :: a -> T.Text
 
+toDec :: (Integral a, Show a) => Int -> a -> T.Text
+toDec digits a = T.justifyRight digits ' ' $ T.pack $ show a
+
 toHex :: (Integral a, Show a) => Int -> a -> T.Text
 toHex digits a = T.justifyRight digits '0' $ T.pack $ N.showHex a ""

src/Mima/Word.hs

@@ -1,17 +1,33 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 module Mima.Word
-  ( MimaWord
+  (
+  -- * MiMa-Word
+    MimaWord
+  -- ** Formatting
+  , wordToDec
+  , wordToHex
+  , wordToHexDec
+  -- ** Converting
   , bytesToWord
   , wordToBytes
   , boolToWord
+  -- ** Querying
+  , wordSize
   , topBit
   , upperOpcode
   , lowerOpcode
   , address
+  -- ** Adding
   , addWords
+  -- * MiMa-Addresses
   , MimaAddress
-  , addressToWord
+  -- ** Formatting
+  , addrToDec
+  , addrToHex
+  , addrToHexDec
+  -- ** Converting
+  , addrToWord
   ) where
 
 import           Data.Bits
@@ -35,11 +51,17 @@ newtype MimaWord = MimaWord Word32
 wordSize :: Int
 wordSize = 24
 
-instance ToText MimaWord where
+wordToDec :: MimaWord -> T.Text
-  toText (MimaWord w) = toHex 6 w
+wordToDec (MimaWord w) = toDec 8 w
+
+wordToHex :: MimaWord -> T.Text
+wordToHex (MimaWord w) = toHex 6 w
+
+wordToHexDec :: MimaWord -> T.Text
+wordToHexDec mw = wordToHex mw <> " (" <> wordToDec mw <> ")"
 
 instance Show MimaWord where
-  show mw = T.unpack $ "MimaWord 0x" <> toText mw
+  show mw = T.unpack $ "MimaWord 0x" <> wordToHex mw
 
 instance Word32Based MimaWord where
   fromWord32 w = MimaWord $ w .&. 0x00FFFFFF
@@ -115,11 +137,17 @@ addWords mw1 mw2 = fromWord32 $ toWord32 mw1 + toWord32 mw2
 newtype MimaAddress = MimaAddress Word32
   deriving (Eq, Ord)
 
-instance ToText MimaAddress where
+addrToDec :: MimaAddress -> T.Text
-  toText (MimaAddress w) = toHex 5 w
+addrToDec (MimaAddress a) = toDec 7 a
+
+addrToHex :: MimaAddress -> T.Text
+addrToHex (MimaAddress a) = toHex 5 a
+
+addrToHexDec :: MimaAddress -> T.Text
+addrToHexDec ma = addrToHex ma <> " (" <> addrToDec ma <> ")"
 
 instance Show MimaAddress where
-  show ma = T.unpack $ "MimaAddress 0x" <> toText ma
+  show ma = T.unpack $ "MimaAddress 0x" <> addrToHex ma
 
 instance Word32Based MimaAddress where
   fromWord32 w = MimaAddress $ w .&. 0x000FFFFF
@@ -140,5 +168,5 @@ instance Enum MimaAddress where
                      ++ ") is out of bounds " ++ show (lower, upper)
   fromEnum = fromEnum . toWord32
 
-addressToWord :: MimaAddress -> MimaWord
+addrToWord :: MimaAddress -> MimaWord
-addressToWord = fromWord32 . toWord32
+addrToWord = fromWord32 . toWord32