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

(defvar *label-counter* 0)
(defvar *instruction-source* nil)
(defvar *compile-result*)

(defun produce-instruction (instruction-class &optional operand)
  (push (make-instance instruction-class :operand operand :source *instruction-source*)
        *compile-result*))

(defun produce-label (&optional label)
  (when (null label)
    (setf label (make-label)))
  (push label *compile-result*)
  label)

(defun produce-comment (text)
  (push text *compile-result*))

(defmacro format-inst (destination control-string &rest format-arguments)
  `(format ,destination "~C~A~%" #\Tab (format nil ,control-string ,@format-arguments)))

(defclass reference () ())

(defgeneric ref-constantp (reference) (:method (reference) nil))

(defclass reference-constant (reference)
  ((%value :accessor ref-value :initarg :value)))

(defmethod ref-constantp ((reference reference-constant))
  t)

(defmethod print-object ((object reference-constant) stream)
  (print-unreadable-object (object stream :type t)
    (format stream "~D" (ref-value object))))

(defmethod dereference ((ref reference-constant))
  (produce-instruction 'inst-lda-immediate (ref-value ref)))

(defclass reference-variable (reference)
  ((%index :accessor ref-index :initarg :index)))

(defmethod print-object ((object reference-variable) stream)
  (print-unreadable-object (object stream :type t)
    (format stream "@~D" (ref-index object))))

(defmethod dereference ((ref reference-variable))
  (produce-instruction 'inst-ldy-immediate (ref-index ref))
  (produce-instruction 'inst-lda-absolute-y "VARVEC"))

(defclass node ()
  ((%next :accessor next :accessor normal-next :initform nil)))

(defmethod generate-code :before ((node node))
  (produce-comment (format nil "~A" node)))

(defmethod generate-code :after ((node node))
  (terpri))

(defmethod compile-node ((node node))
  (generate-code node)
  (unless (null (next node))
    (compile-node (next node))))

(defclass node-call (node)
  ((%callee :accessor callee :initarg :callee)
   (%arguments :accessor arguments :initarg :arguments)))

(defmethod print-object ((object node-call) stream)
  (print-unreadable-object (object stream :type t :identity t)
    (format stream "~A~A" (callee object) (arguments object))))

(defmethod generate-code ((node node-call))
  (let ((*instruction-source* node))
    (loop :for ref :in (arguments node)
          :for index :from 0
          :do (dereference ref)
          :do (produce-instruction 'inst-sta-absolute (format nil "ARGVEC+~D" index)))
    (produce-instruction 'inst-jsr-absolute (callee node))))

(defclass node-branch (node)
  ((%branch-next :accessor branch-next :initarg :branch-next)))

(defmethod generate-code ((node node-branch))
  (let ((*instruction-source* node)
        (else-label (make-label :name-prefix "ELSE")))
    (produce-instruction 'inst-lda-absolute "RESULT")
    (produce-instruction 'inst-bne-relative else-label)
    ;; The THEN branch
    (compile-node (branch-next node))
    ;; The ELSE branch
    (produce-label else-label)))

(defclass node-dotimes (node)
  ((%stop-ref :accessor stop-ref :initarg :stop-ref
              :documentation "A reference giving a value of how many times to run the loop.")
   (%loopee-node :accessor loopee-node :initarg :loopee-node)))

(defmethod generate-code ((node node-dotimes))
  (let ((*instruction-source* node)
        (loop-label (make-label :name-prefix "LOOPBACK")))
    (produce-instruction 'inst-txa-implied)
    (produce-instruction 'inst-pha-implied)

    (dereference (stop-ref node))
    (produce-instruction 'inst-tax-implied)
    (produce-label loop-label)
    (compile-node (loopee-node node))
    (produce-instruction 'inst-dex-implied)
    (produce-instruction 'inst-bne-relative loop-label)

    (produce-instruction 'inst-pla-implied)
    (produce-instruction 'inst-tax-implied)))

(defmethod compile-starting-at ((node node))
  (let ((*compile-result* '()))
    (compile-node node)
    (nreverse *compile-result*)))

(defun make-call (callee args)
  (let ((arguments
          (loop :for (constp value) :in args
                :with index := -1
                :if constp
                  :collect (make-instance 'reference-constant :value value)
                :else
                  :collect (make-instance 'reference-variable :index (incf index)))))
    (make-instance 'node-call :callee callee
                              :arguments arguments)))