From 1975403c3c4e71866bd4f3f23fd167d628a0b0b8 Mon Sep 17 00:00:00 2001
From: Joscha <joscha@plugh.de>
Date: Mon, 25 Nov 2019 17:45:46 +0000
Subject: [PATCH] Output instructions and labels in memory dump

---
 src/Mima/Format/Common.hs      |  9 +++++++++
 src/Mima/Format/Instruction.hs | 31 +++++++++++++++++++++++++++++++
 src/Mima/Format/State.hs       | 24 +++++++++++++++++++++++-
 3 files changed, 63 insertions(+), 1 deletion(-)
 create mode 100644 src/Mima/Format/Instruction.hs

diff --git a/src/Mima/Format/Common.hs b/src/Mima/Format/Common.hs
index d795361..b7eafc0 100644
--- a/src/Mima/Format/Common.hs
+++ b/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
 
diff --git a/src/Mima/Format/Instruction.hs b/src/Mima/Format/Instruction.hs
new file mode 100644
index 0000000..a0f1db8
--- /dev/null
+++ b/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
diff --git a/src/Mima/Format/State.hs b/src/Mima/Format/State.hs
index dcd8ec1..e32c4f2 100644
--- a/src/Mima/Format/State.hs
+++ b/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