common-lisp/sbcl.sbcl
1
0
Fork 0
mirror of git://git.code.sf.net/p/sbcl/sbcl synced 2026-09-10 07:26:40 -04:00
Code Issues Actions 8 Packages Projects Releases Wiki Activity

Fix MAP-INTO-ing extended sequences

Browse source 
Use the required protocol functions.
This commit is contained in:
Bike 2019-12-05 22:09:02 -05:00 committed by Stas Boukarev
parent 8275edf75c
commit 05471076c3
2 changed files with 46 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

12
src/code/seq.lisp
View file

@ -1423,17 +1423,15 @@ many elements are copied."
(setf (car node) (apply really-fun args))
(setf node (cdr node)))))
(sequence
(multiple-value-bind (iter limit from-end)
(multiple-value-bind (iter limit from-end step endp elt set)
(sb-sequence:make-sequence-iterator result-sequence)
(declare (ignore elt) (type function step endp set))
(map-into-lambda sequences (&rest args)
(declare (truly-dynamic-extent args) (optimize speed))
(when (sb-sequence:iterator-endp result-sequence
iter limit from-end)
(when (funcall endp result-sequence iter limit from-end)
(return-from map-into result-sequence))
(setf (sb-sequence:iterator-element result-sequence iter)
(apply really-fun args))
(setf iter (sb-sequence:iterator-step result-sequence
iter from-end)))))))
(funcall set (apply really-fun args) result-sequence iter)
(setf iter (funcall step result-sequence iter from-end)))))))
result-sequence)
;;;; REDUCE

41
tests/extended-sequences.impure.lisp
View file

@ -95,3 +95,44 @@
(x :from-end t)
(loop until (stop) collect (value) do (next))))
(('(a b c d)) '(d c b a) :test #'equal)))
(defclass my-list (sequence standard-object)
((%nilp :initarg :nilp :initform nil :accessor nilp)
(%kar :initarg :kar :accessor kar)
(%kdr :initarg :kdr :accessor kdr)))
(defun my-list (&rest elems)
(if (null elems)
(load-time-value (make-instance 'my-list :nilp t) t)
(make-instance 'my-list
:kar (first elems) :kdr (apply #'my-list (rest elems)))))
(defmethod sequence:length ((sequence my-list))
(if (nilp sequence)
0
(1+ (length (kdr sequence)))))
(defmethod sequence:make-sequence-iterator
((sequence my-list) &key from-end start end)
(declare (ignore from-end start end))
(values sequence (my-list) nil
(lambda (sequence iterator from-end)
(declare (ignore sequence from-end))
(kdr iterator))
(lambda (sequence iterator limit from-end)
(declare (ignore sequence from-end))
(eq iterator limit))
(lambda (sequence iterator)
(declare (ignore sequence))
(kar iterator))
(lambda (new sequence iterator)
(declare (ignore sequence))
(setf (kar iterator) new))
(constantly 0)
(lambda (sequence iterator)
(declare (ignore sequence))
iterator)))
(with-test (:name :map-into)
(assert (equal (coerce (map-into (my-list 1 2 3) #'identity '(4 5 6)) 'list)
'(4 5 6))))