Raymond Toy pushed to branch issue-249-replace-lea-in-arith at cmucl / cmucl

Commits:

5 changed files:

Changes:

  • benchmarks/cl-bench/files/math.lisp
    1 1 
     ;;; math.lisp -- various numerical operations
    2 2 
     ;;
    3 
    -;; Time-stamp: <2004-01-05 emarsden>
    3 
    +;; Time-stamp: <2023-08-12 07:34:28 toy>
    4 4 
     ;;
    5 5 
     ;; some basic mathematical benchmarks
    6 6
    ... ... @@ -56,7 +56,7 @@
    56 56 
     ;; calculate the "level" of a point in the Mandebrot Set, which is the
    57 57 
     ;; number of iterations taken to escape to "infinity" (points that
    58 58 
     ;; don't escape are included in the Mandelbrot Set). This version is
    59 
    -;; intended to test performance when programming in nave math-style.
    59 
    +;; intended to test performance when programming in naive math-style.
    60 60 
     (defun mset-level/complex (c)
    61 61 
       (declare (type complex c))
    62 62 
       (loop :for z = #c(0 0) :then (+ (* z z) c)

  • src/code/list.lisp
    ... ... @@ -45,7 +45,7 @@
    45 45 
     	  tree-equal list-length nth %setnth nthcdr last make-list append
    46 46 
     	  copy-list copy-alist copy-tree revappend nconc nreconc butlast
    47 47 
     	  nbutlast ldiff member member-if member-if-not tailp adjoin union
    48 
    -	  nunion intersection nintersection set-difference nset-difference
    48 
    +	  nunion intersection nintersection nset-difference
    49 49 
     	  set-exclusive-or nset-exclusive-or subsetp acons pairlis assoc
    50 50 
     	  assoc-if assoc-if-not rassoc rassoc-if rassoc-if-not subst subst-if
    51 51 
     	  subst-if-not nsubst nsubst-if nsubst-if-not sublis nsublis))
    ... ... @@ -744,6 +744,39 @@
    744 744 
           list
    745 745 
           (cons item list)))
    746 746
    747 
    +;; The minimum length of a list before we can use a hashtable.  This
    748 
    +;; was determined experimentally.
    749 
    +(defparameter *min-list-length-for-hashtable*
    750 
    +  15)
    751 
    +
    752 
    +;; Convert a list to a hashtable.  The hashtable does not handle
    753 
    +;; duplicated values in the list.  Returns the hashtable.
    754 
    +(defun list-to-hashtable (list key test test-not)
    755 
    +  ;; Don't currently support test-not when converting a list to a hashtable
    756 
    +  (unless test-not
    757 
    +    (let ((hash-test (let ((test-fn (if (and (symbolp test)
    758 
    +                                             (fboundp test))
    759 
    +                                        (fdefinition test)
    760 
    +                                        test)))
    761 
    +                       (cond ((eql test-fn #'eq) 'eq)
    762 
    +                             ((eql test-fn #'eql) 'eql)
    763 
    +                             ((eql test-fn #'equal) 'equal)
    764 
    +                             ((eql test-fn #'equalp) 'equalp)))))
    765 
    +      (unless hash-test
    766 
    +	(return-from list-to-hashtable nil))
    767 
    +      ;; If the list is too short, the hashtable makes things
    768 
    +      ;; slower.  We also need to balance memory usage.
    769 
    +      (let ((len 0))
    770 
    +	;; Compute list length ourselves.
    771 
    +	(dolist (item list)
    772 
    +	  (declare (ignore item))
    773 
    +	  (incf len))
    774 
    +	(when (< len *min-list-length-for-hashtable*)
    775 
    +          (return-from list-to-hashtable nil))
    776 
    +	(let ((hashtable (make-hash-table :test hash-test :size len)))
    777 
    +	  (dolist (item list)
    778 
    +	    (setf (gethash (apply-key key item) hashtable) item))
    779 
    +	  hashtable)))))
    747 780
    748 781 
     ;;; UNION -- Public.
    749 782 
     ;;;
    ... ... @@ -755,11 +788,18 @@
    755 788 
     (defun union (list1 list2 &key key (test #'eql testp) (test-not nil notp))
    756 789 
       "Returns the union of list1 and list2."
    757 790 
       (declare (inline member))
    758 
    -  (when (and testp notp) (error (intl:gettext "Test and test-not both supplied.")))
    759 
    -  (let ((res list2))
    760 
    -    (dolist (elt list1)
    761 
    -      (unless (with-set-keys (member (apply-key key elt) list2))
    762 
    -	(push elt res)))
    791 
    +  (when (and testp notp)
    792 
    +    (error (intl:gettext "Test and test-not both supplied.")))
    793 
    +  (let ((res list2)
    794 
    +	(hashtable (list-to-hashtable list2 key test test-not)))
    795 
    +    (cond (hashtable
    796 
    +	   (dolist (item list1)
    797 
    +	     (unless (nth-value 1 (gethash (apply-key key item) hashtable))
    798 
    +	       (push item res))))
    799 
    +	  ((null hashtable)
    800 
    +	   (dolist (item list1)
    801 
    +	     (unless (with-set-keys (member (apply-key key item) list2))
    802 
    +	       (push item res)))))
    763 803 
         res))
    764 804
    765 805 
     ;;; Destination and source are setf-able and many-evaluable.  Sets the source
    ... ... @@ -792,11 +832,20 @@
    792 832 
       (declare (inline member))
    793 833 
       (if (and testp notp)
    794 834 
           (error "Test and test-not both supplied."))
    795 
    -  (let ((res nil))
    796 
    -    (dolist (elt list1)
    797 
    -      (if (with-set-keys (member (apply-key key elt) list2))
    798 
    -	  (push elt res)))
    799 
    -    res))
    835 
    +  (let ((hashtable
    836 
    +	  (list-to-hashtable list2 key test test-not)))
    837 
    +    (cond (hashtable
    838 
    +	   (let ((res nil))
    839 
    +	     (dolist (item list1)
    840 
    +	       (when (nth-value 1 (gethash (apply-key key item) hashtable))
    841 
    +		 (push item res)))
    842 
    +	     res))
    843 
    +	  ((null hashtable)
    844 
    +	   (let ((res nil))
    845 
    +	     (dolist (elt list1)
    846 
    +	       (if (with-set-keys (member (apply-key key elt) list2))
    847 
    +		   (push elt res)))
    848 
    +	     res)))))
    800 849
    801 850 
     (defun nintersection (list1 list2 &key key
    802 851 
     			    (test #'eql testp) (test-not nil notp))
    ... ... @@ -812,20 +861,32 @@
    812 861 
     	  (setq list1 (Cdr list1))))
    813 862 
         res))
    814 863
    815 
    -(defun set-difference (list1 list2 &key key
    816 
    -			     (test #'eql testp) (test-not nil notp))
    864 
    +(defun set-difference (list1 list2 &key key (test #'eql testp) (test-not nil notp))
    817 865 
       "Returns the elements of list1 which are not in list2."
    818 866 
       (declare (inline member))
    819 867 
       (if (and testp notp)
    820 868 
           (error "Test and test-not both supplied."))
    821 
    -  (if (null list2)
    822 
    -      list1
    823 
    -      (let ((res nil))
    824 
    -	(dolist (elt list1)
    825 
    -	  (if (not (with-set-keys (member (apply-key key elt) list2)))
    826 
    -	      (push elt res)))
    827 
    -	res)))
    828 
    -
    869 
    +  ;; Quick exit
    870 
    +  (when (null list2)
    871 
    +    (return-from set-difference list1))
    872 
    +
    873 
    +  (let ((hashtable
    874 
    +	  (list-to-hashtable list2 key test test-not)))
    875 
    +    (cond (hashtable
    876 
    +	   ;; list2 was placed in hash table.
    877 
    +	   (let ((res nil))
    878 
    +	     (dolist (item list1)
    879 
    +	       (unless (nth-value 1 (gethash (apply-key key item) hashtable))
    880 
    +		 (push item res)))
    881 
    +	     res))
    882 
    +	  ((null hashtable)
    883 
    +	   ;; Default implementation because we didn't create the hash
    884 
    +	   ;; table.
    885 
    +           (let ((res nil))
    886 
    +	     (dolist (item list1)
    887 
    +	       (if (not (with-set-keys (member (apply-key key item) list2)))
    888 
    +                   (push item res)))
    889 
    +	     res)))))
    829 890
    830 891 
     (defun nset-difference (list1 list2 &key key
    831 892 
     			      (test #'eql testp) (test-not nil notp))
    ... ... @@ -1050,7 +1111,10 @@
    1050 1111 
     	(setf (car l) (cdar l)))
    1051 1112 
           (setq res (apply function (nreverse args)))
    1052 1113 
           (case accumulate
    1053 
    -	(:nconc (setq temp (last (nconc temp res))))
    1114 
    +	(:nconc (when res
    1115 
    +		  (let ((next-temp (last res)))
    1116 
    +		    (rplacd temp res)
    1117 
    +		    (setq temp next-temp))))
    1054 1118 
     	(:list (rplacd temp (list res))
    1055 1119 
     	       (setq temp (cdr temp)))))))
    1056 1120

  • src/compiler/seqtran.lisp
    ... ... @@ -36,12 +36,18 @@
    36 36 
     	  (ecase accumulate
    37 37 
     	    (:nconc
    38 38 
     	     (let ((temp (gensym))
    39 
    -		   (map-result (gensym)))
    39 
    +		   (map-result (gensym))
    40 
    +		   (res (gensym))
    41 
    +		   (next-temp (gensym)))
    40 42 
     	       `(let ((,map-result (list nil)))
    41 43 
     		  (declare (dynamic-extent ,map-result))
    42 44 
     		  (do-anonymous ((,temp ,map-result) . ,(do-clauses))
    43 45 
     				 (,endtest (cdr ,map-result))
    44 
    -		    (setq ,temp (last (nconc ,temp ,call)))))))
    46 
    +		    (let ((,res ,call))
    47 
    +		      (when ,res
    48 
    +			(let ((,next-temp (last ,res)))
    49 
    +			  (rplacd ,temp ,res)
    50 
    +			  (setq ,temp ,next-temp))))))))
    45 51 
     	    (:list
    46 52 
     	     (let ((temp (gensym))
    47 53 
     		   (map-result (gensym)))

  • tests/list.lisp
    1 
    +(defpackage "LIST-TESTS"
    2 
    +  (:use "COMMON-LISP"
    3 
    +	"LISP-UNIT"))
    4 
    +
    5 
    +(in-package "LIST-TESTS")
    6 
    +
    7 
    +(define-test mapcan-empty-list-returns-nil
    8 
    +  (locally (declare (notinline mapcan))
    9 
    +    (assert-equal '() (mapcan #'identity '())))
    10 
    +  (locally (declare (inline mapcan))
    11 
    +    (assert-equal '() (mapcan #'identity '()))))
    12 
    +
    13 
    +(define-test mapcon-empty-list-returns-nil
    14 
    +  (locally (declare (notinline mapcon))
    15 
    +    (assert-equal '() (mapcon #'identity '())))
    16 
    +  (locally (declare (inline mapcon))
    17 
    +    (assert-equal '() (mapcon #'identity '()))))
    18 
    +
    19 
    +(define-test mapcan-accumulate-non-nil-signals-type-error
    20 
    +  (locally (declare (notinline mapcan))
    21 
    +    (assert-error 'type-error (mapcan #'identity (list 42))))
    22 
    +  (locally (declare (inline mapcan))
    23 
    +    (assert-error 'type-error (mapcan #'identity (list 42)))))
    24 
    +
    25 
    +(define-test mapcon-accumulate-non-nil-signals-type-error
    26 
    +  (locally (declare (notinline mapcan))
    27 
    +    (assert-error 'type-error (mapcon #'car (list 42))))
    28 
    +  (locally (declare (inline mapcan))
    29 
    +    (assert-error 'type-error (mapcon #'car (list 42)))))
    30 
    +
    31 
    +(define-test mapcan-accumulate-nil-returns-nil
    32 
    +  (locally (declare (notinline mapcan))
    33 
    +    (assert-equal '() (mapcan (constantly nil) '(1)))
    34 
    +    (assert-equal '() (mapcan (constantly nil) '(1 2)))
    35 
    +    (assert-equal '() (mapcan (constantly nil) '(1 2 3))))
    36 
    +  (locally (declare (inline mapcan))
    37 
    +    (assert-equal '() (mapcan (constantly nil) '(1)))
    38 
    +    (assert-equal '() (mapcan (constantly nil) '(1 2)))
    39 
    +    (assert-equal '() (mapcan (constantly nil) '(1 2 3)))))
    40 
    +
    41 
    +(define-test mapcon-accumulate-nil-returns-nil
    42 
    +  (locally (declare (notinline mapcon))
    43 
    +    (assert-equal '() (mapcon (constantly nil) '(1)))
    44 
    +    (assert-equal '() (mapcon (constantly nil) '(1 2)))
    45 
    +    (assert-equal '() (mapcon (constantly nil) '(1 2 3))))
    46 
    +  (locally (declare (inline mapcon))
    47 
    +    (assert-equal '() (mapcon (constantly nil) '(1)))
    48 
    +    (assert-equal '() (mapcon (constantly nil) '(1 2)))
    49 
    +    (assert-equal '() (mapcon (constantly nil) '(1 2 3)))))
    50 
    +
    51 
    +(define-test mapcan-accumulate-one-list-returns-same-list
    52 
    +  (locally (declare (notinline mapcan))
    53 
    +    (let ((list1 (list 1)))
    54 
    +      (assert-eq list1 (mapcan (constantly list1) '(nil)))))
    55 
    +  (locally (declare (inline mapcan))
    56 
    +    (let ((list1 (list 1)))
    57 
    +      (assert-eq list1 (mapcan (constantly list1) '(nil))))))
    58 
    +
    59 
    +(define-test mapcon-accumulate-one-list-returns-same-list
    60 
    +  (locally (declare (notinline mapcon))
    61 
    +    (let ((list1 (list 1)))
    62 
    +      (assert-eq list1 (mapcon (constantly list1) '(nil)))))
    63 
    +  (locally (declare (inline mapcon))
    64 
    +    (let ((list1 (list 1)))
    65 
    +      (assert-eq list1 (mapcon (constantly list1) '(nil))))))
    66 
    +
    67 
    +(define-test mapcan-accumulate-two-lists-returns-same-lists
    68 
    +  (locally (declare (notinline mapcan))
    69 
    +    (let* ((list1 (list 1))
    70 
    +	   (list2 (list 2))
    71 
    +	   (list12 (mapcan #'identity (list list1 list2))))
    72 
    +      (assert-eq list1 list12)
    73 
    +      (assert-eq list2 (cdr list12))))
    74 
    +  (locally (declare (inline mapcan))
    75 
    +    (let* ((list1 (list 1))
    76 
    +	   (list2 (list 2))
    77 
    +	   (list12 (mapcan #'identity (list list1 list2))))
    78 
    +      (assert-eq list1 list12)
    79 
    +      (assert-eq list2 (cdr list12)))))
    80 
    +
    81 
    +(define-test mapcon-accumulate-two-lists-returns-same-lists
    82 
    +  (locally (declare (notinline mapcon))
    83 
    +    (let* ((list1 (list 1))
    84 
    +	   (list2 (list 2))
    85 
    +	   (list12 (mapcon #'car (list list1 list2))))
    86 
    +      (assert-eq list1 list12)
    87 
    +      (assert-eq list2 (cdr list12))))
    88 
    +  (locally (declare (inline mapcon))
    89 
    +    (let* ((list1 (list 1))
    90 
    +	   (list2 (list 2))
    91 
    +	   (list12 (mapcon #'car (list list1 list2))))
    92 
    +      (assert-eq list1 list12)
    93 
    +      (assert-eq list2 (cdr list12)))))
    94 
    +
    95 
    +(define-test mapcan-accumulate-two-lists-skips-nil-returns-same-lists
    96 
    +  (locally (declare (notinline mapcan))
    97 
    +    (let* ((list1 (list 1))
    98 
    +	   (list2 (list 2))
    99 
    +	   (list12 (mapcan #'identity (list nil list1 list2))))
    100 
    +      (assert-eq list1 list12)
    101 
    +      (assert-eq list2 (cdr list12)))
    102 
    +    (let* ((list1 (list 1))
    103 
    +	   (list2 (list 2))
    104 
    +	   (list12 (mapcan #'identity (list list1 nil list2))))
    105 
    +      (assert-eq list1 list12)
    106 
    +      (assert-eq list2 (cdr list12)))
    107 
    +    (let* ((list1 (list 1))
    108 
    +	   (list2 (list 2))
    109 
    +	   (list12 (mapcan #'identity (list list1 list2 nil))))
    110 
    +      (assert-eq list1 list12)
    111 
    +      (assert-eq list2 (cdr list12))))
    112 
    +  (locally (declare (inline mapcan))
    113 
    +    (let* ((list1 (list 1))
    114 
    +	   (list2 (list 2))
    115 
    +	   (list12 (mapcan #'identity (list nil list1 list2))))
    116 
    +      (assert-eq list1 list12)
    117 
    +      (assert-eq list2 (cdr list12)))
    118 
    +    (let* ((list1 (list 1))
    119 
    +	   (list2 (list 2))
    120 
    +	   (list12 (mapcan #'identity (list list1 nil list2))))
    121 
    +      (assert-eq list1 list12)
    122 
    +      (assert-eq list2 (cdr list12)))
    123 
    +    (let* ((list1 (list 1))
    124 
    +	   (list2 (list 2))
    125 
    +	   (list12 (mapcan #'identity (list list1 list2 nil))))
    126 
    +      (assert-eq list1 list12)
    127 
    +      (assert-eq list2 (cdr list12)))))
    128 
    +
    129 
    +(define-test mapcon-accumulate-two-lists-skips-nil-returns-same-lists
    130 
    +  (locally (declare (notinline mapcon))
    131 
    +    (let* ((list1 (list 1))
    132 
    +	   (list2 (list 2))
    133 
    +	   (list12 (mapcon #'car (list nil list1 list2))))
    134 
    +      (assert-eq list1 list12)
    135 
    +      (assert-eq list2 (cdr list12)))
    136 
    +    (let* ((list1 (list 1))
    137 
    +	   (list2 (list 2))
    138 
    +	   (list12 (mapcon #'car (list list1 nil list2))))
    139 
    +      (assert-eq list1 list12)
    140 
    +      (assert-eq list2 (cdr list12)))
    141 
    +    (let* ((list1 (list 1))
    142 
    +	   (list2 (list 2))
    143 
    +	   (list12 (mapcon #'car (list list1 list2 nil))))
    144 
    +      (assert-eq list1 list12)
    145 
    +      (assert-eq list2 (cdr list12))))
    146 
    +  (locally (declare (inline mapcon))
    147 
    +    (let* ((list1 (list 1))
    148 
    +	   (list2 (list 2))
    149 
    +	   (list12 (mapcon #'car (list nil list1 list2))))
    150 
    +      (assert-eq list1 list12)
    151 
    +      (assert-eq list2 (cdr list12)))
    152 
    +    (let* ((list1 (list 1))
    153 
    +	   (list2 (list 2))
    154 
    +	   (list12 (mapcon #'car (list list1 nil list2))))
    155 
    +      (assert-eq list1 list12)
    156 
    +      (assert-eq list2 (cdr list12)))
    157 
    +    (let* ((list1 (list 1))
    158 
    +	   (list2 (list 2))
    159 
    +	   (list12 (mapcon #'car (list list1 list2 nil))))
    160 
    +      (assert-eq list1 list12)
    161 
    +      (assert-eq list2 (cdr list12)))))
    162 
    +
    163 
    +(define-test mapcan-accumulate-same-list-twice-returns-circular-list
    164 
    +  (locally (declare (notinline mapcan))
    165 
    +    (let ((list12 (list 1 2)))
    166 
    +      ;; check that list12 equals #1=(1 2 . #1#)
    167 
    +      (assert-eq list12 (mapcan (constantly list12) '(nil nil)))
    168 
    +      (assert-eql 1 (elt list12 0))
    169 
    +      (assert-eql 2 (elt list12 1))
    170 
    +      (assert-eq (nthcdr 2 list12) list12)))
    171 
    +  (locally (declare (inline mapcan))
    172 
    +    (let ((list12 (list 1 2)))
    173 
    +      ;; check that list12 equals #1=(1 2 . #1#)
    174 
    +      (assert-eq list12 (mapcan (constantly list12) '(nil nil)))
    175 
    +      (assert-eql 1 (elt list12 0))
    176 
    +      (assert-eql 2 (elt list12 1))
    177 
    +      (assert-eq (nthcdr 2 list12) list12))))
    178 
    +
    179 
    +(define-test mapcon-accumulate-same-list-twice-returns-circular-list
    180 
    +  (locally (declare (notinline mapcon))
    181 
    +    (let ((list12 (list 1 2)))
    182 
    +      ;; check that list12 equals #1=(1 2 . #1#)
    183 
    +      (assert-eq list12 (mapcon (constantly list12) '(nil nil)))
    184 
    +      (assert-eql 1 (elt list12 0))
    185 
    +      (assert-eql 2 (elt list12 1))
    186 
    +      (assert-eq (nthcdr 2 list12) list12)))
    187 
    +  (locally (declare (notinline mapcon))
    188 
    +    (let ((list12 (list 1 2)))
    189 
    +      ;; check that list12 equals #1=(1 2 . #1#)
    190 
    +      (assert-eq list12 (mapcon (constantly list12) '(nil nil)))
    191 
    +      (assert-eql 1 (elt list12 0))
    192 
    +      (assert-eql 2 (elt list12 1))
    193 
    +      (assert-eq (nthcdr 2 list12) list12))))

  • tests/sets.lisp
    1 
    +;; Tests for sets
    2 
    +
    3 
    +(defpackage :sets-tests
    4 
    +  (:use :cl :lisp-unit))
    5 
    +
    6 
    +(in-package "SETS-TESTS")
    7 
    +
    8 
    +(define-test set-diff.hash-eql
    9 
    +    (:tag :issues)
    10 
    +  ;; For set-difference to use hashtables by making the threshold
    11 
    +  ;; small.
    12 
    +  (let ((lisp::*min-list-length-for-hashtable* 2))
    13 
    +    (assert-equal '(2 2 1)
    14 
    +		  (set-difference '(1 2 2 3) '(3 4)))
    15 
    +    (assert-equal '(2 2 1)
    16 
    +		  (set-difference '(1 2 2 3) '(3 4 5 6 7 8)))
    17 
    +    (assert-equal '(2 2 1)
    18 
    +		  (set-difference '(1 2 2 3) '(3 4)
    19 
    +				  :test #'eql))
    20 
    +    (assert-equal '(2 2 1)
    21 
    +		  (set-difference '(1 2 2 3) '(3 4 5 6 7 8)
    22 
    +				  :test #'eql))))
    23 
    +
    24 
    +(define-test set-diff.hash-eq
    25 
    +    (:tag :issues)
    26 
    +  (let ((lisp::*min-list-length-for-hashtable* 2))
    27 
    +    (assert-equal '(b b a)
    28 
    +		  (set-difference '(a b b c) '(c d e) :test 'eq))
    29 
    +    (assert-equal '(b b a)
    30 
    +		  (set-difference '(a b b c) '(c d e f g h) :test 'eq))
    31 
    +    (assert-equal '(b b a)
    32 
    +		  (set-difference '(a b b c) '(c d e) :test #'eq))
    33 
    +    (assert-equal '(b b a)
    34 
    +		  (set-difference '(a b b c) '(c d e f g h) :test #'eq))))
    35 
    +
    36 
    +(define-test set-diff.hash-equal
    37 
    +    (:tag :issues)
    38 
    +  (let ((lisp::*min-list-length-for-hashtable* 2))
    39 
    +    (assert-equal '("b" "b" "a")
    40 
    +		  (set-difference '("a" "b" "b" "c")
    41 
    +				  '("c" "d" "e")
    42 
    +				  :test 'equal))
    43 
    +    (assert-equal '("b" "b" "a")
    44 
    +		  (set-difference '("a" "b" "b" "c")
    45 
    +				  '("c" "d" "e" "f" "g" "h")
    46 
    +				  :test 'equal))
    47 
    +    (assert-equal '("b" "b" "a")
    48 
    +		  (set-difference '("a" "b" "b" "c")
    49 
    +				  '("c" "d" "e")
    50 
    +				  :test #'equal))
    51 
    +    (assert-equal '("b" "b" "a")
    52 
    +		  (set-difference '("a" "b" "b" "c")
    53 
    +				  '("c" "d" "e" "f" "g" "h")
    54 
    +				  :test #'equal))))
    55 
    +
    56 
    +(define-test set-diff.hash-equalp
    57 
    +    (:tag :issues)
    58 
    +  (let ((lisp::*min-list-length-for-hashtable* 2))
    59 
    +    (assert-equal '("b" "b" "a")
    60 
    +		  (set-difference '("a" "b" "b" "c")
    61 
    +				  '("C" "d" "e")
    62 
    +				  :test 'equalp))
    63 
    +    (assert-equal '("b" "b" "a")
    64 
    +		  (set-difference '("a" "b" "b" "C")
    65 
    +				  '("c" "D" "e" "f" "g" "h")
    66 
    +				  :test 'equalp))
    67 
    +    (assert-equal '("b" "b" "a")
    68 
    +		  (set-difference '("a" "b" "b" "c")
    69 
    +				  '("C" "d" "e")
    70 
    +				  :test #'equalp))
    71 
    +    (assert-equal '("b" "b" "a")
    72 
    +		  (set-difference '("a" "b" "b" "C")
    73 
    +				  '("c" "D" "e" "f" "g" "h")
    74 
    +				  :test #'equalp))))
    75 
    +
    76 
    +;; Simple test that we handle a key correctly
    77 
    +(define-test set-diff.hash-eql-with-key
    78 
    +  (let ((lisp::*min-list-length-for-hashtable* 2))
    79 
    +    (assert-equal '((3 "b") (2 "b"))
    80 
    +		  (set-difference '((1 "a") (2 "b") (3 "b"))
    81 
    +				  '((1 "a") (4 "c") (5 "d"))
    82 
    +				  :key #'first))))
    83 
    +
    84 
    +(define-test set-diff.test-and-test-not
    85 
    +  (assert-error 'simple-error
    86 
    +		(set-difference '(1 2)
    87 
    +				'(3 4)
    88 
    +				:test 'eql
    89 
    +				:test-not 'eql)))
    90 
    +
    91 
    +
    92 
    +
    93 
    +(define-test union.hash-eql
    94 
    +    (:tag :issues)
    95 
    +  ;; For union to use hashtables by making the threshold
    96 
    +  ;; small.
    97 
    +  (let ((lisp::*min-list-length-for-hashtable* 2))
    98 
    +    (assert-equal '(2 2 1 3 4)
    99 
    +		  (union '(1 2 2 3) '(3 4)))
    100 
    +    (assert-equal '(2 2 1 3 4 5 6 7 8)
    101 
    +		  (union '(1 2 2 3) '(3 4 5 6 7 8)))
    102 
    +    (assert-equal '(2 2 1 3 4)
    103 
    +		  (union '(1 2 2 3) '(3 4)
    104 
    +			 :test #'eql))
    105 
    +    (assert-equal '(2 2 1 3 4 5 6 7 8)
    106 
    +		  (union '(1 2 2 3) '(3 4 5 6 7 8)
    107 
    +			 :test #'eql))))
    108 
    +
    109 
    +(define-test union.hash-eq
    110 
    +    (:tag :issues)
    111 
    +  (let ((lisp::*min-list-length-for-hashtable* 2))
    112 
    +    (assert-equal '(b b a c d e)
    113 
    +		  (union '(a b b c) '(c d e) :test 'eq))
    114 
    +    (assert-equal '(b b a c d e f g h)
    115 
    +		  (union '(a b b c) '(c d e f g h) :test 'eq))
    116 
    +    (assert-equal '(b b a c d e)
    117 
    +		  (union '(a b b c) '(c d e) :test #'eq))
    118 
    +    (assert-equal '(b b a c d e f g h)
    119 
    +		  (union '(a b b c) '(c d e f g h) :test #'eq))))
    120 
    +
    121 
    +(define-test union.hash-equal
    122 
    +    (:tag :issues)
    123 
    +  (let ((lisp::*min-list-length-for-hashtable* 2))
    124 
    +    (assert-equal '("b" "b" "a" "c" "d" "e")
    125 
    +		  (union '("a" "b" "b" "c")
    126 
    +			 '("c" "d" "e")
    127 
    +			 :test 'equal))
    128 
    +    (assert-equal '("b" "b" "a" "c" "d" "e" "f" "g" "h")
    129 
    +		  (union '("a" "b" "b" "c")
    130 
    +			 '("c" "d" "e" "f" "g" "h")
    131 
    +			 :test 'equal))
    132 
    +    (assert-equal '("b" "b" "a" "c" "d" "e")
    133 
    +		  (union '("a" "b" "b" "c")
    134 
    +			 '("c" "d" "e")
    135 
    +			 :test #'equal))
    136 
    +    (assert-equal '("b" "b" "a" "c" "d" "e" "f" "g" "h")
    137 
    +		  (union '("a" "b" "b" "c")
    138 
    +			 '("c" "d" "e" "f" "g" "h")
    139 
    +			 :test #'equal))))
    140 
    +
    141 
    +(define-test union.hash-equalp
    142 
    +    (:tag :issues)
    143 
    +  (let ((lisp::*min-list-length-for-hashtable* 2))
    144 
    +    (assert-equal '("b" "b" "a" "C" "d" "e")
    145 
    +		  (union '("a" "b" "b" "c")
    146 
    +			 '("C" "d" "e")
    147 
    +			 :test 'equalp))
    148 
    +    (assert-equal '("b" "b" "a" "c" "D" "e" "f" "g" "h")
    149 
    +		  (union '("a" "b" "b" "C")
    150 
    +			 '("c" "D" "e" "f" "g" "h")
    151 
    +			 :test 'equalp))
    152 
    +    (assert-equal '("b" "b" "a" "C" "d" "e")
    153 
    +		  (union '("a" "b" "b" "c")
    154 
    +			 '("C" "d" "e")
    155 
    +			 :test #'equalp))
    156 
    +    (assert-equal '("b" "b" "a" "c" "D" "e" "f" "g" "h")
    157 
    +		  (union '("a" "b" "b" "C")
    158 
    +			 '("c" "D" "e" "f" "g" "h")
    159 
    +			 :test #'equalp))))
    160 
    +
    161 
    +;; Simple test that we handle a key correctly
    162 
    +(define-test union.hash-eql-with-key
    163 
    +  (let ((lisp::*min-list-length-for-hashtable* 2))
    164 
    +    (assert-equal '((3 "b") (2 "b") (1 "a") (4 "c") (5 "d"))
    165 
    +		  (union '((1 "a") (2 "b") (3 "b"))
    166 
    +			 '((1 "a") (4 "c") (5 "d"))
    167 
    +			 :key #'first))))
    168 
    +
    169 
    +(define-test union.test-and-test-not
    170 
    +  (assert-error 'simple-error
    171 
    +		(union '(1 2)
    172 
    +		       '(3 4)
    173 
    +		       :test 'eql
    174 
    +		       :test-not 'eql)))

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.common-lisp.net. Manage all notifications · Help