Raymond Toy pushed to branch issue-240-union-with-hash-table 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
    ... ... @@ -1113,7 +1113,10 @@
    1113 1113
     	(setf (car l) (cdar l)))
    
    1114 1114
           (setq res (apply function (nreverse args)))
    
    1115 1115
           (case accumulate
    
    1116
    -	(:nconc (setq temp (last (nconc temp res))))
    
    1116
    +	(:nconc (when res
    
    1117
    +		  (let ((next-temp (last res)))
    
    1118
    +		    (rplacd temp res)
    
    1119
    +		    (setq temp next-temp))))
    
    1117 1120
     	(:list (rplacd temp (list res))
    
    1118 1121
     	       (setq temp (cdr temp)))))))
    
    1119 1122
     
    

  • 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
    ... ... @@ -89,6 +89,7 @@
    89 89
     				:test-not 'eql)))
    
    90 90
     
    
    91 91
        
    
    92
    +
    
    92 93
     (define-test union.hash-eql
    
    93 94
         (:tag :issues)
    
    94 95
       ;; For union to use hashtables by making the threshold
    
    ... ... @@ -171,5 +172,3 @@
    171 172
     		       '(3 4)
    
    172 173
     		       :test 'eql
    
    173 174
     		       :test-not 'eql)))
    174
    -
    
    175
    -