source: branches/0.22.x/abcl/src/org/armedbear/lisp/java-collections.lisp

(require "CLOS")
(require "JAVA")
(require "EXTENSIBLE-SEQUENCES")

(in-package :java)

(defmethod print-object ((coll (jclass "java.util.Collection")) stream)
  (print-unreadable-object (coll stream :type t :identity t)
    (format stream "~A ~A"
      (jclass-of coll)
      (jcall "toString" coll))))

;;Lists (java.util.List) are the Java counterpart to Lisp SEQUENCEs.
(defun jlist-add (list item)
  (jcall (jmethod "java.util.List" "add" "java.lang.Object")
   list item))

(defun jlist-set (list index item)
  (jcall (jmethod "java.util.List" "set" "int" "java.lang.Object")
   list index item))

(defun jlist-get (list index)
  (jcall (jmethod "java.util.List" "get" "int")
   list index))

(defmethod sequence:length ((s (jclass "java.util.List")))
  (jcall (jmethod "java.util.Collection" "size") s))

(defmethod sequence:elt ((s (jclass "java.util.List")) index)
  (jlist-get s index))

(defmethod (setf sequence:elt) (value (list (jclass "java.util.List")) index)
  (jlist-set list index value)
  value)

(defmethod sequence:make-sequence-like
    ((s (jclass "java.util.List")) length
     &rest args &key initial-element initial-contents)
  (declare (ignorable initial-element initial-contents))
  (apply #'make-jsequence-like s length #'jlist-add args))

(defun make-jsequence-like
    (s length add-fn &key (initial-element nil iep) (initial-contents nil icp))
  (let ((seq (jnew (jclass-of s))))
    (cond
      ((and icp iep)
       (error "Can't specify both :initial-element and :initial-contents"))
      (icp
       (dotimes (i length)
   (funcall add-fn seq (elt initial-contents i)))) ;;TODO inefficient, use iterator
      (t
       (dotimes (i length)
   (funcall add-fn seq initial-element))))
    seq))

;;TODO: destruct doesn't signal an error for too-many-args for its options
;;e.g. this didn't complain:
;;(defstruct (jlist-iterator (:type list :conc-name #:jlist-it-))
(defstruct (jlist-iterator (:type list) (:conc-name #:jlist-it-))
  (native-iterator (error "Native iterator required") :read-only t)
  element
  index)

(defmethod sequence:make-simple-sequence-iterator
    ((s (jclass "java.util.List")) &key from-end (start 0) end)
  (let* ((end (or end (length s)))
   (index (if from-end (1- end) start))
   (it (jcall "listIterator" s index))
   (iter (make-jlist-iterator :native-iterator it
            :index (if from-end (1+ index)
                 (1- index))))
   (limit (if from-end start (1- end))))
    ;;CL iterator semantics are that first element is present from the start
    (unless (sequence:iterator-endp s iter limit from-end)
      (sequence:iterator-step s iter from-end))
    (values iter limit from-end)))

;;Collection, and not List, because we want to reuse this for Set when applicable
(defmethod sequence:iterator-step
    ((s (jclass "java.util.Collection")) it from-end)
  (if from-end
      (progn
  (setf (jlist-it-element it)
        (jcall "previous" (jlist-it-native-iterator it)))
  (decf (jlist-it-index it)))
      (progn
  (setf (jlist-it-element it)
        (jcall "next" (jlist-it-native-iterator it)))
  (incf (jlist-it-index it))))
  it)

(defmethod sequence:iterator-endp
    ((s (jclass "java.util.Collection")) it limit from-end)
  (if from-end
      (<= (jlist-it-index it) limit)
      (>= (jlist-it-index it) limit)))

(defmethod sequence:iterator-element
    ((s (jclass "java.util.Collection")) iterator)
  (declare (ignore s))
  (jlist-it-element iterator))

(defmethod (setf sequence:iterator-element)
    (new-value (s (jclass "java.util.Collection")) it)
  (jcall "set" (jlist-it-native-iterator it) new-value))

(defmethod sequence:iterator-index
    ((s (jclass "java.util.Collection")) iterator)
  (declare (ignore s))
  (jlist-it-index iterator))

(defmethod sequence:iterator-copy ((s (jclass "java.util.Collection")) iterator)
  (declare (ignore s iterator))
  (error "iterator-copy not supported for Java iterators."))

;;However, it makes sense to have some sequence functions available for Sets
;;(java.util.Set) too, even if they're not sequences.
(defun jset-add (set item)
  (jcall (jmethod "java.util.Set" "add" "java.lang.Object")
   set item))

(defmethod sequence:length ((s (jclass "java.util.Set")))
  (jcall (jmethod "java.util.Collection" "size") s))

(defmethod sequence:make-sequence-like
    ((s (jclass "java.util.Set")) length
     &rest args &key initial-element initial-contents)
  (declare (ignorable initial-element initial-contents))
  (apply #'make-jsequence-like s length #'jset-add args))

(defmethod sequence:make-simple-sequence-iterator
    ((s (jclass "java.util.Set")) &key from-end (start 0) end)
  (when (or from-end (not (= start 0)))
    (error "Java Sets can only be iterated from the start."))
  (let* ((end (or end (length s)))
   (it (jcall "iterator" s))
   (iter (make-jlist-iterator :native-iterator it
            :index -1))
   (limit (1- end)))
    ;;CL iterator semantics are that first element is present from the start
    (unless (sequence:iterator-endp s iter limit nil)
      (sequence:iterator-step s iter nil))
    (values iter limit nil)))

(provide :java-collections)