From a0caa3b59c5444216994f7785dc23b8044193786 Mon Sep 17 00:00:00 2001 From: Joscha Date: Thu, 7 Nov 2019 20:23:31 +0000 Subject: [PATCH] Add syntax highlighting This commit also cleans up the printing code, which is now longer but easier to work with. --- app/MimaRun.hs | 159 ++++++++++++++++++++++++++++++++++--------------- package.yaml | 3 +- 2 files changed, 112 insertions(+), 50 deletions(-) diff --git a/app/MimaRun.hs b/app/MimaRun.hs index ffb0161..3cb7824 100644 --- a/app/MimaRun.hs +++ b/app/MimaRun.hs @@ -1,12 +1,15 @@ +{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} module MimaRun where import Control.Monad +import Data.Bits import qualified Data.Text as T import qualified Data.Text.IO as T import Options.Applicative +import System.Console.ANSI import Mima.Instruction import Mima.Load @@ -23,6 +26,8 @@ data Settings = Settings , norun :: Bool } deriving (Show) +{- Command-line parameters -} + settingsParser :: Parser Settings settingsParser = Settings <$> strArgument @@ -54,6 +59,110 @@ settingsParser = Settings opts :: ParserInfo Settings opts = info (helper <*> settingsParser) $ fullDesc <> failureCode 1 +{- Fancy output -} + +printAddress :: Int -> MimaAddress -> IO () +printAddress n addr = do + T.putStr $ toHexBytes addr + putStr " (" + T.putStr $ T.justifyRight n ' ' $ toDec addr + putStr ")" + +printWord :: Int -> MimaWord -> IO () +printWord n word = do + T.putStr $ toHexBytes word + putStr " (" + T.putStr $ T.justifyRight n ' ' $ toDec word + putStr ")" + +printInstruction :: Instruction -> IO () +printInstruction (SmallInstruction so lv) = do + setSGR [SetConsoleIntensity BoldIntensity] + if | so `elem` [JMP, JMN, CALL] -> setSGR [SetColor Foreground Vivid Yellow] + | so `elem` [LDC, LDV, STV, LDIV, STIV, LDVR, STVR] -> setSGR [SetColor Foreground Vivid Blue] + | so `elem` [ADD, AND, OR, XOR, EQL] -> setSGR [SetColor Foreground Vivid Cyan] + | otherwise -> pure () + T.putStr $ toText so + putStr " " + setSGR [SetColor Foreground Vivid Black] + T.putStr $ toDec lv + setSGR [] +printInstruction (LargeInstruction lo sv) = do + setSGR [SetConsoleIntensity BoldIntensity] + if | lo == HALT -> setSGR [SetColor Foreground Vivid Red] + | lo == RET -> setSGR [SetColor Foreground Vivid Yellow] + | lo `elem` [NOT, RAR, ADC] -> setSGR [SetColor Foreground Vivid Cyan] + | lo `elem` [LDRA, STRA, LDSP, STSP, LDFP, STFP] -> setSGR [SetColor Foreground Vivid Magenta] + | otherwise -> pure () + T.putStr $ toText lo + when (lo == ADC || sv /= zeroBits) $ do + putStr " " + setSGR [SetColor Foreground Vivid Black] + T.putStr $ toDec sv + setSGR [] + +printWordWithInstruction :: Int -> MimaWord -> IO () +printWordWithInstruction n word = do + printWord n word + case wordToInstruction word of + Left _ -> pure () + Right i -> do + putStr ": " + printInstruction i + +printAddressRegister :: MimaState -> MimaAddress -> IO () +printAddressRegister ms addr = do + printAddress 8 addr + putStr " -> " + printWordWithInstruction 8 $ readAt addr $ msMemory ms + +printRegistersLn :: MimaState -> IO () +printRegistersLn ms = do + putStr "IAR: " + printAddressRegister ms $ msIAR ms + putStrLn "" + + putStr "ACC: " + printWord 8 $ msACC ms + putStrLn "" + + putStr " RA: " + printAddressRegister ms $ msRA ms + putStrLn "" + + putStr " SP: " + printAddressRegister ms $ msSP ms + putStrLn "" + + putStr " FP: " + printAddressRegister ms $ msFP ms + putStrLn "" + +printMemoryLocationLn :: MimaAddress -> MimaWord -> IO () +printMemoryLocationLn addr word = do + printAddress 7 addr + putStr " -> " + printWord 8 word + case wordToInstruction word of + Left _ -> pure () + Right i -> do + putStr ": " + printInstruction i + putStrLn "" + +printMemoryLn :: Bool -> MimaMemory -> IO () +printMemoryLn sparse mem = do + let addresses = if sparse then sparseAddressRange mem else addressRange mem + forM_ addresses $ \addr -> do + printMemoryLocationLn addr (readAt addr mem) + +printStateLn :: Bool -> MimaState -> IO () +printStateLn sparse ms = do + printRegistersLn ms + printMemoryLn sparse $ msMemory ms + +{- Main logic -} + runMima :: Settings -> MimaState -> IO MimaState runMima settings s = case steps settings of @@ -71,54 +180,6 @@ runMima settings s = Just e -> T.putStrLn $ toText e pure s' -dumpState :: Bool -> MimaState -> T.Text -dumpState sparse ms - = registerLegend - <> dumpRegisters ms - <> memoryLegend - <> dumpMemory sparse (msMemory ms) - <> footerLegend - -showWord :: MimaWord -> T.Text -showWord w = - case wordToInstruction w of - Left _ -> wordToHexDec w - Right i -> wordToHexDec w <> ": " <> toText i - -dumpRegisters :: MimaState -> T.Text -dumpRegisters MimaState{..} - = "IAR: " <> showAddressRegister msIAR <> " -> " <> showWord (readAt msIAR msMemory) <> "\n" - <> "ACC: " <> showWordRegister msACC <> "\n" - <> " RA: " <> showAddressRegister msRA <> " -> " <> showWord (readAt msRA msMemory) <> "\n" - <> " SP: " <> showAddressRegister msRA <> " -> " <> showWord (readAt msRA msMemory) <> "\n" - <> " FP: " <> showAddressRegister msRA <> " -> " <> showWord (readAt msRA msMemory) <> "\n" - where - showWordRegister w = wordToHex w <> " (" <> wordToDec w <> ")" - showAddressRegister lv = - " " <> largeValueToHex lv <> " ( " <> largeValueToDec lv <> ")" - -registerLegend :: T.Text -registerLegend = "--------- Register -------------- Target word ---------------\n" --- "IAR: 00000 ( 0) -> 800008 ( 8388616): JMP 8" - -showMemoryLine :: MimaAddress -> MimaWord -> T.Text -showMemoryLine addr word = largeValueToHexDec addr <> " -> " <> showWord word <> "\n" - -dumpMemory :: Bool -> MimaMemory -> T.Text -dumpMemory sparse mem = - let addresses = if sparse then sparseAddressRange mem else addressRange mem - memLines = map (\addr -> showMemoryLine addr $ readAt addr mem) addresses - in T.concat memLines - -memoryLegend :: T.Text -memoryLegend = "--- Address ---------------- Word ---------------------------\n" --- "00000 ( 0) -> 800008 ( 8388616): JMP 8" --- "IAR: 00000 ( 0) -> 800008 ( 8388616): JMP 8" - -footerLegend :: T.Text -footerLegend = "------------------------------------------------------\n" --- "00000 ( 0) -> 800008 ( 8388616): JMP 8" - -- TODO exception handling main :: IO () main = do @@ -133,7 +194,7 @@ main = do unless (quiet settings) $ do putStrLn "" putStrLn "Dump of MiMa state:" - T.putStr $ dumpState (sparse settings) s' + printStateLn (sparse settings) s' putStrLn "" forM_ (memoryDump settings) $ \path -> do diff --git a/package.yaml b/package.yaml index a39d9dc..6013ce8 100644 --- a/package.yaml +++ b/package.yaml @@ -20,10 +20,11 @@ description: Please see the README on GitHub at = 4.7 && < 5 +- ansi-terminal >= 0.9.1 && < 0.10 - bytestring >= 0.10.8 && < 0.11 - containers >= 0.6.0 && < 0.7 -- text >= 1.2.3 && < 1.3 - optparse-applicative >= 0.14.3 && < 0.15 +- text >= 1.2.3 && < 1.3 library: source-dirs: src