(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)))

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

(defclass immediate-mixin () ())
(defclass implied-mixin () ())
(defclass zero-page-mixin () ())
(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) ())

(defun addressing-mode-to-class-name (mode-keyword)
  (cadr (assoc mode-keyword
               '((:implied implied-mixin)
                 (:immediate immediate-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)))))))