Raymond Toy pushed to branch issue-240-intersection-with-hash-table at cmucl / cmucl

Commits:

4 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
    ... ... @@ -1104,7 +1104,10 @@
    1104 1104 
     	(setf (car l) (cdar l)))
    1105 1105 
           (setq res (apply function (nreverse args)))
    1106 1106 
           (case accumulate
    1107 
    -	(:nconc (setq temp (last (nconc temp res))))
    1107 
    +	(:nconc (when res
    1108 
    +		  (let ((next-temp (last res)))
    1109 
    +		    (rplacd temp res)
    1110 
    +		    (setq temp next-temp))))
    1108 1111 
     	(:list (rplacd temp (list res))
    1109 1112 
     	       (setq temp (cdr temp)))))))
    1110 1113

  • 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))))

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