Loading src/code/list.lisp +4 −1 Original line number Diff line number Diff line Loading @@ -1050,7 +1050,10 @@ (setf (car l) (cdar l))) (setq res (apply function (nreverse args))) (case accumulate (:nconc (setq temp (last (nconc temp res)))) (:nconc (when res (let ((next-temp (last res))) (rplacd temp res) (setq temp next-temp)))) (:list (rplacd temp (list res)) (setq temp (cdr temp))))))) Loading src/compiler/seqtran.lisp +8 −2 Original line number Diff line number Diff line Loading @@ -36,12 +36,18 @@ (ecase accumulate (:nconc (let ((temp (gensym)) (map-result (gensym))) (map-result (gensym)) (res (gensym)) (next-temp (gensym))) `(let ((,map-result (list nil))) (declare (dynamic-extent ,map-result)) (do-anonymous ((,temp ,map-result) . ,(do-clauses)) (,endtest (cdr ,map-result)) (setq ,temp (last (nconc ,temp ,call))))))) (let ((,res ,call)) (when ,res (let ((,next-temp (last ,res))) (rplacd ,temp ,res) (setq ,temp ,next-temp)))))))) (:list (let ((temp (gensym)) (map-result (gensym))) Loading tests/list.lisp 0 → 100644 +193 −0 Original line number Diff line number Diff line (defpackage "LIST-TESTS" (:use "COMMON-LISP" "LISP-UNIT")) (in-package "LIST-TESTS") (define-test mapcan-empty-list-returns-nil (locally (declare (notinline mapcan)) (assert-equal '() (mapcan #'identity '()))) (locally (declare (inline mapcan)) (assert-equal '() (mapcan #'identity '())))) (define-test mapcon-empty-list-returns-nil (locally (declare (notinline mapcon)) (assert-equal '() (mapcon #'identity '()))) (locally (declare (inline mapcon)) (assert-equal '() (mapcon #'identity '())))) (define-test mapcan-accumulate-non-nil-signals-type-error (locally (declare (notinline mapcan)) (assert-error 'type-error (mapcan #'identity (list 42)))) (locally (declare (inline mapcan)) (assert-error 'type-error (mapcan #'identity (list 42))))) (define-test mapcon-accumulate-non-nil-signals-type-error (locally (declare (notinline mapcan)) (assert-error 'type-error (mapcon #'car (list 42)))) (locally (declare (inline mapcan)) (assert-error 'type-error (mapcon #'car (list 42))))) (define-test mapcan-accumulate-nil-returns-nil (locally (declare (notinline mapcan)) (assert-equal '() (mapcan (constantly nil) '(1))) (assert-equal '() (mapcan (constantly nil) '(1 2))) (assert-equal '() (mapcan (constantly nil) '(1 2 3)))) (locally (declare (inline mapcan)) (assert-equal '() (mapcan (constantly nil) '(1))) (assert-equal '() (mapcan (constantly nil) '(1 2))) (assert-equal '() (mapcan (constantly nil) '(1 2 3))))) (define-test mapcon-accumulate-nil-returns-nil (locally (declare (notinline mapcon)) (assert-equal '() (mapcon (constantly nil) '(1))) (assert-equal '() (mapcon (constantly nil) '(1 2))) (assert-equal '() (mapcon (constantly nil) '(1 2 3)))) (locally (declare (inline mapcon)) (assert-equal '() (mapcon (constantly nil) '(1))) (assert-equal '() (mapcon (constantly nil) '(1 2))) (assert-equal '() (mapcon (constantly nil) '(1 2 3))))) (define-test mapcan-accumulate-one-list-returns-same-list (locally (declare (notinline mapcan)) (let ((list1 (list 1))) (assert-eq list1 (mapcan (constantly list1) '(nil))))) (locally (declare (inline mapcan)) (let ((list1 (list 1))) (assert-eq list1 (mapcan (constantly list1) '(nil)))))) (define-test mapcon-accumulate-one-list-returns-same-list (locally (declare (notinline mapcon)) (let ((list1 (list 1))) (assert-eq list1 (mapcon (constantly list1) '(nil))))) (locally (declare (inline mapcon)) (let ((list1 (list 1))) (assert-eq list1 (mapcon (constantly list1) '(nil)))))) (define-test mapcan-accumulate-two-lists-returns-same-lists (locally (declare (notinline mapcan)) (let* ((list1 (list 1)) (list2 (list 2)) (list12 (mapcan #'identity (list list1 list2)))) (assert-eq list1 list12) (assert-eq list2 (cdr list12)))) (locally (declare (inline mapcan)) (let* ((list1 (list 1)) (list2 (list 2)) (list12 (mapcan #'identity (list list1 list2)))) (assert-eq list1 list12) (assert-eq list2 (cdr list12))))) (define-test mapcon-accumulate-two-lists-returns-same-lists (locally (declare (notinline mapcon)) (let* ((list1 (list 1)) (list2 (list 2)) (list12 (mapcon #'car (list list1 list2)))) (assert-eq list1 list12) (assert-eq list2 (cdr list12)))) (locally (declare (inline mapcon)) (let* ((list1 (list 1)) (list2 (list 2)) (list12 (mapcon #'car (list list1 list2)))) (assert-eq list1 list12) (assert-eq list2 (cdr list12))))) (define-test mapcan-accumulate-two-lists-skips-nil-returns-same-lists (locally (declare (notinline mapcan)) (let* ((list1 (list 1)) (list2 (list 2)) (list12 (mapcan #'identity (list nil list1 list2)))) (assert-eq list1 list12) (assert-eq list2 (cdr list12))) (let* ((list1 (list 1)) (list2 (list 2)) (list12 (mapcan #'identity (list list1 nil list2)))) (assert-eq list1 list12) (assert-eq list2 (cdr list12))) (let* ((list1 (list 1)) (list2 (list 2)) (list12 (mapcan #'identity (list list1 list2 nil)))) (assert-eq list1 list12) (assert-eq list2 (cdr list12)))) (locally (declare (inline mapcan)) (let* ((list1 (list 1)) (list2 (list 2)) (list12 (mapcan #'identity (list nil list1 list2)))) (assert-eq list1 list12) (assert-eq list2 (cdr list12))) (let* ((list1 (list 1)) (list2 (list 2)) (list12 (mapcan #'identity (list list1 nil list2)))) (assert-eq list1 list12) (assert-eq list2 (cdr list12))) (let* ((list1 (list 1)) (list2 (list 2)) (list12 (mapcan #'identity (list list1 list2 nil)))) (assert-eq list1 list12) (assert-eq list2 (cdr list12))))) (define-test mapcon-accumulate-two-lists-skips-nil-returns-same-lists (locally (declare (notinline mapcon)) (let* ((list1 (list 1)) (list2 (list 2)) (list12 (mapcon #'car (list nil list1 list2)))) (assert-eq list1 list12) (assert-eq list2 (cdr list12))) (let* ((list1 (list 1)) (list2 (list 2)) (list12 (mapcon #'car (list list1 nil list2)))) (assert-eq list1 list12) (assert-eq list2 (cdr list12))) (let* ((list1 (list 1)) (list2 (list 2)) (list12 (mapcon #'car (list list1 list2 nil)))) (assert-eq list1 list12) (assert-eq list2 (cdr list12)))) (locally (declare (inline mapcon)) (let* ((list1 (list 1)) (list2 (list 2)) (list12 (mapcon #'car (list nil list1 list2)))) (assert-eq list1 list12) (assert-eq list2 (cdr list12))) (let* ((list1 (list 1)) (list2 (list 2)) (list12 (mapcon #'car (list list1 nil list2)))) (assert-eq list1 list12) (assert-eq list2 (cdr list12))) (let* ((list1 (list 1)) (list2 (list 2)) (list12 (mapcon #'car (list list1 list2 nil)))) (assert-eq list1 list12) (assert-eq list2 (cdr list12))))) (define-test mapcan-accumulate-same-list-twice-returns-circular-list (locally (declare (notinline mapcan)) (let ((list12 (list 1 2))) ;; check that list12 equals #1=(1 2 . #1#) (assert-eq list12 (mapcan (constantly list12) '(nil nil))) (assert-eql 1 (elt list12 0)) (assert-eql 2 (elt list12 1)) (assert-eq (nthcdr 2 list12) list12))) (locally (declare (inline mapcan)) (let ((list12 (list 1 2))) ;; check that list12 equals #1=(1 2 . #1#) (assert-eq list12 (mapcan (constantly list12) '(nil nil))) (assert-eql 1 (elt list12 0)) (assert-eql 2 (elt list12 1)) (assert-eq (nthcdr 2 list12) list12)))) (define-test mapcon-accumulate-same-list-twice-returns-circular-list (locally (declare (notinline mapcon)) (let ((list12 (list 1 2))) ;; check that list12 equals #1=(1 2 . #1#) (assert-eq list12 (mapcon (constantly list12) '(nil nil))) (assert-eql 1 (elt list12 0)) (assert-eql 2 (elt list12 1)) (assert-eq (nthcdr 2 list12) list12))) (locally (declare (notinline mapcon)) (let ((list12 (list 1 2))) ;; check that list12 equals #1=(1 2 . #1#) (assert-eq list12 (mapcon (constantly list12) '(nil nil))) (assert-eql 1 (elt list12 0)) (assert-eql 2 (elt list12 1)) (assert-eq (nthcdr 2 list12) list12)))) Loading
src/code/list.lisp +4 −1 Original line number Diff line number Diff line Loading @@ -1050,7 +1050,10 @@ (setf (car l) (cdar l))) (setq res (apply function (nreverse args))) (case accumulate (:nconc (setq temp (last (nconc temp res)))) (:nconc (when res (let ((next-temp (last res))) (rplacd temp res) (setq temp next-temp)))) (:list (rplacd temp (list res)) (setq temp (cdr temp))))))) Loading
src/compiler/seqtran.lisp +8 −2 Original line number Diff line number Diff line Loading @@ -36,12 +36,18 @@ (ecase accumulate (:nconc (let ((temp (gensym)) (map-result (gensym))) (map-result (gensym)) (res (gensym)) (next-temp (gensym))) `(let ((,map-result (list nil))) (declare (dynamic-extent ,map-result)) (do-anonymous ((,temp ,map-result) . ,(do-clauses)) (,endtest (cdr ,map-result)) (setq ,temp (last (nconc ,temp ,call))))))) (let ((,res ,call)) (when ,res (let ((,next-temp (last ,res))) (rplacd ,temp ,res) (setq ,temp ,next-temp)))))))) (:list (let ((temp (gensym)) (map-result (gensym))) Loading
tests/list.lisp 0 → 100644 +193 −0 Original line number Diff line number Diff line (defpackage "LIST-TESTS" (:use "COMMON-LISP" "LISP-UNIT")) (in-package "LIST-TESTS") (define-test mapcan-empty-list-returns-nil (locally (declare (notinline mapcan)) (assert-equal '() (mapcan #'identity '()))) (locally (declare (inline mapcan)) (assert-equal '() (mapcan #'identity '())))) (define-test mapcon-empty-list-returns-nil (locally (declare (notinline mapcon)) (assert-equal '() (mapcon #'identity '()))) (locally (declare (inline mapcon)) (assert-equal '() (mapcon #'identity '())))) (define-test mapcan-accumulate-non-nil-signals-type-error (locally (declare (notinline mapcan)) (assert-error 'type-error (mapcan #'identity (list 42)))) (locally (declare (inline mapcan)) (assert-error 'type-error (mapcan #'identity (list 42))))) (define-test mapcon-accumulate-non-nil-signals-type-error (locally (declare (notinline mapcan)) (assert-error 'type-error (mapcon #'car (list 42)))) (locally (declare (inline mapcan)) (assert-error 'type-error (mapcon #'car (list 42))))) (define-test mapcan-accumulate-nil-returns-nil (locally (declare (notinline mapcan)) (assert-equal '() (mapcan (constantly nil) '(1))) (assert-equal '() (mapcan (constantly nil) '(1 2))) (assert-equal '() (mapcan (constantly nil) '(1 2 3)))) (locally (declare (inline mapcan)) (assert-equal '() (mapcan (constantly nil) '(1))) (assert-equal '() (mapcan (constantly nil) '(1 2))) (assert-equal '() (mapcan (constantly nil) '(1 2 3))))) (define-test mapcon-accumulate-nil-returns-nil (locally (declare (notinline mapcon)) (assert-equal '() (mapcon (constantly nil) '(1))) (assert-equal '() (mapcon (constantly nil) '(1 2))) (assert-equal '() (mapcon (constantly nil) '(1 2 3)))) (locally (declare (inline mapcon)) (assert-equal '() (mapcon (constantly nil) '(1))) (assert-equal '() (mapcon (constantly nil) '(1 2))) (assert-equal '() (mapcon (constantly nil) '(1 2 3))))) (define-test mapcan-accumulate-one-list-returns-same-list (locally (declare (notinline mapcan)) (let ((list1 (list 1))) (assert-eq list1 (mapcan (constantly list1) '(nil))))) (locally (declare (inline mapcan)) (let ((list1 (list 1))) (assert-eq list1 (mapcan (constantly list1) '(nil)))))) (define-test mapcon-accumulate-one-list-returns-same-list (locally (declare (notinline mapcon)) (let ((list1 (list 1))) (assert-eq list1 (mapcon (constantly list1) '(nil))))) (locally (declare (inline mapcon)) (let ((list1 (list 1))) (assert-eq list1 (mapcon (constantly list1) '(nil)))))) (define-test mapcan-accumulate-two-lists-returns-same-lists (locally (declare (notinline mapcan)) (let* ((list1 (list 1)) (list2 (list 2)) (list12 (mapcan #'identity (list list1 list2)))) (assert-eq list1 list12) (assert-eq list2 (cdr list12)))) (locally (declare (inline mapcan)) (let* ((list1 (list 1)) (list2 (list 2)) (list12 (mapcan #'identity (list list1 list2)))) (assert-eq list1 list12) (assert-eq list2 (cdr list12))))) (define-test mapcon-accumulate-two-lists-returns-same-lists (locally (declare (notinline mapcon)) (let* ((list1 (list 1)) (list2 (list 2)) (list12 (mapcon #'car (list list1 list2)))) (assert-eq list1 list12) (assert-eq list2 (cdr list12)))) (locally (declare (inline mapcon)) (let* ((list1 (list 1)) (list2 (list 2)) (list12 (mapcon #'car (list list1 list2)))) (assert-eq list1 list12) (assert-eq list2 (cdr list12))))) (define-test mapcan-accumulate-two-lists-skips-nil-returns-same-lists (locally (declare (notinline mapcan)) (let* ((list1 (list 1)) (list2 (list 2)) (list12 (mapcan #'identity (list nil list1 list2)))) (assert-eq list1 list12) (assert-eq list2 (cdr list12))) (let* ((list1 (list 1)) (list2 (list 2)) (list12 (mapcan #'identity (list list1 nil list2)))) (assert-eq list1 list12) (assert-eq list2 (cdr list12))) (let* ((list1 (list 1)) (list2 (list 2)) (list12 (mapcan #'identity (list list1 list2 nil)))) (assert-eq list1 list12) (assert-eq list2 (cdr list12)))) (locally (declare (inline mapcan)) (let* ((list1 (list 1)) (list2 (list 2)) (list12 (mapcan #'identity (list nil list1 list2)))) (assert-eq list1 list12) (assert-eq list2 (cdr list12))) (let* ((list1 (list 1)) (list2 (list 2)) (list12 (mapcan #'identity (list list1 nil list2)))) (assert-eq list1 list12) (assert-eq list2 (cdr list12))) (let* ((list1 (list 1)) (list2 (list 2)) (list12 (mapcan #'identity (list list1 list2 nil)))) (assert-eq list1 list12) (assert-eq list2 (cdr list12))))) (define-test mapcon-accumulate-two-lists-skips-nil-returns-same-lists (locally (declare (notinline mapcon)) (let* ((list1 (list 1)) (list2 (list 2)) (list12 (mapcon #'car (list nil list1 list2)))) (assert-eq list1 list12) (assert-eq list2 (cdr list12))) (let* ((list1 (list 1)) (list2 (list 2)) (list12 (mapcon #'car (list list1 nil list2)))) (assert-eq list1 list12) (assert-eq list2 (cdr list12))) (let* ((list1 (list 1)) (list2 (list 2)) (list12 (mapcon #'car (list list1 list2 nil)))) (assert-eq list1 list12) (assert-eq list2 (cdr list12)))) (locally (declare (inline mapcon)) (let* ((list1 (list 1)) (list2 (list 2)) (list12 (mapcon #'car (list nil list1 list2)))) (assert-eq list1 list12) (assert-eq list2 (cdr list12))) (let* ((list1 (list 1)) (list2 (list 2)) (list12 (mapcon #'car (list list1 nil list2)))) (assert-eq list1 list12) (assert-eq list2 (cdr list12))) (let* ((list1 (list 1)) (list2 (list 2)) (list12 (mapcon #'car (list list1 list2 nil)))) (assert-eq list1 list12) (assert-eq list2 (cdr list12))))) (define-test mapcan-accumulate-same-list-twice-returns-circular-list (locally (declare (notinline mapcan)) (let ((list12 (list 1 2))) ;; check that list12 equals #1=(1 2 . #1#) (assert-eq list12 (mapcan (constantly list12) '(nil nil))) (assert-eql 1 (elt list12 0)) (assert-eql 2 (elt list12 1)) (assert-eq (nthcdr 2 list12) list12))) (locally (declare (inline mapcan)) (let ((list12 (list 1 2))) ;; check that list12 equals #1=(1 2 . #1#) (assert-eq list12 (mapcan (constantly list12) '(nil nil))) (assert-eql 1 (elt list12 0)) (assert-eql 2 (elt list12 1)) (assert-eq (nthcdr 2 list12) list12)))) (define-test mapcon-accumulate-same-list-twice-returns-circular-list (locally (declare (notinline mapcon)) (let ((list12 (list 1 2))) ;; check that list12 equals #1=(1 2 . #1#) (assert-eq list12 (mapcon (constantly list12) '(nil nil))) (assert-eql 1 (elt list12 0)) (assert-eql 2 (elt list12 1)) (assert-eq (nthcdr 2 list12) list12))) (locally (declare (notinline mapcon)) (let ((list12 (list 1 2))) ;; check that list12 equals #1=(1 2 . #1#) (assert-eq list12 (mapcon (constantly list12) '(nil nil))) (assert-eql 1 (elt list12 0)) (assert-eql 2 (elt list12 1)) (assert-eq (nthcdr 2 list12) list12))))