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

(defclass ir-inst ()
  ((%next :accessor next :initarg :successor)
   (%previous :accessor previous :initarg :predecessor)
   (%inputs :accessor inputs :initarg :inputs :initform '())
   (%output :accessor output :initarg :output :initform nil)
   (%iblock :accessor iblock :initarg :iblock)
   (%source :accessor source :initarg :source)))

(defmethod effect-used-p ((inst ir-inst))
  nil)

(defmethod (setf inputs) ((new-value list) (object ir-inst))
  (when (slot-boundp object '%inputs)
    (mapc (lambda (i) (remove-user i object)) (inputs object)))
  (dolist (data new-value)
    (add-user data object))
  (setf (slot-value object '%inputs) new-value))

(defmethod shared-initialize :before
    ((instance ir-inst) slot-names &rest initargs
     &key (inputs nil inputsp) (input nil inputp) (output nil outputp)
     &allow-other-keys)
  (declare (ignore slot-names initargs))
  (when outputp
    (when (slot-boundp instance '%output)
      (setf (definition (output instance)) nil))
    (setf (output instance) output
          (definition output) instance))
  (assert (not (and inputsp inputp))) ; cannot give both singular and plural
  (when inputsp
    (setf (inputs instance) inputs))
  (when inputp
    (setf (inputs instance) (list input))))

(defclass ir-one-input (ir-inst)
  ((%inputs :type (or null (cons t null))))
  (:documentation "Mixin for instructions that may take only one input."))

(defclass ir-effect-use (ir-inst) ()
  (:documentation "An instruction used at least in part for its side-effects. May not be deleted
solely due to its output being unused."))

(defmethod effect-used-p ((inst ir-effect-use))
  t)

(defclass ir-no-output (ir-effect-use)
  ((%output :accessor output :type null :initform nil))
  (:documentation "Mixin forbidding an instruction from having an output."))

(defmethod input ((inst ir-one-input))
  (first (inputs inst)))

(defclass ir-terminator (ir-inst)
  ((%destinations :accessor destinations :initarg :destinations)
   (%next :initform nil :type null))
  (:documentation "An instruction that ends a basic block."))

(defclass ir-return (ir-terminator)
  ((%destinations :initform nil :type null)))

(defclass ir-if (ir-terminator ir-one-input) ())
(defclass ir-jump (ir-terminator) ())

(defclass ir-getconst (ir-one-input ir-inst)
  ((%inputs :type (or null (cons fixnum null)))))

(tlk:define-simple-print-object (ir-getconst %inputs) :format-string "~{~A~}")

(defmethod shared-initialize :after ((instance ir-getconst) slot-names &rest initargs
                                     &key &allow-other-keys)
  (declare (ignore slot-names initargs))
  (unless (null (output instance))
    (check-type (output instance) ir-constant)
    (setf (value (output instance))
          (input instance))))

(defclass ir-fetchvar (ir-one-input ir-inst) ())
(defclass ir-assign (ir-one-input ir-inst) ())

(defclass ir-operation (ir-inst) ())

(defclass ir-call (ir-operation)
  ((%callee :accessor callee :initarg :callee)))

(defmethod effect-used-p ((inst ir-call))
  ;; TODO: Return the non-pureness of the callee
  t)

;;; A messy but quick way to define all the very similar arithmetic operations
(macrolet ((ops ((&rest superclasses) &rest classes)
             `(progn
                ,@(loop :for (class-name ignore symbol) :in classes
                        :collect `(progn
                                    (defclass ,class-name ,superclasses ())
                                    (defmethod print-ir-inst ((inst ,class-name))
                                      (format t "  (~A~{ ~A~}) -> ~A~%"
                                              ,symbol (inputs inst) (output inst)))))
                (defun get-ir-expr-inst-type (node)
                  (typecase node
                    ,@(loop :for (ir-class node-class ignore) :in classes
                            :unless (null node-class)
                              :collect `(,node-class ',ir-class)))))))
  (ops (ir-operation)               ; NILs indicate TODOs here for now
       (ir-test-equal node-expr-test-equal "==")
       (ir-test-not-equal node-expr-test-not-equal "!=")
       (ir-test-less nil "<") (ir-test-greater nil ">")
       (ir-test-less-or-equal nil "<=") (ir-test-greater-or-equal nil ">=")
       (ir-plus node-expr-plus "+") (ir-minus node-expr-minus "-") (ir-mult node-expr-multiply "*") (ir-div node-expr-divide "/")))