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

Last change on this file since 12928 was 12928, checked in by astalla, 11 years ago

Fixes in java collections support (iterators) and dosequence (wrong call to parse-body)

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