From f3b39f78f4340db418c9a187cbfc25b752ac8937 Mon Sep 17 00:00:00 2001 From: Joscha Date: Wed, 20 Nov 2019 20:46:34 +0000 Subject: [PATCH] Parse assembly statements This commit begins the rewrite of the assembly parser to use the new (not yet written down) syntax. --- src/Mima/Parse/Assembly/Common.hs | 41 ++++++++++++ src/Mima/Parse/Assembly/Directive.hs | 65 +++++++++++++++++++ src/Mima/Parse/Assembly/Lexeme.hs | 40 ++++++++++++ src/Mima/Parse/Assembly/RawInstruction.hs | 78 +++++++++++++++++++++++ src/Mima/Parse/Assembly/Statement.hs | 35 ++++++++++ src/Mima/Parse/FlagFile.hs | 1 - 6 files changed, 259 insertions(+), 1 deletion(-) create mode 100644 src/Mima/Parse/Assembly/Common.hs create mode 100644 src/Mima/Parse/Assembly/Directive.hs create mode 100644 src/Mima/Parse/Assembly/Lexeme.hs create mode 100644 src/Mima/Parse/Assembly/RawInstruction.hs create mode 100644 src/Mima/Parse/Assembly/Statement.hs diff --git a/src/Mima/Parse/Assembly/Common.hs b/src/Mima/Parse/Assembly/Common.hs new file mode 100644 index 0000000..5cf1f36 --- /dev/null +++ b/src/Mima/Parse/Assembly/Common.hs @@ -0,0 +1,41 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Mima.Parse.Assembly.Common + ( number + , word + , largeValue + , smallValue + , Address(..) + , address + ) where + +import Text.Megaparsec +import qualified Text.Megaparsec.Char.Lexer as L + +import Mima.Label +import Mima.Parse.Assembly.Lexeme +import Mima.Parse.Common +import Mima.Parse.Weed +import Mima.Word + +number :: Parser Integer +number = L.signed (pure ()) $ + (symbol' "0b" *> binNumber) + <|> (symbol' "0o" *> octNumber) + <|> (symbol' "0x" *> hexNumber) + <|> decNumber + +word :: Parser MimaWord +word = label "word (24 bit)" $ asWord number + +largeValue :: Parser LargeValue +largeValue = label "large value (20 bit)" $ asLargeValue number + +smallValue :: Parser SmallValue +smallValue = label "large value (16 bit)" $ asSmallValue number + +data Address = Direct LargeValue | Indirect (WithOffset LabelName) + deriving (Show) + +address :: Parser Address +address = (Direct <$> largeValue) <|> (Indirect <$> withOffset labelName) diff --git a/src/Mima/Parse/Assembly/Directive.hs b/src/Mima/Parse/Assembly/Directive.hs new file mode 100644 index 0000000..537dac2 --- /dev/null +++ b/src/Mima/Parse/Assembly/Directive.hs @@ -0,0 +1,65 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Mima.Parse.Assembly.Directive + ( SetRegister(..) + , Directive(..) + , lDirective + ) where + +import qualified Data.Set as Set +import Text.Megaparsec + +import Mima.Parse.Assembly.Common +import Mima.Parse.Assembly.Lexeme +import Mima.Parse.Common +import Mima.Word + +data SetRegister a + = SetIAR a + | SetACC MimaWord + | SetRA a + | SetSP a + | SetFP a + deriving (Show) + +data Directive a + = DReg (SetRegister a) -- .reg (iar|acc|ra|sp|fp) + | DOrg MimaAddress -- .org
+ | DLit MimaWord -- .lit + | DArr [MimaWord] -- .arr [, ...] + | DFlag (Set.Set Char) -- .flag + | DFlagOn (Set.Set Char) -- .flagon + | DFlagOff (Set.Set Char) -- .flagoff + deriving (Show) + +lSetRegister :: Parser (SetRegister Address) +lSetRegister = + SetIAR <$> sepBySpace "iar" address + <|> SetACC <$> sepBySpace "acc" word + <|> SetRA <$> sepBySpace "ra" address + <|> SetSP <$> sepBySpace "sp" address + <|> SetFP <$> sepBySpace "fp" address + where + sepBySpace name parser = symbol name *> lSpace *> lexeme parser + +lWordArray :: Parser [MimaWord] +lWordArray = open *> (word `sepBy` comma) <* close + where + open = lexeme $ symbol "[" + comma = lexeme $ symbol "," + close = lexeme $ symbol "]" + +lFlags :: Parser (Set.Set Char) +lFlags = Set.unions <$> some (lexeme flag) + +lDirective :: Parser (Directive Address) +lDirective = label "assembler directive" $ undefined + DReg <$> directive ".reg" lSetRegister + <|> DOrg <$> directive ".org" (lexeme largeValue) + <|> DLit <$> directive ".lit" (lexeme word) + <|> DArr <$> directive ".arr" lWordArray + <|> DFlag <$> directive ".flag" lFlags + <|> DFlagOn <$> directive ".flagon" lFlags + <|> DFlagOff <$> directive ".flagoff" lFlags + where + directive name parser = symbol name *> lSpace *> parser diff --git a/src/Mima/Parse/Assembly/Lexeme.hs b/src/Mima/Parse/Assembly/Lexeme.hs new file mode 100644 index 0000000..1c2a4ed --- /dev/null +++ b/src/Mima/Parse/Assembly/Lexeme.hs @@ -0,0 +1,40 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Mima.Parse.Assembly.Lexeme + ( space + , lexeme + , symbol + , symbol' + , lSpace + , lNewline + , lNewlines + ) where + +import Control.Monad +import qualified Data.Text as T +import Text.Megaparsec +import qualified Text.Megaparsec.Char as C +import qualified Text.Megaparsec.Char.Lexer as L + +import Mima.Parse.Common + +space :: Parser () +space = L.space (void whitespace) (L.skipLineComment ";") empty + +lexeme :: Parser a -> Parser a +lexeme = L.lexeme space + +symbol :: T.Text -> Parser T.Text +symbol = L.symbol space + +symbol' :: T.Text -> Parser T.Text +symbol' = L.symbol' space + +lSpace :: Parser () +lSpace = lexeme space + +lNewline :: Parser () +lNewline = void $ lexeme C.newline + +lNewlines :: Parser () +lNewlines = void (some lNewline) <|> eof diff --git a/src/Mima/Parse/Assembly/RawInstruction.hs b/src/Mima/Parse/Assembly/RawInstruction.hs new file mode 100644 index 0000000..8558c44 --- /dev/null +++ b/src/Mima/Parse/Assembly/RawInstruction.hs @@ -0,0 +1,78 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Mima.Parse.Assembly.RawInstruction + ( RawInstruction(..) + , lRawInstruction + , cookInstruction + ) where + +import qualified Data.Text as T +import Text.Megaparsec + +import Mima.Instruction +import Mima.Parse.Assembly.Common +import Mima.Parse.Assembly.Lexeme +import Mima.Parse.Common +import Mima.Word + +data RawInstruction a + = RawSmallInstruction SmallOpcode a + | RawLargeInstruction LargeOpcode SmallValue + deriving (Show) + +parseByName :: [(T.Text, a)] -> Parser a +parseByName = foldl (<|>) empty . map (\(name, a) -> a <$ symbol' name) + +smallOpcode :: Parser SmallOpcode +smallOpcode = parseByName + [ ("ldc", LDC) + , ("ldv", LDV) + , ("stv", STV) + , ("add", ADD) + , ("and", AND) + , ("or", OR) + , ("xor", XOR) + , ("eql", EQL) + , ("jmp", JMP) + , ("jmn", JMN) + , ("ldiv", LDIV) + , ("stiv", STIV) + , ("call", CALL) + , ("adc", ADC) + ] + +largeOpcode :: Parser LargeOpcode +largeOpcode = parseByName + [ ("halt", HALT) + , ("not", NOT) + , ("rar", RAR) + , ("ret", RET) + , ("ldra", LDRA) + , ("stra", STRA) + , ("ldsp", LDSP) + , ("stsp", STSP) + , ("ldfp", LDFP) + , ("stfp", STFP) + ] + +largeOpcodeWithArgument :: Parser LargeOpcode +largeOpcodeWithArgument = parseByName + [ ("ldrs", LDRS) + , ("strs", STRS) + , ("ldrf", LDRF) + , ("strf", STRF) + ] + +lRawInstruction :: Parser (RawInstruction Address) +lRawInstruction = label "instruction" $ + (RawSmallInstruction <$> smallOpcode <*> addr) + <|> (RawLargeInstruction <$> largeOpcode <*> optionalSv) + <|> (RawLargeInstruction <$> largeOpcodeWithArgument <*> sv) + where + addr = lexeme space *> lexeme address + sv = lexeme space *> lexeme smallValue + optionalSv = lexeme (lexeme space *> smallValue <|> pure 0) + +cookInstruction :: RawInstruction MimaAddress -> Instruction +cookInstruction (RawSmallInstruction so lv) = SmallInstruction so lv +cookInstruction (RawLargeInstruction lo sv) = LargeInstruction lo sv diff --git a/src/Mima/Parse/Assembly/Statement.hs b/src/Mima/Parse/Assembly/Statement.hs new file mode 100644 index 0000000..b46a5e5 --- /dev/null +++ b/src/Mima/Parse/Assembly/Statement.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Mima.Parse.Assembly.Statement + ( Statement(..) + , lStatement + , lStatements + ) where + +import Text.Megaparsec + +import Mima.Label +import Mima.Parse.Assembly.Common +import Mima.Parse.Assembly.Directive +import Mima.Parse.Assembly.Lexeme +import Mima.Parse.Assembly.RawInstruction +import Mima.Parse.Common +import Mima.Parse.Weed + +data Statement a + = SDirective (Directive a) + | SRawInstruction (RawInstruction a) + | SLabel LabelName + deriving (Show) + +lLabel :: Parser LabelName +lLabel = lexeme $ try $ labelName <* symbol ":" + +lStatement :: Parser (Statement Address) +lStatement = + SDirective <$> lDirective <* lNewlines + <|> SRawInstruction <$> lRawInstruction <* lNewlines + <|> SLabel <$> lLabel <* many lNewline + +lStatements :: Parser [WithOffset (Statement Address)] +lStatements = many (withOffset lStatement) diff --git a/src/Mima/Parse/FlagFile.hs b/src/Mima/Parse/FlagFile.hs index a20089c..a3cac8b 100644 --- a/src/Mima/Parse/FlagFile.hs +++ b/src/Mima/Parse/FlagFile.hs @@ -6,7 +6,6 @@ module Mima.Parse.FlagFile ) where import Control.Monad -import Data.Char import qualified Data.Map as Map import qualified Data.Set as Set import qualified Data.Text as T