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

Last change on this file was 15149, checked in by Mark Evenson, 5 years ago

jss: explicitly scope TO-HASHSET
File size: 10.1 KB
Line 
1(in-package :jss)
2
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)))
11
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)))
17
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)))
23
24;;; Deprecated
25;;;
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)))))
36
37;; Contribution of Luke Hope. (Thanks!)
38
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)))))
47
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)))))
56
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.
61
62The REST paramter specifies arguments to the underlying MAKE-HASH-TABLE call.
63
64KEYFUN and VALFUN specifies functions to be run on the keys and values
65of the HASHMAP right before they are placed in the hashtable.
66
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)))
81
82;; ****************************************************************
83;; But needing to remember is annoying
84
85;; Here's a summary I gleaned:
86
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")
98
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.
102
103THING may be a wide range of Java collection types, their common iterators or
104a Java array.
105
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)
154
155(defun j2list (thing)
156  "Attempt to construct a Lisp list out of a Java THING.
157
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))))))))))
206
207(defun to-hashset (list)
208  "Convert LIST to the java.util.HashSet contract"
209  (let ((set (new 'java.util.hashset)))
210    (loop for l in list do (#"add" set l))
211    set))
Note: See TracBrowser for help on using the repository browser.