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

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

Small fix (a parameter wasn't being passed to make-jsequence-like)

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 (1- end) start))
68   (it (jcall "listIterator" s index))
69   (iter (make-jlist-iterator :native-iterator it
70            :index (if from-end (1+ index)
71                 (1- index))))
72   (limit (if from-end start (1- end))))
73    ;;CL iterator semantics are that first element is present from the start
74    (unless (sequence:iterator-endp s iter limit from-end)
75      (sequence:iterator-step s iter from-end))
76    (values iter limit from-end)))
77
78;;Collection, and not List, because we want to reuse this for Set when applicable
79(defmethod sequence:iterator-step
80    ((s (jclass "java.util.Collection")) it from-end)
81  (if from-end
82      (progn
83  (setf (jlist-it-element it)
84        (jcall "previous" (jlist-it-native-iterator it)))
85  (decf (jlist-it-index it)))
86      (progn
87  (setf (jlist-it-element it)
88        (jcall "next" (jlist-it-native-iterator it)))
89  (incf (jlist-it-index it))))
90  it)
91
92(defmethod sequence:iterator-endp
93    ((s (jclass "java.util.Collection")) it limit from-end)
94  (if from-end
95      (<= (jlist-it-index it) limit)
96      (>= (jlist-it-index it) limit)))
97
98(defmethod sequence:iterator-element
99    ((s (jclass "java.util.Collection")) iterator)
100  (declare (ignore s))
101  (jlist-it-element iterator))
102
103(defmethod (setf sequence:iterator-element)
104    (new-value (s (jclass "java.util.Collection")) it)
105  (jcall "set" (jlist-it-native-iterator it) new-value))
106
107(defmethod sequence:iterator-index
108    ((s (jclass "java.util.Collection")) iterator)
109  (declare (ignore s))
110  (jlist-it-index iterator))
111
112(defmethod sequence:iterator-copy ((s (jclass "java.util.Collection")) iterator)
113  (declare (ignore s iterator))
114  (error "iterator-copy not supported for Java iterators."))
115
116;;However, it makes sense to have some sequence functions available for Sets
117;;(java.util.Set) too, even if they're not sequences.
118(defun jset-add (set item)
119  (jcall (jmethod "java.util.Set" "add" "java.lang.Object")
120   set item))
121
122(defmethod sequence:length ((s (jclass "java.util.Set")))
123  (jcall (jmethod "java.util.Collection" "size") s))
124
125(defmethod sequence:make-sequence-like
126    ((s (jclass "java.util.Set")) length
127     &rest args &key initial-element initial-contents)
128  (declare (ignorable initial-element initial-contents))
129  (apply #'make-jsequence-like s length #'jset-add args))
130
131(defmethod sequence:make-simple-sequence-iterator
132    ((s (jclass "java.util.Set")) &key from-end (start 0) end)
133  (when (or from-end (not (= start 0)))
134    (error "Java Sets can only be iterated from the start."))
135  (let* ((end (or end (length s)))
136   (it (jcall "iterator" s))
137   (iter (make-jlist-iterator :native-iterator it
138            :index -1))
139   (limit (1- end)))
140    ;;CL iterator semantics are that first element is present from the start
141    (unless (sequence:iterator-endp s iter limit nil)
142      (sequence:iterator-step s iter nil))
143    (values iter limit nil)))
144
145(provide :java-collections)
Note: See TracBrowser for help on using the repository browser.