module AssemblerInterpreter where

import Data.Maybe (fromMaybe)
import Text.Parsec
import Text.Parsec.Char

interpret :: String -> Maybe String
interpret prog = Nothing

type Parser = Parsec String ()

data Op =
  Mov | Inc | Dec | Add | Sub  | Mul | Div | Jmp | Cmp | Jne | Je |
  Jge | Jg  | Jle | Jl  | Call | Ret | Msg | End 
  deriving (Show)

argsNum Mov = 2
argsNum Inc = 1
argsNum Dec = 1
argsNum Add = 2
argsNum Sub = 2
argsNum Mul = 2
argsNum Div = 2
argsNum Jmp = 1
argsNum Cmp = 2
argsNum Jne = 1
argsNum Je  = 1
argsNum Jge = 1
argsNum Jg  = 1
argsNum Jle = 1
argsNum Jl  = 1
argsNum Call= 1
argsNum Ret = 0
argsNum Msg = -1
argsNum End = 0

opStrP :: Parser String
opStrP = choice $ map string' [
  "mov", "inc", "dec", "add", "sub", "mul", "div", "jmp", "cmp", "jne",
  "je", "jge", "jg", "jle", "jl", "call", "ret", "msg", "end"]

opP :: Parser Op
opP = do
  s <- opStrP
  case s of
    "mov" -> return Mov
    "inc" -> return Inc
    "dec" -> return Dec
    "add" -> return Add
    "sub" -> return Sub
    "mul" -> return Mul
    "div" -> return Div
    "jmp" -> return Jmp
    "cmp" -> return Cmp
    "jne" -> return Jne
    "je"  -> return Je
    "jge" -> return Jge
    "jg"  -> return Jg
    "jle" -> return Jle
    "jl"  -> return Jl
    "call"-> return Call
    "ret" -> return Ret
    "msg" -> return Msg
    "end" -> return End

newtype Label = Label String
  deriving (Show)

inlineSpace :: Parser Char
inlineSpace = oneOf [' ', '\t'] 
inlineSpaces = skipMany $ oneOf [' ', '\t'] 

identifierP :: Parser String
identifierP = do
  notFollowedBy opStrP
  x <- letter <|> oneOf ['_']
  xs <- many (alphaNum <|> oneOf ['_'])
  return (x:xs)

labelP :: Parser Label
labelP = do
  id <- identifierP
  oneOf [':']
  return $ Label id

data Stmt = LabelStmt Label | InstrStmt Op [Arg]
  deriving (Show)

data Arg = IdentifierArg String | NumberArg Int | StringArg String
  deriving (Show)

argP :: Parser Arg
argP = do
  inlineSpaces
  let identifierArgP = IdentifierArg <$> identifierP
      numberP = NumberArg . read <$> many1 digit
      stringP = do
        oneOf ['\''] :: Parser Char
        str <- many $ noneOf ['\'']
        oneOf ['\'']
        return $ StringArg str
  arg <- identifierArgP <|> numberP <|> stringP
  inlineSpaces
  return arg

stmtP :: Parser Stmt
stmtP = do
  let
    labelStmtP = LabelStmt <$> labelP
    argsP = do
      inlineSpaces
      oneOf [',']
      inlineSpaces
      arg <- argP
      inlineSpaces
      return arg
    instrStmtP = do
      op <- opP
      inlineSpaces
      marg <- optionMaybe argP
      args <- case marg of
        Just arg -> do
          targs <- many argsP
          return (arg:targs)
        Nothing -> return []
      return $ InstrStmt op args
  inlineSpaces
  stmt <- labelStmtP <|> instrStmtP
  inlineSpaces
  return stmt

commentP :: Parser ()
commentP = do
  oneOf [';']
  many $ noneOf ['\n']
  return ()

stmtLineP :: Parser [Stmt]
stmtLineP = do
  inlineSpaces
  ms <- optionMaybe stmtP
  inlineSpaces
  optional commentP
  inlineSpaces
  case ms of
    Just s -> return [s]
    Nothing -> return []

progP :: Parser [Stmt]
progP = do
  let newlineP = do
        newline :: Parser Char
        return (++)
  stmts <- chainl stmtLineP newlineP []
  spaces
  return stmts

main = do
  print $ runParser opP () "" "msg" 
  print $ runParser stmtLineP () "" "ret" 
  print $ runParser progP () "" "ret \n  mov a , 12\n uwu: \n ret" 
  print $ runParser progP () "" "ret ; 123 ; 123\n  mov a , 12\n uwu: \n ret" 
  print $ runParser progP () "" "\nmov   a, 2            ; value1\nmov   b, 10           ; value2\nmov   c, a            ; temp1\nmov   d, b            ; temp2\ncall  proc_func\ncall  print\nend\n\nproc_func:\n    cmp   d, 1\n    je    continue\n    mul   c, a\n    dec   d\n    call  proc_func\n\ncontinue:\n    ret\n\nprint:\n    msg a, '^', b, ' = ', c\n    ret\n"