Garmelon/mima-tools
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Parse instructions without arguments

Browse source
This commit is contained in:
I-Al-Istannen 2020-03-31 16:06:15 +02:00
parent 813d891468
commit 2882a2c42e
1 changed files with 12 additions and 8 deletions
Download patch file Download diff file Expand all files Collapse all files

20
src/Mima/Asm/Phase1.hs
View file

@ -17,6 +17,8 @@ module Mima.Asm.Phase1
-- * Parsers -- * Parsers
, Phase1 , Phase1
, parsePhase1 , parsePhase1
-- * Parse helper function
, parseAssembly
) where ) where
import Control.Monad import Control.Monad
@ -113,7 +115,7 @@ instance Onion SmallValue where
data Instruction a data Instruction a
= SmallInstruction a (SmallOpcode a) (Location a) = SmallInstruction a (SmallOpcode a) (Location a)
| LargeInstruction a (LargeOpcode a) (SmallValue a) | LargeInstruction a (LargeOpcode a) (Maybe (SmallValue a))
deriving (Show) deriving (Show)
instance Onion Instruction where instance Onion Instruction where
@ -266,7 +268,6 @@ smallValue :: Parser (SmallValue Span)
smallValue = uncurry SmallValue <$> withSpan boundedNumber smallValue = uncurry SmallValue <$> withSpan boundedNumber
instruction :: Parser (Instruction Span) instruction :: Parser (Instruction Span)
-- TODO: Instructions without arguments! (e.g. HALT)
instruction = small <|> large instruction = small <|> large
where where
small = do small = do
@ -279,10 +280,12 @@ instruction = small <|> large
large = do large = do
start <- getSourcePos start <- getSourcePos
lo <- largeOpcode lo <- largeOpcode
space1 sv <- optionalAwareArgument lo
sv <- smallValue
stop <- getSourcePos stop <- getSourcePos
pure $ LargeInstruction (Span start stop) lo sv pure $ LargeInstruction (Span start stop) lo sv
optionalAwareArgument (LargeOpcode _ code)
| Vm.argumentIsOptional code = optional (space1 *> smallValue <?> "argument")
| otherwise = Just <$> (space1 *> smallValue <?> "argument")
singleDirective singleDirective
:: (Span -> Span -> a -> b Span) :: (Span -> Span -> a -> b Span)
@ -365,11 +368,12 @@ doParse p input = case parse parsecParser "" (T.pack input) of
Right (res, tokenStream) -> putStrLn $ "Success:\n " ++ show res ++ "\n " ++ show (appEndo tokenStream []) Right (res, tokenStream) -> putStrLn $ "Success:\n " ++ show res ++ "\n " ++ show (appEndo tokenStream [])
where parsecParser = runWriterT p where parsecParser = runWriterT p
parseAssembly :: T.Text -> Either T.Text Phase1 -- | Parses a given text to a 'Phase1' structure, if possible.
parseAssembly :: T.Text -> Either (ParseErrorBundle T.Text Void) Phase1
parseAssembly input = case parse (runWriterT parsePhase1) "" input of parseAssembly input = case parse (runWriterT parsePhase1) "" input of
Left msg -> Left $ T.pack $ errorBundlePretty msg Left err -> Left err
Right (result, _) -> Right result Right (result, _) -> Right result
displayParseResult :: Either T.Text Phase1 -> IO () displayParseResult :: Either (ParseErrorBundle T.Text Void) Phase1 -> IO ()
displayParseResult (Left msg) = putStrLn $ T.unpack msg displayParseResult (Left msg) = putStrLn $ errorBundlePretty msg
displayParseResult (Right val) = traverse_ print val displayParseResult (Right val) = traverse_ print val