Clean up string formatting
This commit is contained in:
parent
510ecaa51d
commit
f3a3432c9c
3 changed files with 46 additions and 56 deletions
|
|
@ -77,12 +77,6 @@ data Instruction
|
|||
| LargeInstruction !LargeOpcode !SmallValue
|
||||
deriving (Show, Eq)
|
||||
|
||||
instance ToText Instruction where
|
||||
toText (SmallInstruction oc lv) = T.justifyLeft 4 ' ' (toText oc) <> " " <> largeValueToDec lv
|
||||
toText (LargeInstruction oc sv)
|
||||
| sv == minBound = T.justifyLeft 4 ' ' (toText oc)
|
||||
| otherwise = T.justifyLeft 4 ' ' (toText oc) <> " " <> smallValueToDec sv
|
||||
|
||||
wordToInstruction :: MimaWord -> Either T.Text Instruction
|
||||
wordToInstruction mw = if getSmallOpcode mw == 0xF
|
||||
then parseLargeInstruction mw
|
||||
|
|
@ -99,7 +93,7 @@ parseSmallOpcode :: Word32 -> Either T.Text SmallOpcode
|
|||
parseSmallOpcode w = case smallOpcodeMap Map.!? w of
|
||||
Just oc -> pure oc
|
||||
Nothing -> Left $ "Unknown small opcode " <> T.pack (show w)
|
||||
<> " (" <> toHex 1 w <> ")"
|
||||
<> " (" <> integralToHex 1 w <> ")"
|
||||
|
||||
parseLargeInstruction :: MimaWord -> Either T.Text Instruction
|
||||
parseLargeInstruction mw = do
|
||||
|
|
@ -112,4 +106,4 @@ parseLargeOpcode :: Word32 -> Either T.Text LargeOpcode
|
|||
parseLargeOpcode w = case largeOpcodeMap Map.!? w of
|
||||
Just oc -> pure oc
|
||||
Nothing -> Left $ "Unknown large opcode " <> T.pack (show w)
|
||||
<> " (" <> toHex 1 w <> ")"
|
||||
<> " (" <> integralToHex 1 w <> ")"
|
||||
|
|
|
|||
|
|
@ -1,7 +1,11 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Mima.Util
|
||||
( ToText(..)
|
||||
, toDec
|
||||
, toHex
|
||||
, HexLike(..)
|
||||
, groupByTwoChars
|
||||
, integralToDec
|
||||
, integralToHex
|
||||
) where
|
||||
|
||||
import qualified Data.Text as T
|
||||
|
|
@ -20,8 +24,22 @@ 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
|
||||
class HexLike a where
|
||||
toDec :: a -> T.Text
|
||||
toHex :: a -> T.Text
|
||||
|
||||
toHex :: (Integral a, Show a) => Int -> a -> T.Text
|
||||
toHex digits a = T.justifyRight digits '0' $ T.pack $ N.showHex a ""
|
||||
toHexBytes :: a -> T.Text
|
||||
toHexBytes = T.intercalate " " . groupByTwoChars . toHex
|
||||
|
||||
groupByTwoChars :: T.Text -> [T.Text]
|
||||
groupByTwoChars = reverse . helper . T.unpack . T.reverse
|
||||
where
|
||||
helper (c1:c2:cs) = T.pack [c2, c1] : helper cs
|
||||
helper [c] = [T.singleton c]
|
||||
helper [] = []
|
||||
|
||||
integralToDec :: (Integral a, Show a) => Int -> a -> T.Text
|
||||
integralToDec digits a = T.justifyRight digits ' ' $ T.pack $ show a
|
||||
|
||||
integralToHex :: (Integral a, Show a) => Int -> a -> T.Text
|
||||
integralToHex digits a = T.justifyRight digits '0' $ T.pack $ N.showHex a ""
|
||||
|
|
|
|||
|
|
@ -4,10 +4,6 @@ module Mima.Word
|
|||
( topBit
|
||||
-- * 24-bit value
|
||||
, MimaWord
|
||||
-- ** Formatting
|
||||
, wordToHex
|
||||
, wordToDec
|
||||
, wordToHexDec
|
||||
-- ** Converting
|
||||
, bytesToWord
|
||||
, wordToBytes
|
||||
|
|
@ -23,10 +19,6 @@ module Mima.Word
|
|||
-- * 20-bit value
|
||||
, LargeValue
|
||||
, MimaAddress
|
||||
-- ** Formatting
|
||||
, largeValueToHex
|
||||
, largeValueToDec
|
||||
, largeValueToHexDec
|
||||
-- ** Converting
|
||||
, bytesToLargeValue
|
||||
, largeValueToBytes
|
||||
|
|
@ -35,10 +27,6 @@ module Mima.Word
|
|||
, addLargeValues
|
||||
-- * 16-bit value
|
||||
, SmallValue
|
||||
-- ** Formatting
|
||||
, smallValueToHex
|
||||
, smallValueToDec
|
||||
, smallValueToHexDec
|
||||
-- ** Converting
|
||||
, signedSmallValueToWord
|
||||
) where
|
||||
|
|
@ -70,6 +58,11 @@ newtype WB t = WB { unWB :: t}
|
|||
instance (Show t) => Show (WB t) where
|
||||
show = show . unWB
|
||||
|
||||
instance (HexLike t) => HexLike (WB t) where
|
||||
toDec = toDec . unWB
|
||||
toHex = toHex . unWB
|
||||
toHexBytes = toHexBytes . unWB
|
||||
|
||||
-- Kinda obvious, isn't it? :P
|
||||
instance (Word32Based t) => Word32Based (WB t) where
|
||||
usedBits = usedBits . unWB
|
||||
|
|
@ -146,17 +139,12 @@ instance Word32Based MimaWord_ where
|
|||
fromWord32 w = MimaWord_ $ w .&. 0xFFFFFF
|
||||
toWord32 (MimaWord_ w) = w
|
||||
|
||||
instance HexLike MimaWord_ where
|
||||
toDec = T.pack . show . toWord32
|
||||
toHex = integralToHex 6 . toWord32
|
||||
|
||||
instance Show MimaWord_ where
|
||||
show mw = T.unpack $ "MimaWord_ 0x" <> toHex 6 (toWord32 mw)
|
||||
|
||||
wordToHex :: MimaWord -> T.Text
|
||||
wordToHex = toHex 6 . toWord32
|
||||
|
||||
wordToDec :: MimaWord -> T.Text
|
||||
wordToDec = toDec 8 . toWord32
|
||||
|
||||
wordToHexDec :: MimaWord -> T.Text
|
||||
wordToHexDec mw = wordToHex mw <> " (" <> wordToDec mw <> ")"
|
||||
show mw = T.unpack $ "MimaWord_ 0x" <> toHex mw
|
||||
|
||||
bytesToWord :: Word8 -> Word8 -> Word8 -> MimaWord
|
||||
bytesToWord w1 w2 w3 =
|
||||
|
|
@ -204,17 +192,12 @@ instance Word32Based LargeValue_ where
|
|||
fromWord32 w = LargeValue_ $ w .&. 0xFFFFF
|
||||
toWord32 (LargeValue_ w) = w
|
||||
|
||||
instance HexLike LargeValue_ where
|
||||
toDec = T.pack . show . toWord32
|
||||
toHex = integralToHex 5 . toWord32
|
||||
|
||||
instance Show LargeValue_ where
|
||||
show lv = T.unpack $ "LargeValue_ 0x" <> toHex 5 (toWord32 lv)
|
||||
|
||||
largeValueToHex :: LargeValue -> T.Text
|
||||
largeValueToHex = toHex 5 . toWord32
|
||||
|
||||
largeValueToDec :: LargeValue -> T.Text
|
||||
largeValueToDec = toDec 7 . toWord32
|
||||
|
||||
largeValueToHexDec :: LargeValue -> T.Text
|
||||
largeValueToHexDec mw = largeValueToHex mw <> " (" <> largeValueToDec mw <> ")"
|
||||
show lv = T.unpack $ "LargeValue_ 0x" <> toHex lv
|
||||
|
||||
bytesToLargeValue :: Word8 -> Word8 -> Word8 -> LargeValue
|
||||
bytesToLargeValue w1 w2 w3 = getAddress $ bytesToWord w1 w2 w3
|
||||
|
|
@ -236,17 +219,12 @@ instance Word32Based SmallValue_ where
|
|||
fromWord32 w = SmallValue_ $ w .&. 0xFFFF
|
||||
toWord32 (SmallValue_ w) = w
|
||||
|
||||
instance HexLike SmallValue_ where
|
||||
toDec = T.pack . show . toWord32
|
||||
toHex = integralToHex 5 . toWord32
|
||||
|
||||
instance Show SmallValue_ where
|
||||
show lv = T.unpack $ "SmallValue_ 0x" <> toHex 4 (toWord32 lv)
|
||||
|
||||
smallValueToHex :: SmallValue -> T.Text
|
||||
smallValueToHex = toHex 4 . toWord32
|
||||
|
||||
smallValueToDec :: SmallValue -> T.Text
|
||||
smallValueToDec = toDec 5 . toWord32
|
||||
|
||||
smallValueToHexDec :: SmallValue -> T.Text
|
||||
smallValueToHexDec mw = smallValueToHex mw <> " (" <> smallValueToDec mw <> ")"
|
||||
show sv = T.unpack $ "SmallValue_ 0x" <> toHex sv
|
||||
|
||||
signedSmallValueToWord :: SmallValue -> MimaWord
|
||||
signedSmallValueToWord sv
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue