(uiop:define-package :st-buchberger/src/term
 (:mix :cl)
 (:mix-reexport :st-buchberger/src/ring-element)
 (:export #:term #:initialize-instance #:ring-zero-p
  #:print-object #:element->string #:ring-equal-p))

(in-package :st-buchberger/src/term)

(defclass term (ring-element)
  ((coefficient
    :initarg :coefficient
    :initform 0
    :accessor coefficient)
   (monomial
    :type vector
    :initarg :monomial
    :initform (make-array 0)
    :accessor monomial)))

(defmethod initialize-instance :after ((tm term) &key ring)
  (unless (monomial tm)
    (setf (monomial tm)                 ; zero-polynomial
          (make-array (length (variables ring))
                      :element-type 'integer :initial-element 0))))

(defmethod ring-zero-p ((tm term))
  (and (zerop (coefficient tm))
       (vector-zero-p (monomial tm))))

(defmethod print-object ((tm term) stream)
  (print-unreadable-object (tm stream :type t)
    (format stream "~a ~a" (coefficient tm) (monomial tm))))

(defmethod element->string ((tm term) &key ring leading-term)
  (with-output-to-string (s)
    (with-slots (coefficient monomial) tm
      (flet ((independent-term-p (monomial)
               (every #'zerop monomial))
             (print-variables ()
               (dotimes (i (length monomial))
                 (let ((exponent (aref monomial i)))
                   (unless (zerop exponent)
                     (format s "~a"
                             (string-downcase
                              (elt (variables ring) i)))
                     (when (/= 1 exponent)
                       (format s "^~d" exponent)))))))
        (if (plusp (signum coefficient))
            (format s (if leading-term "" "+ "))
            (format s (if leading-term "-" "- ")))
        (if (independent-term-p monomial)
            (format s "~d" (abs coefficient))
            (progn
              (when (/= 1 (abs coefficient))
                (format s "~d" (abs coefficient)))
              (print-variables)))))))

(defmethod ring-equal-p ((t1 term) (t2 term))
  (with-slots ((c1 coefficient) (m1 monomial)) t1
    (with-slots ((c2 coefficient) (m2 monomial)) t2
      (and (= c1 c2)
           (vector-equal-p m1 m2)))))