source: trunk/abcl/contrib/jss/collections.lisp @ 15146

Last change on this file since 15146 was 15146, checked in by Mark Evenson, 4 years ago

JSS read sharp expression bugfixes
(Alan Ruttenberg)

Fix the following in JSS:

1) method call expression lookup java class for jstatic.
2) maybe-class, if it isn't a class, intern in current package vs. jss

Added missing <file:contrib/jss/util.lisp> from the head as of
with commit 2dab9f16384f279afe0127ef3c540811939c5bcb

Untabify all source units for sanity.

Merges <>.


File size: 10.1 KB
1(in-package :jss)
3(defun set-to-list (set)
4  "Convert the java.util.Set named in SET to a Lisp list."
5  (declare (optimize (speed 3) (safety 0)))
6  (with-constant-signature ((iterator "iterator" t) (hasnext "hasNext") (next "next"))
7    (loop with iterator = (iterator set)
8       while (hasNext iterator)
9       for item = (next iterator)
10       collect item)))
12(defun jlist-to-list (list)
13  "Convert a LIST implementing java.util.List to a Lisp list."
14  (declare (optimize (speed 3) (safety 0)))
15  (loop :for i :from 0 :below (jcall "size" list)
16     :collecting (jcall "get" list i)))
18(defun jarray-to-list (jarray)
19  "Convert the Java array named by JARRARY into a Lisp list."
20  (declare (optimize (speed 3) (safety 0)))
21  (loop :for i :from 0 :below (jarray-length jarray)
22     :collecting (jarray-ref jarray i)))
24;;; Deprecated
26;;; XXX unclear what sort of list this would actually work on, as it
27;;; certainly doesn't seem to be any of the Java collection types
28;;; (what implements getNext())?
29(defun list-to-list (list)
30  (declare (optimize (speed 3) (safety 0)))
31  (with-constant-signature ((isEmpty "isEmpty") (getfirst "getFirst")
32                            (getNext "getNext"))
33    (loop until (isEmpty list)
34       collect (getFirst list)
35       do (setq list (getNext list)))))
37;; Contribution of Luke Hope. (Thanks!)
39(defun iterable-to-list (iterable)
40  "Return the items contained the java.lang.Iterable ITERABLE as a list."
41  (declare (optimize (speed 3) (safety 0)))
42  (let ((it (#"iterator" iterable)))
43    (with-constant-signature ((has-next "hasNext")
44                              (next "next"))
45      (loop :while (has-next it)
46         :collect (next it)))))
48(defun vector-to-list (vector)
49  "Return the elements of java.lang.Vector VECTOR as a list."
50  (declare (optimize (speed 3) (safety 0)))
51  (with-constant-signature ((has-more "hasMoreElements")
52                            (next "nextElement"))
53    (let ((elements (#"elements" vector)))
54      (loop :while (has-more elements)
55         :collect (next elements)))))
57(defun hashmap-to-hashtable (hashmap &rest rest &key (keyfun #'identity) (valfun #'identity) (invert? nil)
58                                                  table 
59                             &allow-other-keys )
60  "Converts the a HASHMAP reference to a java.util.HashMap object to a Lisp hashtable.
62The REST paramter specifies arguments to the underlying MAKE-HASH-TABLE call.
64KEYFUN and VALFUN specifies functions to be run on the keys and values
65of the HASHMAP right before they are placed in the hashtable.
67If INVERT? is non-nil than reverse the keys and values in the resulting hashtable."
68  (let ((keyset (#"keySet" hashmap))
69        (table (or table (apply 'make-hash-table
70                                (loop for (key value) on rest by #'cddr
71                                   unless (member key '(:invert? :valfun :keyfun :table)) 
72                                   collect key and collect value)))))
73    (with-constant-signature ((iterator "iterator" t) (hasnext "hasNext") (next "next"))
74      (loop with iterator = (iterator keyset)
75         while (hasNext iterator)
76         for item = (next iterator)
77         do (if invert?
78                (setf (gethash (funcall valfun (#"get" hashmap item)) table) (funcall keyfun item))
79                (setf (gethash (funcall keyfun item) table) (funcall valfun (#"get" hashmap item)))))
80      table)))
82;; ****************************************************************
83;; But needing to remember is annoying
85;; Here's a summary I gleaned:
87;; java.util.Dictionary -> #"elements" yields java.util.Collections$3
88;; java.util.AbstractCollection -> #"iterator" yields java.util.Iterator?
89;; org.apache.felix.framework.util.CompoundEnumeration  -> implements java.util.Enumeration
90;; java.util.Collections -> doc says #"iterator" yields java.util.Iterator
91;; java.util.Collections$1) -> implements java.util.Iterator
92;; java.util.Collections$2) -> implements java.util.Spliterator (#"iterator" (#"stream" 'StreamSupport <a spliterator>)) -> java.util.Iterator
93;; java.util.Collections$3) -> implements java.util.Enumeration
94;; java.util.Iterator
95;;   ("next" "hasNext")
96;; java.util.Enumeration)
97;;   ("nextElement" "hasMoreElements")
99;; TODO: maybe do it even more MAPC-style and accept multiple sequences too?
100(defun jmap (function thing)
101  "Call FUNCTION for every element in the THING.  Returns NIL.
103THING may be a wide range of Java collection types, their common iterators or
104a Java array.
106In case the THING is a map-like object, FUNCTION will be called with two
107arguments, key and value."
108  (flet ((iterator-run (iterator)
109           (with-constant-signature ((has-next "hasNext")
110                                     (next "next"))
111             (loop :while (has-next iterator)
112                   :do (funcall function (next iterator)))))
113         (enumeration-run (enumeration)
114           (with-constant-signature ((has-next "hasMoreElements")
115                                     (next "nextElement"))
116             (loop :while (has-next enumeration)
117                   :do (funcall function (next enumeration)))))
118         (map-run (map)
119           (with-constant-signature ((has-next "hasMoreElements")
120                                     (next "nextElement"))
121             (let ((keyiterator (#"iterator" (#"keyset" map))))
122               (loop :while (has-next keyiterator)
123                     :for key = (next keyiterator)
124                     :do (funcall function key (#"get" map key)))))))
125    (let ((isinstance
126            (load-time-value (jmethod "java.lang.Class" "isInstance" "java.lang.Object"))))
127      (cond
128        ((jcall isinstance (load-time-value (ignore-errors (jclass "java.util.AbstractCollection"))) thing)
129         (iterator-run (#"iterator" thing)))
130        ((jcall isinstance (load-time-value (ignore-errors (jclass "java.util.Iterator"))) thing)
131         (iterator-run thing))
132        ((jcall isinstance (load-time-value (ignore-errors (jclass "java.lang.Iterable"))) thing)
133         (iterator-run (#"iterator" thing)))
134        ((jcall isinstance (load-time-value (ignore-errors (jclass "java.util.Enumeration"))) thing)
135         (enumeration-run thing))
136        ((jcall isinstance (load-time-value (ignore-errors (jclass "java.util.AbstractMap"))) thing)
137         (map-run thing))
138        ((jcall isinstance (load-time-value (ignore-errors (jclass "java.util.Collections"))) thing)
139         (iterator-run (#"iterator" thing)))
140        ((jcall isinstance (load-time-value (ignore-errors (jclass "java.util.Spliterator"))) thing)
141         (iterator-run (#"iterator" (#"stream" 'StreamSupport thing))))
142        ((jcall isinstance (load-time-value (ignore-errors (jclass "java.util.Dictionary"))) thing)
143         (iterator-run (#"elements" thing)))
144        (t
145         (let ((jarray (ignore-errors
146                        (or (and (jclass-array-p (jclass-of thing))
147                                 thing)
148                            (#"toArray" thing)))))
149           (if jarray
150               (loop :for i :from 0 :below (jarray-length jarray)
151                     :do (funcall function (jarray-ref jarray i)))
152               (error "yet another iteration type - fix it: ~a" (jclass-name (jobject-class thing)))))))))
153  NIL)
155(defun j2list (thing)
156  "Attempt to construct a Lisp list out of a Java THING.
158THING may be a wide range of Java collection types, their common
159iterators or a Java array."
160  (declare (optimize (speed 3) (safety 0)))
161  (flet ((iterator-collect (iterator)
162           (with-constant-signature ((has-next "hasNext")
163                                     (next "next"))
164             (loop :while (has-next iterator)
165                   :collect (next iterator))))
166         (enumeration-collect (enumeration)
167           (with-constant-signature ((has-next "hasMoreElements")
168                                     (next "nextElement"))
169             (loop :while (has-next enumeration)
170                   :collect (next enumeration))))
171         (map-collect (map)
172           (with-constant-signature ((has-next "hasMoreElements")
173                                     (next "nextElement"))
174             (let ((keyiterator (#"iterator" (#"keyset" map))))
175               (loop :while (has-next keyiterator)
176                     :for key = (next keyiterator)
177                  :collect (cons key (#"get" map key)))))))
178    (let ((isinstance
179           (load-time-value (jmethod "java.lang.Class" "isInstance" "java.lang.Object"))))
180      (cond
181        ((jcall isinstance (load-time-value (ignore-errors (jclass "java.util.AbstractCollection"))) thing)
182         (iterator-collect (#"iterator" thing)))
183        ((jcall isinstance (load-time-value (ignore-errors (jclass "java.util.Iterator"))) thing)
184         (iterator-collect thing))
185        ((jcall isinstance (load-time-value (ignore-errors (jclass "java.lang.Iterable"))) thing)
186         (iterator-collect (#"iterator" thing)))
187        ((jcall isinstance (load-time-value (ignore-errors (jclass "java.util.Enumeration"))) thing)
188         (enumeration-collect thing))
189        ((jcall isinstance (load-time-value (ignore-errors (jclass "java.util.AbstractMap"))) thing)
190         (map-collect thing))
191        ((jcall isinstance (load-time-value (ignore-errors (jclass "java.util.Collections"))) thing)
192         (iterator-collect (#"iterator" thing)))
193        ((jcall isinstance (load-time-value (ignore-errors (jclass "java.util.Spliterator"))) thing)
194         (iterator-collect (#"iterator" (#"stream" 'StreamSupport thing))))
195        ((jcall isinstance (load-time-value (ignore-errors (jclass "java.util.Dictionary"))) thing)
196         (iterator-collect (#"elements" thing)))
197        (t
198         (let ((jarray (ignore-errors
199                        (or (and (jclass-array-p (jclass-of thing))
200                                 thing)
201                            (#"toArray" thing)))))
202           (if jarray
203               (loop :for i :from 0 :below (jarray-length jarray)
204                     :collect (jarray-ref jarray i))
205               (error "yet another iteration type - fix it: ~a" (jclass-name (jobject-class thing))))))))))
207(defun to-hashset (list)
208  "Convert LIST to the java.util.HashSet contract"
209  (let ((set (new 'hashset)))
210    (loop for l in list do (#"add" set l))
211    set))
Note: See TracBrowser for help on using the repository browser.