(in-package :cl-smoke.qt.core)

(defun cxx:= (object &rest more-objects)
  (if (null more-objects)
      t
      (every #'(lambda (o)
                 ;; Consider Class::operator== and operator==
                 ;; FIXME integrate this in the overload resolution
                 (if (typep object 'smoke-standard-object)
                     (handler-case (qt:operator== object o)
                       (no-applicable-cxx-method ()
                         (cxx:operator== object o)))
                     (qt:operator== object o)))
             more-objects)))

(defun cxx:/= (object &rest more-objects)
  (if (null more-objects)
      t
      (some #'(lambda (o)
                (qt:operator!= object o))
            more-objects)))
      
(defun ordered-p (relation list)
  "Returns true when LIST is ordered according to RELATION."
  (if (or (null list) (null (rest list)))
      t
      (and (funcall relation (first list)
                    (second list))
           (ordered-p relation (rest list)))))

(defmacro define-cxx-relation (relation)
  `(defun ,(intern (symbol-name relation) :cxx) (object &rest more-objects)
     (ordered-p (symbol-function (quote ,(intern (format nil "OPERATOR~A"
                                                         relation)
                                                 :qt)))
                (cons object more-objects))))
  
(defmacro define-cxx-relations (&rest relations)
  `(progn
     ,@(mapcar #'(lambda (r) `(define-cxx-relation ,r)) relations)))

(define-cxx-relations < <= >= >)


(defun cxx:incf (object &optional (delta 1))
  (cxx:operator+= object delta))

(defun cxx:decf (object &optional (delta 1))
  (cxx:operator-= object delta))

(defun cxx:+ (&rest args)
  (if (null args)
      0
      (reduce #'qt:operator+ args)))

(defun cxx:- (object &rest subtrahends)
  (if (null subtrahends)
      (cxx:operator- object)
      (reduce #'qt:operator- (cons object subtrahends))))

(defun cxx:* (&rest args)
  (if (null args)
      1
      (reduce #'qt:operator- args)))

(defun cxx:/ (object &rest denominators)
  (if (null denominators)
      (qt:operator/ 1 object)
      (qt:operator/ object (apply #'cxx:+ denominators))))

(defun cxx:1+ (object)
  (qt:operator+ object 1))

(defun cxx:1- (object)
  (qt:operator- object 1))

(defun cxx:aref (object index)
  "Returns the element of OBJECT at position INDEX."
  (declare ((integer 0) index))
  (assert (< index (cxx:size object))
          (index)
          "Index ~A for ~A requested, but the length is ~A"
          index object (cxx:size object))
  (cxx:at object index))


(defun (setf cxx:aref) (new-value object index)
  (declare ((integer 0) index))
  (assert (< index (cxx:size object))
          (index)
          "Index ~A for ~A requested, but the length is ~A"
          index object (cxx:size object))
  (cxx:operator= (cxx:operator[] object index)
                 new-value)
  new-value)