source: trunk/abcl/src/org/armedbear/lisp/java-collections.lisp @ 13368

Last change on this file since 13368 was 13368, checked in by astalla, 10 years ago

Better separation between java-collections and the Java FFI. java-collections should be easily moved to contrib now.

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