Split up phase 1 into multiple modules
This commit is contained in:
parent
8d0e70cf5d
commit
ff9b7a35c7
5 changed files with 470 additions and 449 deletions
|
|
@ -1,453 +1,10 @@
|
||||||
{-# LANGUAGE DeriveFunctor #-}
|
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
|
||||||
|
|
||||||
module Mima.Asm.Phase1
|
module Mima.Asm.Phase1
|
||||||
(
|
( AsmToken
|
||||||
-- * Types
|
|
||||||
Name(..)
|
|
||||||
, Address(..)
|
|
||||||
, Location(..)
|
|
||||||
, SmallOpcode(..)
|
|
||||||
, LargeOpcode(..)
|
|
||||||
, MimaWord(..)
|
|
||||||
, SmallValue(..)
|
|
||||||
, Instruction(..)
|
|
||||||
, RegisterDirective(..)
|
|
||||||
, JsonValue(..)
|
|
||||||
, Directive(..)
|
|
||||||
, Span(..)
|
|
||||||
, AsmToken(..)
|
|
||||||
-- * Phase1
|
|
||||||
, Phase1
|
, Phase1
|
||||||
, parsePhase1
|
, parsePhase1
|
||||||
, formatPhase1
|
, formatPhase1
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad
|
import Mima.Asm.Phase1.Format
|
||||||
import qualified Data.Aeson as A
|
import Mima.Asm.Phase1.Parse
|
||||||
import qualified Data.Aeson.Text as A
|
import Mima.Asm.Phase1.Types
|
||||||
import qualified Data.ByteString.Lazy as BS
|
|
||||||
import Data.Char
|
|
||||||
import Data.Foldable
|
|
||||||
import Data.Maybe
|
|
||||||
import qualified Data.Text as T
|
|
||||||
import qualified Data.Text.Encoding as T
|
|
||||||
import qualified Data.Text.Lazy as TL
|
|
||||||
import Data.Void
|
|
||||||
import Text.Megaparsec
|
|
||||||
import Text.Megaparsec.Char
|
|
||||||
import Text.Megaparsec.Char.Lexer hiding (space)
|
|
||||||
|
|
||||||
import Mima.Asm.Types
|
|
||||||
import Mima.Format
|
|
||||||
import qualified Mima.Vm.Instruction as Vm
|
|
||||||
|
|
||||||
{-
|
|
||||||
<value> := <word> | <address>
|
|
||||||
<address> := <absolute address> | <relative address> | <label>
|
|
||||||
<name> := [a-z]([a-z0-9_]*)
|
|
||||||
<label> := <name>:
|
|
||||||
<instruction> := as usual
|
|
||||||
|
|
||||||
.reg ACC <value>
|
|
||||||
.reg <other register> <address>
|
|
||||||
|
|
||||||
.org (<absolute address> | <positive relative address> | <negative address>) ???
|
|
||||||
.lit <value>
|
|
||||||
.arr [<value>]
|
|
||||||
|
|
||||||
.meta <name> <json value>
|
|
||||||
.meta-start <name> [<json value>]
|
|
||||||
.meta-stop <name>
|
|
||||||
-}
|
|
||||||
|
|
||||||
{- Types -}
|
|
||||||
|
|
||||||
data Name a = Name a T.Text
|
|
||||||
deriving (Show, Functor)
|
|
||||||
|
|
||||||
instance Onion Name where
|
|
||||||
peel (Name a _) = a
|
|
||||||
|
|
||||||
data Address a
|
|
||||||
= AddressAbsolute a Integer
|
|
||||||
| AddressRelative a Integer
|
|
||||||
deriving (Show, Functor)
|
|
||||||
|
|
||||||
instance Onion Address where
|
|
||||||
peel (AddressAbsolute a _) = a
|
|
||||||
peel (AddressRelative a _) = a
|
|
||||||
|
|
||||||
data Location a
|
|
||||||
= LocationAddress (Address a)
|
|
||||||
| LocationLabel (Name a)
|
|
||||||
| LocationLabelRel a (Name a) a Integer
|
|
||||||
-- ^ @Lo LocationLabelRel completeSpan name offsetSpan offset@
|
|
||||||
deriving (Show, Functor)
|
|
||||||
|
|
||||||
instance Onion Location where
|
|
||||||
peel (LocationAddress a) = peel a
|
|
||||||
peel (LocationLabel a) = peel a
|
|
||||||
peel (LocationLabelRel a _ _ _) = a
|
|
||||||
|
|
||||||
data SmallOpcode a = SmallOpcode a Vm.SmallOpcode
|
|
||||||
deriving (Show, Functor)
|
|
||||||
|
|
||||||
instance Onion SmallOpcode where
|
|
||||||
peel (SmallOpcode a _) = a
|
|
||||||
|
|
||||||
data LargeOpcode a = LargeOpcode a Vm.LargeOpcode
|
|
||||||
deriving (Show, Functor)
|
|
||||||
|
|
||||||
instance Onion LargeOpcode where
|
|
||||||
peel (LargeOpcode a _) = a
|
|
||||||
|
|
||||||
data MimaWord a
|
|
||||||
= WordRaw a Integer
|
|
||||||
| WordLocation (Location a)
|
|
||||||
deriving (Show, Functor)
|
|
||||||
|
|
||||||
instance Onion MimaWord where
|
|
||||||
peel (WordRaw a _) = a
|
|
||||||
peel (WordLocation a) = peel a
|
|
||||||
|
|
||||||
data SmallValue a = SmallValue a Integer
|
|
||||||
deriving (Show, Functor)
|
|
||||||
|
|
||||||
instance Onion SmallValue where
|
|
||||||
peel (SmallValue a _) = a
|
|
||||||
|
|
||||||
data Instruction a
|
|
||||||
= SmallInstruction a (SmallOpcode a) (Location a)
|
|
||||||
| LargeInstruction a (LargeOpcode a) (Maybe (SmallValue a))
|
|
||||||
deriving (Show, Functor)
|
|
||||||
|
|
||||||
instance Onion Instruction where
|
|
||||||
peel (SmallInstruction a _ _) = a
|
|
||||||
peel (LargeInstruction a _ _) = a
|
|
||||||
|
|
||||||
-- | The first @a@ parameter represents the span of the whole thing. The second
|
|
||||||
-- @a@ parameter represents the span of the directive literal (e. g. @.org@).
|
|
||||||
data RegisterDirective a
|
|
||||||
= RegIar a a (Location a)
|
|
||||||
| RegAcc a a (MimaWord a)
|
|
||||||
| RegRa a a (Location a)
|
|
||||||
| RegSp a a (Location a)
|
|
||||||
| RegFp a a (Location a)
|
|
||||||
deriving (Show, Functor)
|
|
||||||
|
|
||||||
instance Onion RegisterDirective where
|
|
||||||
peel (RegIar a _ _) = a
|
|
||||||
peel (RegAcc a _ _) = a
|
|
||||||
peel (RegRa a _ _) = a
|
|
||||||
peel (RegSp a _ _) = a
|
|
||||||
peel (RegFp a _ _) = a
|
|
||||||
|
|
||||||
data JsonValue a = JsonValue a A.Value
|
|
||||||
deriving (Show, Functor)
|
|
||||||
|
|
||||||
instance Onion JsonValue where
|
|
||||||
peel (JsonValue a _) = a
|
|
||||||
|
|
||||||
-- | The first @a@ parameter represents the span of the whole thing. The second
|
|
||||||
-- @a@ parameter represents the span of the directive literal (e. g. @.org@).
|
|
||||||
data Directive a
|
|
||||||
= Reg a a (RegisterDirective a)
|
|
||||||
| Org a a (Address a)
|
|
||||||
| Lit a a (MimaWord a)
|
|
||||||
| Arr a a [MimaWord a]
|
|
||||||
| Meta a a (Name a) (JsonValue a)
|
|
||||||
| MetaStart a a (Name a) (JsonValue a)
|
|
||||||
| MetaStop a a (Name a)
|
|
||||||
deriving (Show, Functor)
|
|
||||||
|
|
||||||
instance Onion Directive where
|
|
||||||
peel (Reg a _ _) = a
|
|
||||||
peel (Org a _ _) = a
|
|
||||||
peel (Lit a _ _) = a
|
|
||||||
peel (Arr a _ _) = a
|
|
||||||
peel (Meta a _ _ _) = a
|
|
||||||
peel (MetaStart a _ _ _) = a
|
|
||||||
peel (MetaStop a _ _) = a
|
|
||||||
|
|
||||||
data AsmToken a
|
|
||||||
= TokenLabel (Name a)
|
|
||||||
| TokenInstruction (Instruction a)
|
|
||||||
| TokenDirective (Directive a)
|
|
||||||
| TokenComment a T.Text Bool
|
|
||||||
-- ^ @'TokenComment' a text inline@ represents a comment.
|
|
||||||
-- @inline@ is true if the comment is on the same line as an instruction or a label.
|
|
||||||
deriving (Show, Functor)
|
|
||||||
|
|
||||||
instance Onion AsmToken where
|
|
||||||
peel (TokenLabel a) = peel a
|
|
||||||
peel (TokenInstruction a) = peel a
|
|
||||||
peel (TokenDirective a) = peel a
|
|
||||||
peel (TokenComment a _ _) = a
|
|
||||||
|
|
||||||
data Span = Span SourcePos SourcePos
|
|
||||||
|
|
||||||
instance Show Span where
|
|
||||||
show (Span start end) = "<" ++ showPos start ++ "-" ++ showPos end ++ ">"
|
|
||||||
where
|
|
||||||
showPos pos =
|
|
||||||
show (unPos $ sourceLine pos) ++ ":" ++ show (unPos $ sourceColumn pos)
|
|
||||||
|
|
||||||
type Phase1 s = [AsmToken s]
|
|
||||||
|
|
||||||
{- Parsing -}
|
|
||||||
|
|
||||||
type Parser = Parsec Void T.Text
|
|
||||||
|
|
||||||
inlineSpace :: Parser ()
|
|
||||||
inlineSpace = void $ takeWhileP (Just "space (no newline)") (\x -> isSpace x && x /= '\n')
|
|
||||||
|
|
||||||
inlineSpace1 :: Parser ()
|
|
||||||
inlineSpace1 = void $ takeWhile1P (Just "space (no newline)") (\x -> isSpace x && x /= '\n')
|
|
||||||
|
|
||||||
withSpan :: Parser a -> Parser (Span, a)
|
|
||||||
withSpan f = do
|
|
||||||
start <- getSourcePos
|
|
||||||
result <- f
|
|
||||||
stop <- getSourcePos
|
|
||||||
pure (Span start stop, result)
|
|
||||||
|
|
||||||
name :: Parser (Name Span)
|
|
||||||
name = fmap (uncurry Name) $ withSpan $ do
|
|
||||||
firstChar <- satisfy isLower <?> "lowercase character"
|
|
||||||
otherChars <- takeWhileP (Just "alphanumeric character or '_'") (\c -> isAlphaNum c || c == '_')
|
|
||||||
pure $ T.pack [firstChar] <> otherChars
|
|
||||||
|
|
||||||
number :: (Num a) => Parser a
|
|
||||||
number =
|
|
||||||
(chunk "0b" *> binary) <|>
|
|
||||||
(chunk "0o" *> octal) <|>
|
|
||||||
(chunk "0x" *> hexadecimal) <|>
|
|
||||||
decimal
|
|
||||||
|
|
||||||
signedNumber :: (Num a) => Parser a
|
|
||||||
signedNumber = signed (pure ()) number -- do not allow any space
|
|
||||||
|
|
||||||
address :: Parser (Address Span)
|
|
||||||
address =
|
|
||||||
fmap (uncurry AddressRelative) (withSpan $ between (char '[') (char ']') signedNumber) <|>
|
|
||||||
fmap (uncurry AddressAbsolute) (withSpan signedNumber)
|
|
||||||
|
|
||||||
labelWithOffset :: Parser (Location Span)
|
|
||||||
labelWithOffset = do
|
|
||||||
(completeSpan, (n, offsetSpan, offset)) <- withSpan $ do
|
|
||||||
n <- name
|
|
||||||
(offsetSpan, offset) <- withSpan $ between (char '[') (char ']') signedNumber
|
|
||||||
pure (n, offsetSpan, offset)
|
|
||||||
|
|
||||||
pure $ LocationLabelRel completeSpan n offsetSpan offset
|
|
||||||
|
|
||||||
location :: Parser (Location Span)
|
|
||||||
location =
|
|
||||||
(LocationAddress <$> address) <|> try labelWithOffset <|> (LocationLabel <$> name)
|
|
||||||
|
|
||||||
smallOpcode :: Parser (SmallOpcode Span)
|
|
||||||
smallOpcode = asum $ map parseOpcode [minBound..maxBound]
|
|
||||||
where
|
|
||||||
parseOpcode o = do
|
|
||||||
(s, _) <- withSpan $ chunk $ T.pack $ show o
|
|
||||||
pure $ SmallOpcode s o
|
|
||||||
|
|
||||||
largeOpcode :: Parser (LargeOpcode Span)
|
|
||||||
largeOpcode = asum $ map parseOpcode [minBound..maxBound]
|
|
||||||
where
|
|
||||||
parseOpcode o = do
|
|
||||||
(s, _) <- withSpan $ chunk $ T.pack $ show o
|
|
||||||
pure $ LargeOpcode s o
|
|
||||||
|
|
||||||
mimaWord :: Parser (MimaWord Span)
|
|
||||||
mimaWord =
|
|
||||||
(uncurry WordRaw <$> withSpan signedNumber) <|> (WordLocation <$> location)
|
|
||||||
|
|
||||||
smallValue :: Parser (SmallValue Span)
|
|
||||||
smallValue = uncurry SmallValue <$> withSpan signedNumber
|
|
||||||
|
|
||||||
instruction :: Parser (Instruction Span)
|
|
||||||
instruction = small <|> large
|
|
||||||
where
|
|
||||||
small = do
|
|
||||||
start <- getSourcePos
|
|
||||||
so <- smallOpcode
|
|
||||||
inlineSpace1
|
|
||||||
loc <- location
|
|
||||||
stop <- getSourcePos
|
|
||||||
pure $ SmallInstruction (Span start stop) so loc
|
|
||||||
large = do
|
|
||||||
start <- getSourcePos
|
|
||||||
lo <- largeOpcode
|
|
||||||
sv <- optionalAwareArgument lo
|
|
||||||
stop <- getSourcePos
|
|
||||||
pure $ LargeInstruction (Span start stop) lo sv
|
|
||||||
optionalAwareArgument (LargeOpcode _ code)
|
|
||||||
| Vm.argumentIsOptional code = optional (inlineSpace1 *> smallValue <?> "argument")
|
|
||||||
| otherwise = Just <$> (inlineSpace1 *> smallValue <?> "argument")
|
|
||||||
|
|
||||||
singleDirective
|
|
||||||
:: (Span -> Span -> a -> b Span)
|
|
||||||
-> T.Text
|
|
||||||
-> Parser a
|
|
||||||
-> Parser (b Span)
|
|
||||||
singleDirective f t p = do
|
|
||||||
(outerSpan, (nameSpan, a)) <- withSpan $ do
|
|
||||||
(nameSpan, _) <- withSpan $ chunk t
|
|
||||||
inlineSpace1
|
|
||||||
a <- p
|
|
||||||
pure (nameSpan, a)
|
|
||||||
pure $ f outerSpan nameSpan a
|
|
||||||
|
|
||||||
registerDirective :: Parser (RegisterDirective Span)
|
|
||||||
registerDirective =
|
|
||||||
singleDirective RegIar "IAR" location <|>
|
|
||||||
singleDirective RegAcc "ACC" mimaWord <|>
|
|
||||||
singleDirective RegRa "RA" location <|>
|
|
||||||
singleDirective RegSp "SP" location <|>
|
|
||||||
singleDirective RegFp "FP" location
|
|
||||||
|
|
||||||
directive :: Parser (Directive Span)
|
|
||||||
directive =
|
|
||||||
singleDirective Reg ".reg" registerDirective <|>
|
|
||||||
singleDirective Org ".org" address <|>
|
|
||||||
singleDirective Lit ".lit" mimaWord <|>
|
|
||||||
arr <|>
|
|
||||||
metaStart MetaStart ".meta-start" <|>
|
|
||||||
singleDirective MetaStop ".meta-stop" name <|>
|
|
||||||
metaStart Meta ".meta"
|
|
||||||
where
|
|
||||||
arr = do
|
|
||||||
(outerSpan, (regSpan, mimaWords)) <- withSpan $ do
|
|
||||||
(dirSpan, _) <- withSpan $ chunk ".arr"
|
|
||||||
inlineSpace1
|
|
||||||
mimaWords <- between (char '[') (char ']') $
|
|
||||||
sepBy1 mimaWord (char ',' *> inlineSpace)
|
|
||||||
pure (dirSpan, mimaWords)
|
|
||||||
pure $ Arr outerSpan regSpan mimaWords
|
|
||||||
|
|
||||||
metaStart f keyword = do
|
|
||||||
(outerSpan, (regSpan, metaName, jsonValue)) <- withSpan $ do
|
|
||||||
(dirSpan, _) <- withSpan $ chunk keyword
|
|
||||||
inlineSpace1
|
|
||||||
metaName <- name
|
|
||||||
inlineSpace1
|
|
||||||
|
|
||||||
(valueSpan, rawJsonValue) <- withSpan $ do
|
|
||||||
metaValueBS <- BS.fromStrict . T.encodeUtf8
|
|
||||||
<$> takeWhile1P (Just "json value") (/= '\n')
|
|
||||||
case A.eitherDecode metaValueBS of
|
|
||||||
Left msg -> fail msg
|
|
||||||
Right value -> pure value
|
|
||||||
|
|
||||||
pure (dirSpan, metaName, JsonValue valueSpan rawJsonValue)
|
|
||||||
pure $ f outerSpan regSpan metaName jsonValue
|
|
||||||
|
|
||||||
comment :: Bool -> Parser (AsmToken Span)
|
|
||||||
comment inline = fmap (\(s, text) -> TokenComment s text inline) $ withSpan $
|
|
||||||
char ';' *> takeWhileP (Just "comment") (/= '\n')
|
|
||||||
|
|
||||||
asmToken :: Parser (AsmToken Span)
|
|
||||||
asmToken = (TokenInstruction <$> instruction) <|> (TokenDirective <$> directive)
|
|
||||||
|
|
||||||
labels :: Parser [AsmToken Span]
|
|
||||||
labels = do
|
|
||||||
start <- optional label_
|
|
||||||
case start of
|
|
||||||
Nothing -> pure []
|
|
||||||
Just l -> do
|
|
||||||
ls <- many $ try $ inlineSpace1 *> label_
|
|
||||||
pure $ l : ls
|
|
||||||
where
|
|
||||||
label_ = (TokenLabel <$> name) <* char ':'
|
|
||||||
|
|
||||||
-- | Parses a single line consisting of zero or more tokens:
|
|
||||||
-- inlineSpace, zero or more labels, zero or more instructions/directives,
|
|
||||||
-- zero or more comments and a final newline or EOF.
|
|
||||||
lineParser :: Parser [AsmToken Span]
|
|
||||||
lineParser = do
|
|
||||||
inlineSpace
|
|
||||||
ls <- labels
|
|
||||||
t <- optional $ try $ do
|
|
||||||
unless (null ls) inlineSpace1
|
|
||||||
asmToken
|
|
||||||
c <- optional $ try $ do
|
|
||||||
let aloneOnLine = null ls && isNothing t
|
|
||||||
unless aloneOnLine inlineSpace1
|
|
||||||
comment $ not aloneOnLine
|
|
||||||
pure $ ls ++ toList t ++ toList c
|
|
||||||
|
|
||||||
parsePhase1 :: Parser (Phase1 Span)
|
|
||||||
parsePhase1 = mconcat <$> sepBy lineParser newline <* eof
|
|
||||||
|
|
||||||
{- Formatting -}
|
|
||||||
|
|
||||||
formatName :: Name a -> T.Text
|
|
||||||
formatName (Name _ text) = text
|
|
||||||
|
|
||||||
formatAddress :: Address a -> T.Text
|
|
||||||
formatAddress (AddressAbsolute _ addr) = toDec addr
|
|
||||||
formatAddress (AddressRelative _ rel)
|
|
||||||
| rel >= 0 = T.pack $ "+" ++ show rel
|
|
||||||
| otherwise = T.pack $ show rel
|
|
||||||
|
|
||||||
formatLocation :: Location a -> T.Text
|
|
||||||
formatLocation (LocationAddress addr) = formatAddress addr
|
|
||||||
formatLocation (LocationLabel l) = formatName l
|
|
||||||
formatLocation (LocationLabelRel _ l _ offset)
|
|
||||||
= formatName l <> "[" <> toDec offset <> "]"
|
|
||||||
|
|
||||||
formatSmallOpcode :: SmallOpcode a -> T.Text
|
|
||||||
formatSmallOpcode (SmallOpcode _ opcode) = T.pack $ show opcode
|
|
||||||
|
|
||||||
formatLargeOpcode :: LargeOpcode a -> T.Text
|
|
||||||
formatLargeOpcode (LargeOpcode _ opcode) = T.pack $ show opcode
|
|
||||||
|
|
||||||
formatMimaWord :: MimaWord a -> T.Text
|
|
||||||
formatMimaWord (WordRaw _ word) = toDec word
|
|
||||||
formatMimaWord (WordLocation loc) = formatLocation loc
|
|
||||||
|
|
||||||
formatSmallValue :: SmallValue a -> T.Text
|
|
||||||
formatSmallValue (SmallValue _ val) = toDec val
|
|
||||||
|
|
||||||
formatInstruction :: Instruction a -> T.Text
|
|
||||||
formatInstruction (SmallInstruction _ opcode loc) =
|
|
||||||
formatSmallOpcode opcode <> " " <> formatLocation loc
|
|
||||||
formatInstruction (LargeInstruction _ opcode Nothing) =
|
|
||||||
formatLargeOpcode opcode
|
|
||||||
formatInstruction (LargeInstruction _ opcode (Just val)) =
|
|
||||||
formatLargeOpcode opcode <> " " <> formatSmallValue val
|
|
||||||
|
|
||||||
formatRegisterDirective :: RegisterDirective a -> T.Text
|
|
||||||
formatRegisterDirective (RegIar _ _ loc) = "IAR " <> formatLocation loc
|
|
||||||
formatRegisterDirective (RegAcc _ _ word) = "ACC " <> formatMimaWord word
|
|
||||||
formatRegisterDirective (RegRa _ _ loc) = "RA " <> formatLocation loc
|
|
||||||
formatRegisterDirective (RegSp _ _ loc) = "SP " <> formatLocation loc
|
|
||||||
formatRegisterDirective (RegFp _ _ loc) = "FP " <> formatLocation loc
|
|
||||||
|
|
||||||
formatJsonValue :: JsonValue a -> T.Text
|
|
||||||
formatJsonValue (JsonValue _ val) = TL.toStrict $ A.encodeToLazyText val
|
|
||||||
|
|
||||||
formatDirective :: Directive a -> T.Text
|
|
||||||
formatDirective (Reg _ _ regDir) = ".reg " <> formatRegisterDirective regDir
|
|
||||||
formatDirective (Org _ _ addr) = ".org " <> formatAddress addr
|
|
||||||
formatDirective (Lit _ _ val) = ".lit " <> formatMimaWord val
|
|
||||||
formatDirective (Arr _ _ vals) =
|
|
||||||
".arr [" <> T.intercalate ", " (map formatMimaWord vals) <> "]"
|
|
||||||
formatDirective (Meta _ _ n val) =
|
|
||||||
".meta " <> formatName n <> " " <> formatJsonValue val
|
|
||||||
formatDirective (MetaStart _ _ n val) =
|
|
||||||
".meta-start " <> formatName n <> " " <> formatJsonValue val
|
|
||||||
formatDirective (MetaStop _ _ n) = ".meta-stop " <> formatName n
|
|
||||||
|
|
||||||
formatToken :: AsmToken a -> T.Text
|
|
||||||
formatToken (TokenLabel n) = formatName n <> ":"
|
|
||||||
formatToken (TokenInstruction ins) = " " <> formatInstruction ins
|
|
||||||
formatToken (TokenDirective dir) = formatDirective dir
|
|
||||||
formatToken (TokenComment _ text _) = ";" <> text
|
|
||||||
|
|
||||||
formatPhase1 :: Phase1 a -> T.Text
|
|
||||||
formatPhase1 (x:y@(TokenComment _ _ True):xs) = formatToken x <> " " <> formatPhase1 (y:xs)
|
|
||||||
formatPhase1 (x:xs) = formatToken x <> "\n" <> formatPhase1 xs
|
|
||||||
formatPhase1 [] = ""
|
|
||||||
|
|
|
||||||
81
src/Mima/Asm/Phase1/Format.hs
Normal file
81
src/Mima/Asm/Phase1/Format.hs
Normal file
|
|
@ -0,0 +1,81 @@
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
|
module Mima.Asm.Phase1.Format
|
||||||
|
( formatPhase1
|
||||||
|
) where
|
||||||
|
|
||||||
|
import qualified Data.Aeson.Text as A
|
||||||
|
import qualified Data.Text as T
|
||||||
|
import qualified Data.Text.Lazy as TL
|
||||||
|
|
||||||
|
import Mima.Asm.Phase1.Types
|
||||||
|
import Mima.Format
|
||||||
|
|
||||||
|
formatName :: Name a -> T.Text
|
||||||
|
formatName (Name _ text) = text
|
||||||
|
|
||||||
|
formatAddress :: Address a -> T.Text
|
||||||
|
formatAddress (AddressAbsolute _ addr) = toDec addr
|
||||||
|
formatAddress (AddressRelative _ rel)
|
||||||
|
| rel >= 0 = T.pack $ "+" ++ show rel
|
||||||
|
| otherwise = T.pack $ show rel
|
||||||
|
|
||||||
|
formatLocation :: Location a -> T.Text
|
||||||
|
formatLocation (LocationAddress addr) = formatAddress addr
|
||||||
|
formatLocation (LocationLabel l) = formatName l
|
||||||
|
formatLocation (LocationLabelRel _ l _ offset)
|
||||||
|
= formatName l <> "[" <> toDec offset <> "]"
|
||||||
|
|
||||||
|
formatSmallOpcode :: SmallOpcode a -> T.Text
|
||||||
|
formatSmallOpcode (SmallOpcode _ opcode) = T.pack $ show opcode
|
||||||
|
|
||||||
|
formatLargeOpcode :: LargeOpcode a -> T.Text
|
||||||
|
formatLargeOpcode (LargeOpcode _ opcode) = T.pack $ show opcode
|
||||||
|
|
||||||
|
formatMimaWord :: MimaWord a -> T.Text
|
||||||
|
formatMimaWord (WordRaw _ word) = toDec word
|
||||||
|
formatMimaWord (WordLocation loc) = formatLocation loc
|
||||||
|
|
||||||
|
formatSmallValue :: SmallValue a -> T.Text
|
||||||
|
formatSmallValue (SmallValue _ val) = toDec val
|
||||||
|
|
||||||
|
formatInstruction :: Instruction a -> T.Text
|
||||||
|
formatInstruction (SmallInstruction _ opcode loc) =
|
||||||
|
formatSmallOpcode opcode <> " " <> formatLocation loc
|
||||||
|
formatInstruction (LargeInstruction _ opcode Nothing) =
|
||||||
|
formatLargeOpcode opcode
|
||||||
|
formatInstruction (LargeInstruction _ opcode (Just val)) =
|
||||||
|
formatLargeOpcode opcode <> " " <> formatSmallValue val
|
||||||
|
|
||||||
|
formatRegisterDirective :: RegisterDirective a -> T.Text
|
||||||
|
formatRegisterDirective (RegIar _ _ loc) = "IAR " <> formatLocation loc
|
||||||
|
formatRegisterDirective (RegAcc _ _ word) = "ACC " <> formatMimaWord word
|
||||||
|
formatRegisterDirective (RegRa _ _ loc) = "RA " <> formatLocation loc
|
||||||
|
formatRegisterDirective (RegSp _ _ loc) = "SP " <> formatLocation loc
|
||||||
|
formatRegisterDirective (RegFp _ _ loc) = "FP " <> formatLocation loc
|
||||||
|
|
||||||
|
formatJsonValue :: JsonValue a -> T.Text
|
||||||
|
formatJsonValue (JsonValue _ val) = TL.toStrict $ A.encodeToLazyText val
|
||||||
|
|
||||||
|
formatDirective :: Directive a -> T.Text
|
||||||
|
formatDirective (Reg _ _ regDir) = ".reg " <> formatRegisterDirective regDir
|
||||||
|
formatDirective (Org _ _ addr) = ".org " <> formatAddress addr
|
||||||
|
formatDirective (Lit _ _ val) = ".lit " <> formatMimaWord val
|
||||||
|
formatDirective (Arr _ _ vals) =
|
||||||
|
".arr [" <> T.intercalate ", " (map formatMimaWord vals) <> "]"
|
||||||
|
formatDirective (Meta _ _ n val) =
|
||||||
|
".meta " <> formatName n <> " " <> formatJsonValue val
|
||||||
|
formatDirective (MetaStart _ _ n val) =
|
||||||
|
".meta-start " <> formatName n <> " " <> formatJsonValue val
|
||||||
|
formatDirective (MetaStop _ _ n) = ".meta-stop " <> formatName n
|
||||||
|
|
||||||
|
formatToken :: AsmToken a -> T.Text
|
||||||
|
formatToken (TokenLabel n) = formatName n <> ":"
|
||||||
|
formatToken (TokenInstruction ins) = " " <> formatInstruction ins
|
||||||
|
formatToken (TokenDirective dir) = formatDirective dir
|
||||||
|
formatToken (TokenComment _ text _) = ";" <> text
|
||||||
|
|
||||||
|
formatPhase1 :: Phase1 a -> T.Text
|
||||||
|
formatPhase1 (x:y@(TokenComment _ _ True):xs) = formatToken x <> " " <> formatPhase1 (y:xs)
|
||||||
|
formatPhase1 (x:xs) = formatToken x <> "\n" <> formatPhase1 xs
|
||||||
|
formatPhase1 [] = ""
|
||||||
215
src/Mima/Asm/Phase1/Parse.hs
Normal file
215
src/Mima/Asm/Phase1/Parse.hs
Normal file
|
|
@ -0,0 +1,215 @@
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
|
module Mima.Asm.Phase1.Parse
|
||||||
|
( Span(..)
|
||||||
|
, Parser
|
||||||
|
, parsePhase1
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Control.Monad
|
||||||
|
import qualified Data.Aeson as A
|
||||||
|
import qualified Data.ByteString.Lazy as BS
|
||||||
|
import Data.Char
|
||||||
|
import Data.Foldable
|
||||||
|
import Data.Maybe
|
||||||
|
import qualified Data.Text as T
|
||||||
|
import qualified Data.Text.Encoding as T
|
||||||
|
import Data.Void
|
||||||
|
import Text.Megaparsec
|
||||||
|
import Text.Megaparsec.Char
|
||||||
|
import Text.Megaparsec.Char.Lexer hiding (space)
|
||||||
|
|
||||||
|
import Mima.Asm.Phase1.Types
|
||||||
|
import qualified Mima.Vm.Instruction as Vm
|
||||||
|
|
||||||
|
data Span = Span SourcePos SourcePos
|
||||||
|
|
||||||
|
instance Show Span where
|
||||||
|
show (Span start end) = "<" ++ showPos start ++ "-" ++ showPos end ++ ">"
|
||||||
|
where
|
||||||
|
showPos pos =
|
||||||
|
show (unPos $ sourceLine pos) ++ ":" ++ show (unPos $ sourceColumn pos)
|
||||||
|
|
||||||
|
type Parser = Parsec Void T.Text
|
||||||
|
|
||||||
|
inlineSpace :: Parser ()
|
||||||
|
inlineSpace = void $ takeWhileP (Just "space (no newline)") (\x -> isSpace x && x /= '\n')
|
||||||
|
|
||||||
|
inlineSpace1 :: Parser ()
|
||||||
|
inlineSpace1 = void $ takeWhile1P (Just "space (no newline)") (\x -> isSpace x && x /= '\n')
|
||||||
|
|
||||||
|
withSpan :: Parser a -> Parser (Span, a)
|
||||||
|
withSpan f = do
|
||||||
|
start <- getSourcePos
|
||||||
|
result <- f
|
||||||
|
stop <- getSourcePos
|
||||||
|
pure (Span start stop, result)
|
||||||
|
|
||||||
|
name :: Parser (Name Span)
|
||||||
|
name = fmap (uncurry Name) $ withSpan $ do
|
||||||
|
firstChar <- satisfy isLower <?> "lowercase character"
|
||||||
|
otherChars <- takeWhileP (Just "alphanumeric character or '_'") (\c -> isAlphaNum c || c == '_')
|
||||||
|
pure $ T.pack [firstChar] <> otherChars
|
||||||
|
|
||||||
|
number :: (Num a) => Parser a
|
||||||
|
number =
|
||||||
|
(chunk "0b" *> binary) <|>
|
||||||
|
(chunk "0o" *> octal) <|>
|
||||||
|
(chunk "0x" *> hexadecimal) <|>
|
||||||
|
decimal
|
||||||
|
|
||||||
|
signedNumber :: (Num a) => Parser a
|
||||||
|
signedNumber = signed (pure ()) number -- do not allow any space
|
||||||
|
|
||||||
|
address :: Parser (Address Span)
|
||||||
|
address =
|
||||||
|
fmap (uncurry AddressRelative) (withSpan $ between (char '[') (char ']') signedNumber) <|>
|
||||||
|
fmap (uncurry AddressAbsolute) (withSpan signedNumber)
|
||||||
|
|
||||||
|
labelWithOffset :: Parser (Location Span)
|
||||||
|
labelWithOffset = do
|
||||||
|
(completeSpan, (n, offsetSpan, offset)) <- withSpan $ do
|
||||||
|
n <- name
|
||||||
|
(offsetSpan, offset) <- withSpan $ between (char '[') (char ']') signedNumber
|
||||||
|
pure (n, offsetSpan, offset)
|
||||||
|
|
||||||
|
pure $ LocationLabelRel completeSpan n offsetSpan offset
|
||||||
|
|
||||||
|
location :: Parser (Location Span)
|
||||||
|
location =
|
||||||
|
(LocationAddress <$> address) <|> try labelWithOffset <|> (LocationLabel <$> name)
|
||||||
|
|
||||||
|
smallOpcode :: Parser (SmallOpcode Span)
|
||||||
|
smallOpcode = asum $ map parseOpcode [minBound..maxBound]
|
||||||
|
where
|
||||||
|
parseOpcode o = do
|
||||||
|
(s, _) <- withSpan $ chunk $ T.pack $ show o
|
||||||
|
pure $ SmallOpcode s o
|
||||||
|
|
||||||
|
largeOpcode :: Parser (LargeOpcode Span)
|
||||||
|
largeOpcode = asum $ map parseOpcode [minBound..maxBound]
|
||||||
|
where
|
||||||
|
parseOpcode o = do
|
||||||
|
(s, _) <- withSpan $ chunk $ T.pack $ show o
|
||||||
|
pure $ LargeOpcode s o
|
||||||
|
|
||||||
|
mimaWord :: Parser (MimaWord Span)
|
||||||
|
mimaWord =
|
||||||
|
(uncurry WordRaw <$> withSpan signedNumber) <|> (WordLocation <$> location)
|
||||||
|
|
||||||
|
smallValue :: Parser (SmallValue Span)
|
||||||
|
smallValue = uncurry SmallValue <$> withSpan signedNumber
|
||||||
|
|
||||||
|
instruction :: Parser (Instruction Span)
|
||||||
|
instruction = small <|> large
|
||||||
|
where
|
||||||
|
small = do
|
||||||
|
start <- getSourcePos
|
||||||
|
so <- smallOpcode
|
||||||
|
inlineSpace1
|
||||||
|
loc <- location
|
||||||
|
stop <- getSourcePos
|
||||||
|
pure $ SmallInstruction (Span start stop) so loc
|
||||||
|
large = do
|
||||||
|
start <- getSourcePos
|
||||||
|
lo <- largeOpcode
|
||||||
|
sv <- optionalAwareArgument lo
|
||||||
|
stop <- getSourcePos
|
||||||
|
pure $ LargeInstruction (Span start stop) lo sv
|
||||||
|
optionalAwareArgument (LargeOpcode _ code)
|
||||||
|
| Vm.argumentIsOptional code = optional (inlineSpace1 *> smallValue <?> "argument")
|
||||||
|
| otherwise = Just <$> (inlineSpace1 *> smallValue <?> "argument")
|
||||||
|
|
||||||
|
singleDirective
|
||||||
|
:: (Span -> Span -> a -> b Span)
|
||||||
|
-> T.Text
|
||||||
|
-> Parser a
|
||||||
|
-> Parser (b Span)
|
||||||
|
singleDirective f t p = do
|
||||||
|
(outerSpan, (nameSpan, a)) <- withSpan $ do
|
||||||
|
(nameSpan, _) <- withSpan $ chunk t
|
||||||
|
inlineSpace1
|
||||||
|
a <- p
|
||||||
|
pure (nameSpan, a)
|
||||||
|
pure $ f outerSpan nameSpan a
|
||||||
|
|
||||||
|
registerDirective :: Parser (RegisterDirective Span)
|
||||||
|
registerDirective =
|
||||||
|
singleDirective RegIar "IAR" location <|>
|
||||||
|
singleDirective RegAcc "ACC" mimaWord <|>
|
||||||
|
singleDirective RegRa "RA" location <|>
|
||||||
|
singleDirective RegSp "SP" location <|>
|
||||||
|
singleDirective RegFp "FP" location
|
||||||
|
|
||||||
|
directive :: Parser (Directive Span)
|
||||||
|
directive =
|
||||||
|
singleDirective Reg ".reg" registerDirective <|>
|
||||||
|
singleDirective Org ".org" address <|>
|
||||||
|
singleDirective Lit ".lit" mimaWord <|>
|
||||||
|
arr <|>
|
||||||
|
metaStart MetaStart ".meta-start" <|>
|
||||||
|
singleDirective MetaStop ".meta-stop" name <|>
|
||||||
|
metaStart Meta ".meta"
|
||||||
|
where
|
||||||
|
arr = do
|
||||||
|
(outerSpan, (regSpan, mimaWords)) <- withSpan $ do
|
||||||
|
(dirSpan, _) <- withSpan $ chunk ".arr"
|
||||||
|
inlineSpace1
|
||||||
|
mimaWords <- between (char '[') (char ']') $
|
||||||
|
sepBy1 mimaWord (char ',' *> inlineSpace)
|
||||||
|
pure (dirSpan, mimaWords)
|
||||||
|
pure $ Arr outerSpan regSpan mimaWords
|
||||||
|
|
||||||
|
metaStart f keyword = do
|
||||||
|
(outerSpan, (regSpan, metaName, jsonValue)) <- withSpan $ do
|
||||||
|
(dirSpan, _) <- withSpan $ chunk keyword
|
||||||
|
inlineSpace1
|
||||||
|
metaName <- name
|
||||||
|
inlineSpace1
|
||||||
|
|
||||||
|
(valueSpan, rawJsonValue) <- withSpan $ do
|
||||||
|
metaValueBS <- BS.fromStrict . T.encodeUtf8
|
||||||
|
<$> takeWhile1P (Just "json value") (/= '\n')
|
||||||
|
case A.eitherDecode metaValueBS of
|
||||||
|
Left msg -> fail msg
|
||||||
|
Right value -> pure value
|
||||||
|
|
||||||
|
pure (dirSpan, metaName, JsonValue valueSpan rawJsonValue)
|
||||||
|
pure $ f outerSpan regSpan metaName jsonValue
|
||||||
|
|
||||||
|
comment :: Bool -> Parser (AsmToken Span)
|
||||||
|
comment inline = fmap (\(s, text) -> TokenComment s text inline) $ withSpan $
|
||||||
|
char ';' *> takeWhileP (Just "comment") (/= '\n')
|
||||||
|
|
||||||
|
asmToken :: Parser (AsmToken Span)
|
||||||
|
asmToken = (TokenInstruction <$> instruction) <|> (TokenDirective <$> directive)
|
||||||
|
|
||||||
|
labels :: Parser [AsmToken Span]
|
||||||
|
labels = do
|
||||||
|
start <- optional label_
|
||||||
|
case start of
|
||||||
|
Nothing -> pure []
|
||||||
|
Just l -> do
|
||||||
|
ls <- many $ try $ inlineSpace1 *> label_
|
||||||
|
pure $ l : ls
|
||||||
|
where
|
||||||
|
label_ = (TokenLabel <$> name) <* char ':'
|
||||||
|
|
||||||
|
-- | Parses a single line consisting of zero or more tokens:
|
||||||
|
-- inlineSpace, zero or more labels, zero or more instructions/directives,
|
||||||
|
-- zero or more comments and a final newline or EOF.
|
||||||
|
lineParser :: Parser [AsmToken Span]
|
||||||
|
lineParser = do
|
||||||
|
inlineSpace
|
||||||
|
ls <- labels
|
||||||
|
t <- optional $ try $ do
|
||||||
|
unless (null ls) inlineSpace1
|
||||||
|
asmToken
|
||||||
|
c <- optional $ try $ do
|
||||||
|
let aloneOnLine = null ls && isNothing t
|
||||||
|
unless aloneOnLine inlineSpace1
|
||||||
|
comment $ not aloneOnLine
|
||||||
|
pure $ ls ++ toList t ++ toList c
|
||||||
|
|
||||||
|
parsePhase1 :: Parser (Phase1 Span)
|
||||||
|
parsePhase1 = mconcat <$> sepBy lineParser newline <* eof
|
||||||
168
src/Mima/Asm/Phase1/Types.hs
Normal file
168
src/Mima/Asm/Phase1/Types.hs
Normal file
|
|
@ -0,0 +1,168 @@
|
||||||
|
{-# LANGUAGE DeriveFunctor #-}
|
||||||
|
|
||||||
|
module Mima.Asm.Phase1.Types
|
||||||
|
( Name(..)
|
||||||
|
, Address(..)
|
||||||
|
, Location(..)
|
||||||
|
, SmallOpcode(..)
|
||||||
|
, LargeOpcode(..)
|
||||||
|
, MimaWord(..)
|
||||||
|
, SmallValue(..)
|
||||||
|
, Instruction(..)
|
||||||
|
, RegisterDirective(..)
|
||||||
|
, JsonValue(..)
|
||||||
|
, Directive(..)
|
||||||
|
, AsmToken(..)
|
||||||
|
, Phase1
|
||||||
|
) where
|
||||||
|
|
||||||
|
import qualified Data.Aeson as A
|
||||||
|
import qualified Data.Text as T
|
||||||
|
|
||||||
|
import Mima.Asm.Types
|
||||||
|
import qualified Mima.Vm.Instruction as Vm
|
||||||
|
|
||||||
|
{-
|
||||||
|
<value> := <word> | <address>
|
||||||
|
<address> := <absolute address> | <relative address> | <label>
|
||||||
|
<name> := [a-z]([a-z0-9_]*)
|
||||||
|
<label> := <name>:
|
||||||
|
<instruction> := as usual
|
||||||
|
|
||||||
|
.reg ACC <value>
|
||||||
|
.reg <other register> <address>
|
||||||
|
|
||||||
|
.org (<absolute address> | <positive relative address> | <negative address>) ???
|
||||||
|
.lit <value>
|
||||||
|
.arr [<value>]
|
||||||
|
|
||||||
|
.meta <name> <json value>
|
||||||
|
.meta-start <name> [<json value>]
|
||||||
|
.meta-stop <name>
|
||||||
|
-}
|
||||||
|
|
||||||
|
{- Types -}
|
||||||
|
|
||||||
|
data Name a = Name a T.Text
|
||||||
|
deriving (Show, Functor)
|
||||||
|
|
||||||
|
instance Onion Name where
|
||||||
|
peel (Name a _) = a
|
||||||
|
|
||||||
|
data Address a
|
||||||
|
= AddressAbsolute a Integer
|
||||||
|
| AddressRelative a Integer
|
||||||
|
deriving (Show, Functor)
|
||||||
|
|
||||||
|
instance Onion Address where
|
||||||
|
peel (AddressAbsolute a _) = a
|
||||||
|
peel (AddressRelative a _) = a
|
||||||
|
|
||||||
|
data Location a
|
||||||
|
= LocationAddress (Address a)
|
||||||
|
| LocationLabel (Name a)
|
||||||
|
| LocationLabelRel a (Name a) a Integer
|
||||||
|
-- ^ @Lo LocationLabelRel completeSpan name offsetSpan offset@
|
||||||
|
deriving (Show, Functor)
|
||||||
|
|
||||||
|
instance Onion Location where
|
||||||
|
peel (LocationAddress a) = peel a
|
||||||
|
peel (LocationLabel a) = peel a
|
||||||
|
peel (LocationLabelRel a _ _ _) = a
|
||||||
|
|
||||||
|
data SmallOpcode a = SmallOpcode a Vm.SmallOpcode
|
||||||
|
deriving (Show, Functor)
|
||||||
|
|
||||||
|
instance Onion SmallOpcode where
|
||||||
|
peel (SmallOpcode a _) = a
|
||||||
|
|
||||||
|
data LargeOpcode a = LargeOpcode a Vm.LargeOpcode
|
||||||
|
deriving (Show, Functor)
|
||||||
|
|
||||||
|
instance Onion LargeOpcode where
|
||||||
|
peel (LargeOpcode a _) = a
|
||||||
|
|
||||||
|
data MimaWord a
|
||||||
|
= WordRaw a Integer
|
||||||
|
| WordLocation (Location a)
|
||||||
|
deriving (Show, Functor)
|
||||||
|
|
||||||
|
instance Onion MimaWord where
|
||||||
|
peel (WordRaw a _) = a
|
||||||
|
peel (WordLocation a) = peel a
|
||||||
|
|
||||||
|
data SmallValue a = SmallValue a Integer
|
||||||
|
deriving (Show, Functor)
|
||||||
|
|
||||||
|
instance Onion SmallValue where
|
||||||
|
peel (SmallValue a _) = a
|
||||||
|
|
||||||
|
data Instruction a
|
||||||
|
= SmallInstruction a (SmallOpcode a) (Location a)
|
||||||
|
| LargeInstruction a (LargeOpcode a) (Maybe (SmallValue a))
|
||||||
|
deriving (Show, Functor)
|
||||||
|
|
||||||
|
instance Onion Instruction where
|
||||||
|
peel (SmallInstruction a _ _) = a
|
||||||
|
peel (LargeInstruction a _ _) = a
|
||||||
|
|
||||||
|
-- | The first @a@ parameter represents the span of the whole thing. The second
|
||||||
|
-- @a@ parameter represents the span of the directive literal (e. g. @.org@).
|
||||||
|
data RegisterDirective a
|
||||||
|
= RegIar a a (Location a)
|
||||||
|
| RegAcc a a (MimaWord a)
|
||||||
|
| RegRa a a (Location a)
|
||||||
|
| RegSp a a (Location a)
|
||||||
|
| RegFp a a (Location a)
|
||||||
|
deriving (Show, Functor)
|
||||||
|
|
||||||
|
instance Onion RegisterDirective where
|
||||||
|
peel (RegIar a _ _) = a
|
||||||
|
peel (RegAcc a _ _) = a
|
||||||
|
peel (RegRa a _ _) = a
|
||||||
|
peel (RegSp a _ _) = a
|
||||||
|
peel (RegFp a _ _) = a
|
||||||
|
|
||||||
|
data JsonValue a = JsonValue a A.Value
|
||||||
|
deriving (Show, Functor)
|
||||||
|
|
||||||
|
instance Onion JsonValue where
|
||||||
|
peel (JsonValue a _) = a
|
||||||
|
|
||||||
|
-- | The first @a@ parameter represents the span of the whole thing. The second
|
||||||
|
-- @a@ parameter represents the span of the directive literal (e. g. @.org@).
|
||||||
|
data Directive a
|
||||||
|
= Reg a a (RegisterDirective a)
|
||||||
|
| Org a a (Address a)
|
||||||
|
| Lit a a (MimaWord a)
|
||||||
|
| Arr a a [MimaWord a]
|
||||||
|
| Meta a a (Name a) (JsonValue a)
|
||||||
|
| MetaStart a a (Name a) (JsonValue a)
|
||||||
|
| MetaStop a a (Name a)
|
||||||
|
deriving (Show, Functor)
|
||||||
|
|
||||||
|
instance Onion Directive where
|
||||||
|
peel (Reg a _ _) = a
|
||||||
|
peel (Org a _ _) = a
|
||||||
|
peel (Lit a _ _) = a
|
||||||
|
peel (Arr a _ _) = a
|
||||||
|
peel (Meta a _ _ _) = a
|
||||||
|
peel (MetaStart a _ _ _) = a
|
||||||
|
peel (MetaStop a _ _) = a
|
||||||
|
|
||||||
|
data AsmToken a
|
||||||
|
= TokenLabel (Name a)
|
||||||
|
| TokenInstruction (Instruction a)
|
||||||
|
| TokenDirective (Directive a)
|
||||||
|
| TokenComment a T.Text Bool
|
||||||
|
-- ^ @'TokenComment' a text inline@ represents a comment.
|
||||||
|
-- @inline@ is true if the comment is on the same line as an instruction or a label.
|
||||||
|
deriving (Show, Functor)
|
||||||
|
|
||||||
|
instance Onion AsmToken where
|
||||||
|
peel (TokenLabel a) = peel a
|
||||||
|
peel (TokenInstruction a) = peel a
|
||||||
|
peel (TokenDirective a) = peel a
|
||||||
|
peel (TokenComment a _ _) = a
|
||||||
|
|
||||||
|
type Phase1 s = [AsmToken s]
|
||||||
|
|
@ -1,4 +1,4 @@
|
||||||
{-# LANGUAGE DataKinds #-}
|
{-# LANGUAGE DataKinds #-}
|
||||||
|
|
||||||
module Mima.Asm.Phase2.Subphase1
|
module Mima.Asm.Phase2.Subphase1
|
||||||
( subphase1
|
( subphase1
|
||||||
|
|
@ -11,7 +11,7 @@ import Data.Foldable
|
||||||
import qualified Data.Map.Strict as Map
|
import qualified Data.Map.Strict as Map
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
|
|
||||||
import qualified Mima.Asm.Phase1 as P1
|
import qualified Mima.Asm.Phase1.Types as P1
|
||||||
import Mima.Asm.Phase2.Types
|
import Mima.Asm.Phase2.Types
|
||||||
import Mima.Asm.Phase2.Util
|
import Mima.Asm.Phase2.Util
|
||||||
import Mima.Asm.Types
|
import Mima.Asm.Types
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue