Output instructions and labels in memory dump

src/Mima/Format/Common.hs

@@ -4,6 +4,7 @@ module Mima.Format.Common
   ( toBin
   , toDec
   , toHex
+  , negative
   , chunkedBy
   , chunkyBin
   , chunkyDec
@@ -32,6 +33,14 @@ toDec = T.pack . show
 toHex :: (Integral a, Show a) => a -> T.Text
 toHex a = T.pack $ showHex a ""
 
+-- | @'negative' a@ interprets @a@ as @a - 'maxBound'@ if @a@ is greater than
+-- @'maxBound' `div` 2@, and as a positive number otherwise. 'minBound' is
+-- ignored.
+negative :: (Integral a, Bounded a, Show a) => (a -> T.Text) -> a -> T.Text
+negative f a
+  | a > maxBound `div` 2 = "-" <> f (-(a - maxBound))
+  | otherwise            = f a
+
 chunkedBy :: T.Text -> Int -> T.Text -> T.Text
 chunkedBy sep n = T.reverse . T.intercalate sep . T.chunksOf n . T.reverse
 

src/Mima/Format/Instruction.hs

@@ -0,0 +1,31 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Mima.Format.Instruction
+  ( formatLargeValue
+  , formatSmallValue
+  , formatSmallOpcode
+  , formatLargeOpcode
+  , formatInstruction
+  ) where
+
+import qualified Data.Text as T
+
+import           Mima.Format.Common
+import           Mima.Instruction
+import           Mima.Word
+
+formatLargeValue :: LargeValue -> T.Text
+formatLargeValue = negative toDec
+
+formatSmallValue :: SmallValue -> T.Text
+formatSmallValue = negative toDec
+
+formatSmallOpcode :: SmallOpcode -> T.Text
+formatSmallOpcode = T.pack . show
+
+formatLargeOpcode :: LargeOpcode -> T.Text
+formatLargeOpcode = T.pack . show
+
+formatInstruction :: Instruction -> T.Text
+formatInstruction (SmallInstruction so lv) = formatSmallOpcode so <> " " <> formatLargeValue lv
+formatInstruction (LargeInstruction lo sv) = formatLargeOpcode lo <> " " <> formatSmallValue sv

src/Mima/Format/State.hs

@@ -28,6 +28,8 @@ import qualified Data.Text as T
 
 import           Mima.Flag
 import           Mima.Format.Common
+import           Mima.Format.Instruction
+import           Mima.Instruction
 import           Mima.Label
 import           Mima.State
 import           Mima.Word
@@ -138,6 +140,25 @@ fWord a = do
       formats = (dec ++ hex ++ bin) <*> pure a
   pure $ "{" <> T.intercalate ", " formats <> "}"
 
+{- Instructions and Labels -}
+
+fLabels :: Set.Set LabelName -> T.Text
+fLabels = mconcat . map (<> ": ") . Set.toAscList
+
+fDecoration :: MimaAddress -> Formatter
+fDecoration a = do
+  env <- ask
+  let conf = feConf env
+      -- Labels
+      labels = Map.findWithDefault Set.empty a $ feLabels env
+      labelsStr = if fcShowLabels conf then fLabels labels else ""
+      -- Instruction
+      word = readAt a $ msMemory $ feState env
+      instrStr = case wordToInstruction word of
+        Left _  -> ""
+        Right i -> if fcShowInstructions conf then formatInstruction i else ""
+  pure $ labelsStr <> instrStr
+
 {- Memory -}
 
 fMemoryLn :: MimaAddress -> Formatter
@@ -148,7 +169,8 @@ fMemoryLn a = do
   flags <- fFlags a
   addr <- fAddress a
   word <- fWord w
-  pure $ flags <> addr <> " " <> word <> "\n"
+  deco <- fDecoration a
+  pure $ flags <> addr <> " " <> word <> " " <> deco <> "\n"
 
 interestingAddresses :: FormatReader (Set.Set MimaAddress)
 interestingAddresses = do