Fix looping over sbcl *external-formats*.

The internal represtation of the SBCL *external-formats* has changed to a
new structure which is not an hash-table anymore.
This commit is contained in:
Dimitri Fontaine 2022-06-23 17:15:47 +02:00
parent 3853c8996f
commit e2418891a4
No known key found for this signature in database
GPG Key ID: 38096AB1A90BF6D4

View File

@ -232,8 +232,20 @@ in 2 bytes.
#+ccl #+ccl
(parse-ccl-encodings-desc (with-output-to-string (*standard-output*) (parse-ccl-encodings-desc (with-output-to-string (*standard-output*)
(ccl:describe-character-encodings))) (ccl:describe-character-encodings)))
#+sbcl #+sbcl
(let ((result '())) (typecase sb-impl::*external-formats*
(vector
(loop :for encoding :across sb-impl::*external-formats*
:when encoding
:collect
(mapcar (function string-upcase)
(typecase encoding
(sb-impl::external-format
(slot-value encoding 'sb-impl::names))
(list
(slot-value (first encoding) 'sb-impl::names))))))
(hash-table
(let ((result '()))
(maphash (lambda (name encoding) (maphash (lambda (name encoding)
(declare (ignore name)) (declare (ignore name))
(pushnew encoding result)) (pushnew encoding result))
@ -241,7 +253,7 @@ in 2 bytes.
(mapcar (lambda (encoding) (mapcar (lambda (encoding)
(mapcar (function string-upcase) (mapcar (function string-upcase)
(slot-value encoding 'sb-impl::names))) (slot-value encoding 'sb-impl::names)))
result)))) result))))))
(sort encoding-and-aliases #'string< :key #'car))) (sort encoding-and-aliases #'string< :key #'car)))
(defun show-encodings () (defun show-encodings ()