1(require "CLOS") 2(require "JAVA") 3(require "EXTENSIBLE-SEQUENCES") 4(require "PRINT-OBJECT") 5 6(in-package :java) 7 8(let* ((jclass (jclass "java.util.List")) 9 (class (%find-java-class jclass))) 10 (if class 11 (error "java.util.List is already registered as a Lisp class; since JAVA-CLASSes can't be redefined, I can't inject SEQUENCE in its class precedence list. Ensure that you require :java-collections before specializing any method on java.util.List and in general before using java.util.List as a CLOS class.") 12 ;;The code below is adapted from ensure-java-class in java.lisp 13 (%register-java-class 14 jclass (mop::ensure-class 15 (make-symbol (jclass-name jclass)) 16 :metaclass (find-class 'java-class) 17 :direct-superclasses 18 (let ((supers 19 (mapcar #'ensure-java-class 20 (delete nil 21 (concatenate 'list 22 (list (jclass-superclass jclass)) 23 (jclass-interfaces jclass)))))) 24 (append supers (list (find-class 'sequence)) (jclass-additional-superclasses jclass))) 25 :java-class jclass)))) 26 27(defmethod print-object ((coll (jclass "java.util.Collection")) stream) 28 (print-unreadable-object (coll stream :type t :identity t) 29 (format stream "~A ~A" 30 (jclass-of coll) 31 (jcall "toString" coll)))) 32 33;;Lists (java.util.List) are the Java counterpart to Lisp SEQUENCEs. 34(defun jlist-add (list item) 35 (jcall (jmethod "java.util.List" "add" "java.lang.Object") 36 list item)) 37 38(defun jlist-set (list index item) 39 (jcall (jmethod "java.util.List" "set" "int" "java.lang.Object") 40 list index item)) 41 42(defun jlist-get (list index) 43 (jcall (jmethod "java.util.List" "get" "int") 44 list index)) 45 46(defmethod sequence:length ((s (jclass "java.util.List"))) 47 (jcall (jmethod "java.util.Collection" "size") s)) 48 49(defmethod sequence:elt ((s (jclass "java.util.List")) index) 50 (jlist-get s index)) 51 52(defmethod (setf sequence:elt) (value (list (jclass "java.util.List")) index) 53 (jlist-set list index value) 54 value) 55 56(defmethod sequence:make-sequence-like 57 ((s (jclass "java.util.List")) length 58 &rest args &key initial-element initial-contents) 59 (declare (ignorable initial-element initial-contents)) 60 (apply #'make-jsequence-like s length #'jlist-add args)) 61 62(defun make-jsequence-like 63 (s length add-fn &key (initial-element nil iep) (initial-contents nil icp)) 64 (let ((seq (jnew (jclass-of s)))) 65 (cond 66 ((and icp iep) 67 (error "Can't specify both :initial-element and :initial-contents")) 68 (icp 69 (dotimes (i length) 70 (funcall add-fn seq (elt initial-contents i)))) ;;TODO inefficient, use iterator 71 (t 72 (dotimes (i length) 73 (funcall add-fn seq initial-element)))) 74 seq)) 75 76;;TODO: destruct doesn't signal an error for too-many-args for its options 77;;e.g. this didn't complain: 78;;(defstruct (jlist-iterator (:type list :conc-name #:jlist-it-)) 79(defstruct (jlist-iterator (:type list) (:conc-name #:jlist-it-)) 80 (native-iterator (error "Native iterator required") :read-only t) 81 element 82 index) 83 84(defmethod sequence:make-simple-sequence-iterator 85 ((s (jclass "java.util.List")) &key from-end (start 0) end) 86 (let* ((end (or end (length s))) 87 (index (if from-end end start)) 88 (it (jcall "listIterator" s index)) 89 (iter (make-jlist-iterator :native-iterator it 90 :index (if from-end (1+ index) (1- index)))) 91 (limit (if from-end (1+ start) (1- end)))) 92 ;;CL iterator semantics are that first element is present from the start 93 (unless (sequence:iterator-endp s iter limit from-end) 94 (sequence:iterator-step s iter from-end)) 95 (values iter limit from-end))) 96 97;;Collection, and not List, because we want to reuse this for Set when applicable 98(defmethod sequence:iterator-step 99 ((s (jclass "java.util.Collection")) it from-end) 100 (let ((native-it (jlist-it-native-iterator it))) 101 (if from-end 102 (progn 103 (setf (jlist-it-element it) 104 (when (jcall "hasPrevious" native-it) 105 (jcall "previous" native-it))) 106 (decf (jlist-it-index it))) 107 (progn 108 (setf (jlist-it-element it) 109 (when (jcall "hasNext" native-it) 110 (jcall "next" native-it))) 111 (incf (jlist-it-index it))))) 112 it) 113 114(defmethod sequence:iterator-endp 115 ((s (jclass "java.util.Collection")) it limit from-end) 116 (if from-end 117 (< (jlist-it-index it) limit) 118 (> (jlist-it-index it) limit))) 119 120(defmethod sequence:iterator-element 121 ((s (jclass "java.util.Collection")) iterator) 122 (declare (ignore s)) 123 (jlist-it-element iterator)) 124 125(defmethod (setf sequence:iterator-element) 126 (new-value (s (jclass "java.util.Collection")) it) 127 (jcall "set" (jlist-it-native-iterator it) new-value)) 128 129(defmethod sequence:iterator-index 130 ((s (jclass "java.util.Collection")) iterator) 131 (declare (ignore s)) 132 (jlist-it-index iterator)) 133 134(defmethod sequence:iterator-copy ((s (jclass "java.util.Collection")) iterator) 135 (declare (ignore s iterator)) 136 (error "iterator-copy not supported for Java iterators.")) 137 138;;It makes sense to have some sequence functions available for Sets 139;;(java.util.Set) too, even if they're not sequences. 140(defun jset-add (set item) 141 (jcall (jmethod "java.util.Set" "add" "java.lang.Object") 142 set item)) 143 144(defmethod sequence:length ((s (jclass "java.util.Set"))) 145 (jcall (jmethod "java.util.Collection" "size") s)) 146 147(defmethod sequence:make-sequence-like 148 ((s (jclass "java.util.Set")) length 149 &rest args &key initial-element initial-contents) 150 (declare (ignorable initial-element initial-contents)) 151 (apply #'make-jsequence-like s length #'jset-add args)) 152 153(defmethod sequence:make-simple-sequence-iterator 154 ((s (jclass "java.util.Set")) &key from-end (start 0) end) 155 (when (or from-end (not (= start 0))) 156 (error "Java Sets can only be iterated from the start.")) 157 (let* ((end (or end (length s))) 158 (it (jcall "iterator" s)) 159 (iter (make-jlist-iterator :native-iterator it 160 :index -1)) 161 (limit (1- end))) 162 ;;CL iterator semantics are that first element is present from the start 163 (unless (sequence:iterator-endp s iter limit nil) 164 (sequence:iterator-step s iter nil)) 165 (values iter limit nil))) 166 167(provide :java-collections) 168