module Ast.Parser.Asm where

import qualified Ast.Parser.Utils as PU
import qualified Ast.Types as AT
import qualified Data.Maybe as DM
import qualified Text.Megaparsec as M
import qualified Text.Megaparsec.Char as MC

-- | Parses an inline assembly expression.
-- Takes a `PU.Parser AT.Expr` for expressions and a `PU.Parser AT.Type` for types.
-- Returns an `AT.AsmExpr` containing:
--   * The assembly code
--   * The assembly constraints
--   * A list of expression arguments
--   * A list of parameter types
--   * A return type
--   * Side-effect flags
--   * Stack alignment flag
--   * An assembly dialect
parseAsm :: PU.Parser AT.Expr -> PU.Parser AT.Type -> PU.Parser AT.AsmExpr
parseAsm :: Parser Expr -> Parser Type -> Parser AsmExpr
parseAsm Parser Expr
ap Parser Type
tp = ParsecT ParseErrorCustom String (StateT ParserState IO) String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
-> Parser AsmExpr
-> Parser AsmExpr
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
M.between (String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
PU.symbol String
"{") (String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
PU.symbol String
"}") (Parser AsmExpr -> Parser AsmExpr)
-> Parser AsmExpr -> Parser AsmExpr
forall a b. (a -> b) -> a -> b
$ do
  String
code <- String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
PU.symbol String
"code ->" ParsecT ParseErrorCustom String (StateT ParserState IO) String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
forall a b.
ParsecT ParseErrorCustom String (StateT ParserState IO) a
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT ParseErrorCustom String (StateT ParserState IO) String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
forall a. Parser a -> Parser a
PU.lexeme ParsecT ParseErrorCustom String (StateT ParserState IO) String
anyString
  AsmConstraint
constraints <- String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
PU.symbol String
"constraints ->" ParsecT ParseErrorCustom String (StateT ParserState IO) String
-> ParsecT
     ParseErrorCustom String (StateT ParserState IO) AsmConstraint
-> ParsecT
     ParseErrorCustom String (StateT ParserState IO) AsmConstraint
forall a b.
ParsecT ParseErrorCustom String (StateT ParserState IO) a
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT
  ParseErrorCustom String (StateT ParserState IO) AsmConstraint
-> ParsecT
     ParseErrorCustom String (StateT ParserState IO) AsmConstraint
forall a. Parser a -> Parser a
PU.lexeme ParsecT
  ParseErrorCustom String (StateT ParserState IO) AsmConstraint
parseAsmConstraint
  [Expr]
args <- String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
PU.symbol String
"args ->" ParsecT ParseErrorCustom String (StateT ParserState IO) String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) [Expr]
-> ParsecT ParseErrorCustom String (StateT ParserState IO) [Expr]
forall a b.
ParsecT ParseErrorCustom String (StateT ParserState IO) a
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT ParseErrorCustom String (StateT ParserState IO) String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) [Expr]
-> ParsecT ParseErrorCustom String (StateT ParserState IO) [Expr]
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
M.between (String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
PU.symbol String
"(") (String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
PU.symbol String
")") (Parser Expr
-> ParsecT ParseErrorCustom String (StateT ParserState IO) [Expr]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
M.many Parser Expr
ap)
  [Type]
parameters <- String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
PU.symbol String
"parameters ->" ParsecT ParseErrorCustom String (StateT ParserState IO) String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) [Type]
-> ParsecT ParseErrorCustom String (StateT ParserState IO) [Type]
forall a b.
ParsecT ParseErrorCustom String (StateT ParserState IO) a
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Type
-> ParsecT ParseErrorCustom String (StateT ParserState IO) [Type]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
M.some (Parser Type -> Parser Type
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
M.try Parser Type
tp)
  Type
returnType <- String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
PU.symbol String
"return_type ->" ParsecT ParseErrorCustom String (StateT ParserState IO) String
-> Parser Type -> Parser Type
forall a b.
ParsecT ParseErrorCustom String (StateT ParserState IO) a
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Type -> Parser Type
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
M.try Parser Type
tp
  Bool
sideEffects <- String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
PU.symbol String
"side_effects ->" ParsecT ParseErrorCustom String (StateT ParserState IO) String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) Bool
-> ParsecT ParseErrorCustom String (StateT ParserState IO) Bool
forall a b.
ParsecT ParseErrorCustom String (StateT ParserState IO) a
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT ParseErrorCustom String (StateT ParserState IO) Bool
-> ParsecT ParseErrorCustom String (StateT ParserState IO) Bool
forall a. Parser a -> Parser a
PU.lexeme ParsecT ParseErrorCustom String (StateT ParserState IO) Bool
PU.parseBool
  Bool
alignStack <- String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
PU.symbol String
"align_stack ->" ParsecT ParseErrorCustom String (StateT ParserState IO) String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) Bool
-> ParsecT ParseErrorCustom String (StateT ParserState IO) Bool
forall a b.
ParsecT ParseErrorCustom String (StateT ParserState IO) a
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT ParseErrorCustom String (StateT ParserState IO) Bool
-> ParsecT ParseErrorCustom String (StateT ParserState IO) Bool
forall a. Parser a -> Parser a
PU.lexeme ParsecT ParseErrorCustom String (StateT ParserState IO) Bool
PU.parseBool
  AsmDialect
dialect <- String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
PU.symbol String
"dialect ->" ParsecT ParseErrorCustom String (StateT ParserState IO) String
-> ParsecT
     ParseErrorCustom String (StateT ParserState IO) AsmDialect
-> ParsecT
     ParseErrorCustom String (StateT ParserState IO) AsmDialect
forall a b.
ParsecT ParseErrorCustom String (StateT ParserState IO) a
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT ParseErrorCustom String (StateT ParserState IO) AsmDialect
parseAsmDialect
  AsmExpr -> Parser AsmExpr
forall a.
a -> ParsecT ParseErrorCustom String (StateT ParserState IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (AsmExpr -> Parser AsmExpr) -> AsmExpr -> Parser AsmExpr
forall a b. (a -> b) -> a -> b
$ String
-> AsmConstraint
-> [Expr]
-> [Type]
-> Type
-> Bool
-> Bool
-> AsmDialect
-> AsmExpr
AT.AsmExpr String
code AsmConstraint
constraints [Expr]
args [Type]
parameters Type
returnType Bool
sideEffects Bool
alignStack AsmDialect
dialect

-- | Parses an assembly constraint string, which may include
-- an optional output constraint and zero or more input constraints.
-- Returns an `AT.AsmConstraint` containing an output constraint (if present)
-- and a list of input constraints.
parseAsmConstraint :: PU.Parser AT.AsmConstraint
parseAsmConstraint :: ParsecT
  ParseErrorCustom String (StateT ParserState IO) AsmConstraint
parseAsmConstraint = ParsecT ParseErrorCustom String (StateT ParserState IO) Char
-> ParsecT ParseErrorCustom String (StateT ParserState IO) Char
-> ParsecT
     ParseErrorCustom String (StateT ParserState IO) AsmConstraint
-> ParsecT
     ParseErrorCustom String (StateT ParserState IO) AsmConstraint
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
M.between (Token String
-> ParsecT
     ParseErrorCustom String (StateT ParserState IO) (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
MC.char Char
Token String
'"') (Token String
-> ParsecT
     ParseErrorCustom String (StateT ParserState IO) (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
MC.char Char
Token String
'"') (ParsecT
   ParseErrorCustom String (StateT ParserState IO) AsmConstraint
 -> ParsecT
      ParseErrorCustom String (StateT ParserState IO) AsmConstraint)
-> ParsecT
     ParseErrorCustom String (StateT ParserState IO) AsmConstraint
-> ParsecT
     ParseErrorCustom String (StateT ParserState IO) AsmConstraint
forall a b. (a -> b) -> a -> b
$ do
  Maybe String
output <- ParsecT ParseErrorCustom String (StateT ParserState IO) String
-> ParsecT
     ParseErrorCustom String (StateT ParserState IO) (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
M.optional ParsecT ParseErrorCustom String (StateT ParserState IO) String
parseConstraintOutput
  Maybe [String]
inputs <- ParsecT ParseErrorCustom String (StateT ParserState IO) [String]
-> ParsecT
     ParseErrorCustom String (StateT ParserState IO) (Maybe [String])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
M.optional (ParsecT ParseErrorCustom String (StateT ParserState IO) [String]
 -> ParsecT
      ParseErrorCustom String (StateT ParserState IO) (Maybe [String]))
-> ParsecT ParseErrorCustom String (StateT ParserState IO) [String]
-> ParsecT
     ParseErrorCustom String (StateT ParserState IO) (Maybe [String])
forall a b. (a -> b) -> a -> b
$ ParsecT
  ParseErrorCustom String (StateT ParserState IO) (Tokens String)
sep ParsecT
  ParseErrorCustom String (StateT ParserState IO) (Tokens String)
-> ParsecT ParseErrorCustom String (StateT ParserState IO) [String]
-> ParsecT ParseErrorCustom String (StateT ParserState IO) [String]
forall a b.
ParsecT ParseErrorCustom String (StateT ParserState IO) a
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT ParseErrorCustom String (StateT ParserState IO) String
-> ParsecT
     ParseErrorCustom String (StateT ParserState IO) (Tokens String)
-> ParsecT ParseErrorCustom String (StateT ParserState IO) [String]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
M.sepBy ParsecT ParseErrorCustom String (StateT ParserState IO) String
parseConstraintInput ParsecT
  ParseErrorCustom String (StateT ParserState IO) (Tokens String)
sep
  AsmConstraint
-> ParsecT
     ParseErrorCustom String (StateT ParserState IO) AsmConstraint
forall a.
a -> ParsecT ParseErrorCustom String (StateT ParserState IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (AsmConstraint
 -> ParsecT
      ParseErrorCustom String (StateT ParserState IO) AsmConstraint)
-> AsmConstraint
-> ParsecT
     ParseErrorCustom String (StateT ParserState IO) AsmConstraint
forall a b. (a -> b) -> a -> b
$ String -> [String] -> AsmConstraint
AT.AsmConstraint (String -> Maybe String -> String
forall a. a -> Maybe a -> a
DM.fromMaybe String
"" Maybe String
output) ([String] -> AsmConstraint) -> [String] -> AsmConstraint
forall a b. (a -> b) -> a -> b
$ [String] -> Maybe [String] -> [String]
forall a. a -> Maybe a -> a
DM.fromMaybe [] Maybe [String]
inputs
  where
    sep :: ParsecT
  ParseErrorCustom String (StateT ParserState IO) (Tokens String)
sep = Tokens String
-> ParsecT
     ParseErrorCustom String (StateT ParserState IO) (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MC.string String
Tokens String
","

-- | Parses a single assembly input constraint (`"r"` or `"m"`).
-- Returns the parsed `String` representing the constraint.
parseConstraintInput :: PU.Parser String
parseConstraintInput :: ParsecT ParseErrorCustom String (StateT ParserState IO) String
parseConstraintInput = [ParsecT ParseErrorCustom String (StateT ParserState IO) String]
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
M.choice [Tokens String
-> ParsecT
     ParseErrorCustom String (StateT ParserState IO) (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MC.string String
Tokens String
"r", Tokens String
-> ParsecT
     ParseErrorCustom String (StateT ParserState IO) (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MC.string String
Tokens String
"m"]

-- | Parses a single assembly output constraint, which is prefixed by `'='`
-- and then expects either `"r"` or `"m"`.
-- Returns the parsed `String` representing the constraint.
parseConstraintOutput :: PU.Parser String
parseConstraintOutput :: ParsecT ParseErrorCustom String (StateT ParserState IO) String
parseConstraintOutput = Token String
-> ParsecT
     ParseErrorCustom String (StateT ParserState IO) (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
MC.char Char
Token String
'=' ParsecT ParseErrorCustom String (StateT ParserState IO) Char
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
forall a b.
ParsecT ParseErrorCustom String (StateT ParserState IO) a
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [ParsecT ParseErrorCustom String (StateT ParserState IO) String]
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
M.choice [Tokens String
-> ParsecT
     ParseErrorCustom String (StateT ParserState IO) (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MC.string String
Tokens String
"r", Tokens String
-> ParsecT
     ParseErrorCustom String (StateT ParserState IO) (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MC.string String
Tokens String
"m"]

-- | Parses the assembly dialect, which can be either `Intel` or `ATT`.
-- Returns an `AT.AsmDialect`.
parseAsmDialect :: PU.Parser AT.AsmDialect
parseAsmDialect :: ParsecT ParseErrorCustom String (StateT ParserState IO) AsmDialect
parseAsmDialect = [ParsecT
   ParseErrorCustom String (StateT ParserState IO) AsmDialect]
-> ParsecT
     ParseErrorCustom String (StateT ParserState IO) AsmDialect
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
M.choice [AsmDialect
AT.Intel AsmDialect
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
-> ParsecT
     ParseErrorCustom String (StateT ParserState IO) AsmDialect
forall a b.
a
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
-> ParsecT ParseErrorCustom String (StateT ParserState IO) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
PU.symbol String
"Intel", AsmDialect
AT.ATT AsmDialect
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
-> ParsecT
     ParseErrorCustom String (StateT ParserState IO) AsmDialect
forall a b.
a
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
-> ParsecT ParseErrorCustom String (StateT ParserState IO) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
PU.symbol String
"ATT"]

-- | Parses a string enclosed in double quotes (`"..."`).
-- Returns the parsed `String`.
anyString :: PU.Parser String
anyString :: ParsecT ParseErrorCustom String (StateT ParserState IO) String
anyString = ParsecT ParseErrorCustom String (StateT ParserState IO) Char
-> ParsecT ParseErrorCustom String (StateT ParserState IO) Char
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
M.between (Token String
-> ParsecT
     ParseErrorCustom String (StateT ParserState IO) (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
MC.char Char
Token String
'\"') (Token String
-> ParsecT
     ParseErrorCustom String (StateT ParserState IO) (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
MC.char Char
Token String
'\"') (ParsecT ParseErrorCustom String (StateT ParserState IO) String
 -> ParsecT ParseErrorCustom String (StateT ParserState IO) String)
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
forall a b. (a -> b) -> a -> b
$ ParsecT ParseErrorCustom String (StateT ParserState IO) Char
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
M.many ParsecT ParseErrorCustom String (StateT ParserState IO) Char
PU.parseStringChar