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

;;; Base node

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

(defun nodep (obj)
  (typep obj 'node))

(defmethod node-nexts ((node node))
  (list (normal-next node)))

;;; Basic nodes

(defclass node-nop (node) ())

(defclass node-block (node)
  ((%statements :accessor statements :initarg :statements)))

(defclass node-program (node-block) ())

;;; Expression nodes

(defclass node-expr (node)
  ((%operands :accessor operands :initarg :operands)
   (%operator-token :accessor operator-token :initarg :operator-token)))

(define-transformation (node (node-expr node)) node)

(defclass node-expr-grouping (node)
  ((%expression :accessor expression :initarg :expression)))

(define-transformation (node (node-expr-grouping node-expr)) node)

(defmethod node-nexts ((node node-expr-grouping))
  (append (list (expression node)) (call-next-method)))

(defclass node-assignment (node-expr)
  ((%dst-variable :accessor dst-variable :initarg :variable)
   (%value :accessor value :initarg :value)))

(defmethod initialize-instance :after ((instance node-assignment) &rest initargs &key &allow-other-keys)
  (declare (ignore initargs))
  (setf (operands instance) (list (dst-variable instance)
                                  (value instance))))

(defmethod node-nexts ((node node-assignment))
  (append (when (nodep (value node))
            (list (value node)))
          (call-next-method)))

(defclass node-standard-expr (node-expr) ())

(defmacro define-standard-expr-node (name)
  `(progn
     (defclass ,name (node-standard-expr) ())
     (define-transformation (node (,name node-expr)) node)))

(defmethod node-nexts ((node node-standard-expr))
  (append (remove-if-not #'nodep (operands node))
          (call-next-method)))

(define-standard-expr-node node-expr-plus)
(define-standard-expr-node node-expr-minus)
(define-standard-expr-node node-expr-test-equal)
(define-standard-expr-node node-expr-test-not-equal)
(define-standard-expr-node node-expr-multiply)
(define-standard-expr-node node-expr-divide)

;;; 

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

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

(defmethod node-nexts ((node node-branch))
  (list (normal-next node) (branch-next node)))

(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.")
   (%counter-ref :accessor counter-ref :initarg :counter-ref
                 :documentation "A reference to a variable being set to the loop index.")
   (%loopee-node :accessor loopee-node :initarg :loopee-node)))

(defmethod node-nexts ((node node-dotimes))
  (append (list (loopee-node node))
          (call-next-method)))