Raymond Toy pushed to branch issue-240-union-with-hash-table at cmucl / cmucl Commits: 33f11724 by Raymond Toy at 2023-08-12T07:34:55-07:00 Replace latin-1 character Latin_Small_Letter_I_With_Diaeresis In files/math.lisp, the word "naive" is spelled using the character \Latin_Small_Letter_I_With_Diaeresis. However, when compiling locally with a UTF-8 encoding (which is the default), this is invalid. The letter needs to be encoded as 2 octets. I'm too lazy to figure out how to get emacs to insert the correct encoded character so I'm replacing it with a simple "i". This makes the file pure ASCII, so it should work fine with a UTF-8 encoding. - - - - - a8ced15b by Carl Shapiro at 2023-08-14T04:45:23+00:00 Address #196: Fix issues with mapping and nconc accumulation - - - - - 310e41eb by Carl Shapiro at 2023-08-14T04:45:41+00:00 Merge branch 'mapcan' into 'master' Address #196: Fix issues with mapping and nconc accumulation See merge request cmucl/cmucl!162 - - - - - 19a305de by Raymond Toy at 2023-08-16T14:28:11+00:00 Address #240: Speed up set-difference - - - - - 9d593e3a by Raymond Toy at 2023-08-16T14:28:55+00:00 Merge branch 'issue-240-set-diff-with-hash-table' into 'master' Address #240: Speed up set-difference Closes #240 See merge request cmucl/cmucl!153 - - - - - 5819562a by Raymond Toy at 2023-08-16T07:43:30-07:00 Merge branch 'master' into issue-240-union-with-hash-table - - - - - 5 changed files: - benchmarks/cl-bench/files/math.lisp - src/code/list.lisp - src/compiler/seqtran.lisp - + tests/list.lisp - tests/sets.lisp Changes: ===================================== benchmarks/cl-bench/files/math.lisp ===================================== @@ -1,6 +1,6 @@ ;;; math.lisp -- various numerical operations ;; -;; Time-stamp: <2004-01-05 emarsden> +;; Time-stamp: <2023-08-12 07:34:28 toy> ;; ;; some basic mathematical benchmarks @@ -56,7 +56,7 @@ ;; calculate the "level" of a point in the Mandebrot Set, which is the ;; number of iterations taken to escape to "infinity" (points that ;; don't escape are included in the Mandelbrot Set). This version is -;; intended to test performance when programming in naïve math-style. +;; intended to test performance when programming in naive math-style. (defun mset-level/complex (c) (declare (type complex c)) (loop :for z = #c(0 0) :then (+ (* z z) c) ===================================== src/code/list.lisp ===================================== @@ -1113,7 +1113,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))))))) ===================================== src/compiler/seqtran.lisp ===================================== @@ -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))) ===================================== tests/list.lisp ===================================== @@ -0,0 +1,193 @@ +(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)))) ===================================== tests/sets.lisp ===================================== @@ -89,6 +89,7 @@ :test-not 'eql))) + (define-test union.hash-eql (:tag :issues) ;; For union to use hashtables by making the threshold @@ -171,5 +172,3 @@ '(3 4) :test 'eql :test-not 'eql))) - - View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/ec9b0dcd0041e301bdefc6e... -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/ec9b0dcd0041e301bdefc6e... You're receiving this email because of your account on gitlab.common-lisp.net.