Create working parser

This commit is contained in:
2021-11-02 16:52:07 +01:00
parent c16cfb33a0
commit e8b94aa017
3 changed files with 54 additions and 0 deletions

View File

@@ -27,6 +27,8 @@ executable MVM
other-modules:
VirtualMachine
Instruction
Parser
Util
-- LANGUAGE extensions used by modules in this package.
-- other-extensions:

28
app/Parser.hs Normal file
View File

@@ -0,0 +1,28 @@
module Parser (
parse
) where
import Data.Word
import qualified Data.ByteString as B
import qualified Data.Map as Map
import qualified Instruction as I
import qualified Util as U
parse :: B.ByteString -> Either String [I.Command]
parse = parseCommands . B.unpack
parseCommands :: [Word8] -> Either String [I.Command]
parseCommands [] = Right []
parseCommands code@(x:_) = case parseCommand code of
Just (cmd, rest) -> parseCommands rest >>= (\r -> return $ cmd : r)
Nothing -> Left $ "Unparseable byte: " ++ U.byteStr x ++ "\nIn following sequence:\n" ++ U.bytesStr 16 code
parseCommand :: [Word8] -> Maybe (I.Command, [Word8])
parseCommand [] = Nothing
parseCommand (opByte:xs) = do
let op = toEnum . fromIntegral $ opByte :: I.Op
instruction <- Map.lookup op I.instructionByOp
let noParams = I.noParams instruction
let params = map fromIntegral $ take noParams xs :: [Int]
return (I.Command instruction params, drop noParams xs)

24
app/Util.hs Normal file
View File

@@ -0,0 +1,24 @@
module Util (
byteStr,
bytesStr
) where
import Data.List
import Data.Word
import Numeric (showHex)
bytesStr :: Int -> [Word8] -> String
bytesStr sparse = insertAtN '\n' (sparse*3) . intercalate " " . map byteStr
byteStr :: Word8 -> String
byteStr = pad '0' 2 . (flip showHex) "" . fromIntegral
insertAtN :: a -> Int -> [a] -> [a]
insertAtN c n xs = insertAtN' n xs
where
insertAtN' 0 xs = c : insertAtN' n xs
insertAtN' _ [] = []
insertAtN' m (x:xs) = x : insertAtN' (m-1) xs
pad :: Char -> Int -> String -> String
pad char width string = replicate (width - length string) char ++ string