(in-package #:user-side-compiler)

(defgeneric check-arguments (instruction))

(defclass instruction ()
  ((%mnemonic :allocation :class :reader mnemonic :initarg :mnemonic)
   (%operand :accessor operand :initarg :operand)
   (%next :accessor next :accessor normal-next :initarg :next)
   (%source :accessor source :initarg :source :initform nil)))

(defmethod print-object ((object instruction) stream)
  (format stream "#<~A~A>" (mnemonic object)
          (if (or (typep object 'implied-mixin)
                  (typep object 'accumulator-mixin))
              ""
              (format nil " ~S" (operand object)))))

(defclass complete-mixin ()
  ((%opcode :allocation :class :reader opcode :initarg :opcode)))

(defclass immediate-mixin () ())
(defclass implied-mixin () ())
(defclass accumulator-mixin () ())
(defclass zero-page-mixin () ())

(defmethod shared-initialize :after ((instance zero-page-mixin) slot-names &rest initargs &key &allow-other-keys)
  (declare (ignore slot-names initargs))
  (when (numberp (operand instance))
    (assert (< (operand instance) #x100))))

(defclass zero-page-x-mixin (zero-page-mixin) ())
(defclass absolute-mixin () ())
(defclass absolute-x-mixin (absolute-mixin) ())
(defclass absolute-y-mixin (absolute-mixin) ())
(defclass indirect-x-mixin (zero-page-mixin) ())
(defclass indirect-y-mixin (zero-page-mixin) ())

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defun addressing-mode-to-class-name (mode-keyword)
    (cadr (assoc mode-keyword
                 '((:implied implied-mixin)
                   (:immediate immediate-mixin)
                   (:accumulator accumulator-mixin)
                   (:zero-page zero-page-mixin)
                   (:zero-page-x zero-page-x-mixin)
                   (:zero-page-y zero-page-y-mixin)
                   (:absolute absolute-mixin)
                   (:absolute-x absolute-x-mixin)
                   (:absolute-y absolute-y-mixin)
                   (:indirect-x indirect-x-mixin)
                   (:indirect-y indirect-y-mixin))))))

(defclass branching-mixin ()
  ((%branch-next :accessor branch-next :initarg :branch-next)))

(defmacro define-instruction (mnemonic branching-p &rest modes-and-codes)
  (let* ((name (string-upcase mnemonic))
         (base-name (intern (format nil "INST-~A" name))))
    `(progn
       (defclass ,base-name (instruction)
         ((%mnemonic :allocation :class :initform ',mnemonic)))
       ,@(loop :for (mode code) :in modes-and-codes
               :collect `(defclass ,(intern (format nil "INST-~A-~A"
                                                    name mode))
                             ,(append
                               `(,base-name
                                 ,(addressing-mode-to-class-name mode)
                                 complete-mixin)
                               (when branching-p
                                 '(branching-mixin)))
                           ((%opcode :allocation :class :initform ,code)))))))

;;; Testing

(define-instruction "TXA" nil (:implied 0))
(define-instruction "PHA" nil (:implied 0))
(define-instruction "PLA" nil (:implied 0))
(define-instruction "TAX" nil (:implied 0))
(define-instruction "DEX" nil (:implied 0))
(define-instruction "BNE" t (:zero-page 0))
(define-instruction "LDA" nil
  (:absolute 0)
  (:zero-page 0)
  (:immediate 0)
  (:absolute-y 0))
(define-instruction "LDY" nil
  (:absolute 0)
  (:immediate 0))
(define-instruction "STA" nil
  (:absolute 0)
  (:immediate 0)
  (:absolute-y 0))
(define-instruction "JSR" nil
  (:absolute 0))