module E2ASM.Assembler.Parser
( parse
, parseDirective
, parseInstruction
, ParserState
, mkParserState
) where


import qualified Data.Map                    as Map
import qualified Data.Text                   as T
import qualified Data.Word                   as W
import qualified Text.Parsec                 as P

import qualified E2ASM.Assembler.AST         as AST
import qualified E2ASM.Assembler.Diagnostics as Diag
import qualified E2ASM.Assembler.Directive   as Dir
import qualified E2ASM.Assembler.Instruction as Instr
import qualified E2ASM.Assembler.Label       as Lab
import qualified E2ASM.Assembler.Number      as Num
import qualified E2ASM.Assembler.Predicate   as Pred
import qualified E2ASM.Assembler.Register    as Reg
import qualified E2ASM.Assembler.Token       as Tok


data ParserState =
  ParserState (Map.Map T.Text W.Word32) W.Word32
  deriving (Eq, Show)


mkParserState :: ParserState
mkParserState = ParserState Map.empty 0


type Parser = P.Parsec [Tok.Token] ParserState


parse :: Parser (AST.AST, ParserState)
parse = do
  nodes <- P.many parsers
  state <- P.getState
  return (AST.AST nodes, state)
  where
    parsers :: Parser AST.Node
    parsers = P.choice
      [parseLabel, parseDirective, parseInstruction]


parseLabel :: Parser AST.Node
parseLabel = do
  lab                <- labelDef
  ParserState m pc <- P.getState

  let t = Lab.getLabelText lab

  if t `Map.member` m then do
    Diag.fatal $ "Label " ++ show t ++ " already defined."
  else do
    let m' = Map.insert t pc m
    P.putState (ParserState m' pc)
    return . AST.NLabel $ lab


parseDirective :: Parser AST.Node
parseDirective = do
  dir              <- directive
  args             <- parseArgument `P.sepBy1` separator
  ParserState m pc <- P.getState

  let
    len = fromIntegral $ length args
    pc' = pc + case dir of
      Dir.DB -> 1 * len
      Dir.DH -> 2 * len
      Dir.DW -> 4 * len

  P.putState (ParserState m pc')
  return $ AST.NDirective dir args
  where
    parseArgument :: Parser AST.Argument
    parseArgument = number >>= \n -> return $ AST.ANumber n


parseInstruction :: Parser AST.Node
parseInstruction = do
  maybePred        <- P.optionMaybe parseParenPred
  instr            <- instruction
  args             <- parseArgument `P.sepBy1` separator
  ParserState m pc <- P.getState

  let p = maybe Pred.p0 id maybePred

  if pc `mod` 4 /= 0 then do
    Diag.fatal $ "The address is not aligned."
  else do
    P.putState (ParserState m (pc + 4))
    return $ AST.NInstruction instr p args
  where
    parseParenPred :: Parser Pred.Predicate
    parseParenPred = lparen *> predicate <* rparen

    parseArgument :: Parser AST.Argument
    parseArgument = regArg P.<|> predArg P.<|> labelArg P.<|> numArg
      where
        labelArg :: Parser AST.Argument
        labelArg = labelRef >>= \l -> return $ AST.ALabel l

        regArg :: Parser AST.Argument
        regArg = register >>= \r -> return $ AST.ARegister r

        predArg :: Parser AST.Argument
        predArg = predicate >>= \p -> return $ AST.APredicate p

        numArg :: Parser AST.Argument
        numArg = number >>= \n -> return $ AST.ANumber n



labelDef :: Parser Lab.Label
labelDef = P.token show getPos check
  where
    check :: Tok.Token -> Maybe Lab.Label
    check (Tok.Token (Tok.TLabelDef l) _) = Just l
    check _                               = Nothing


labelRef :: Parser Lab.Label
labelRef = P.token show getPos check
  where
    check :: Tok.Token -> Maybe Lab.Label
    check (Tok.Token (Tok.TLabelRef l) _) = Just l
    check _                               = Nothing


directive :: Parser Dir.Directive
directive = P.token show getPos check
  where
    check :: Tok.Token -> Maybe Dir.Directive
    check (Tok.Token (Tok.TDir d) _) = Just d
    check _                          = Nothing


instruction :: Parser Instr.Instruction
instruction = P.token show getPos check
  where
    check :: Tok.Token -> Maybe Instr.Instruction
    check (Tok.Token (Tok.TInstr i) _) = Just i
    check _                            = Nothing


predicate :: Parser Pred.Predicate
predicate = P.token show getPos check
  where
    check :: Tok.Token -> Maybe Pred.Predicate
    check (Tok.Token (Tok.TPred p) _) = Just p
    check _                           = Nothing


register :: Parser Reg.Register
register = P.token show getPos check
  where
    check :: Tok.Token -> Maybe Reg.Register
    check (Tok.Token (Tok.TReg r) _) = Just r
    check _                          = Nothing


number :: Parser Num.Number
number = P.token show getPos check
  where
    check :: Tok.Token -> Maybe Num.Number
    check (Tok.Token (Tok.TNum n) _) = Just n
    check _                          = Nothing


separator :: Parser ()
separator = P.token show getPos check
  where
    check :: Tok.Token -> Maybe ()
    check (Tok.Token (Tok.TSep _) _) = Just ()
    check _                          = Nothing


lparen :: Parser ()
lparen = P.token show getPos check
  where
    check :: Tok.Token -> Maybe ()
    check (Tok.Token (Tok.TLParen _) _) = Just ()
    check _                             = Nothing


rparen :: Parser ()
rparen = P.token show getPos check
  where
    check :: Tok.Token -> Maybe ()
    check (Tok.Token (Tok.TRParen _) _) = Just ()
    check _                             = Nothing



getPos :: Tok.Token -> P.SourcePos
getPos (Tok.Token _ p) = p
