1 (cl:defpackage #:collect
3 (cl:in-package #:collect)
5 (declaim (inline make-forward-collector
8 (defun make-forward-collector ()
9 (let ((c (cons nil nil)))
12 (defun forward-collect (c x)
13 (declare (type cons c))
14 (let ((new (cons x nil)))
15 (setf (cdr (car c)) new
17 (defun forward-collection (c)
18 (declare (type cons c))
21 (defmacro with-macro-collector ((collect collection) &body body)
22 (let ((head (gensym "HEAD-"))
23 (tail (gensym "TAIL-"))
24 (item (gensym "ITEM-"))
25 (new (gensym "NEW-")))
26 `(let* ((,head (cons nil nil)) (,tail ,head))
27 (declare (type cons ,head ,tail))
28 (flet ((,collect (,item)
29 (let ((,new (cons ,item nil)))
30 (setf (cdr ,tail) ,new
34 (declare (inline ,collect ,collection))
37 (declaim (inline make-reverse-collector
39 reverse-collection-nondestructively
41 (defun make-reverse-collector ()
43 (defun reverse-collect (c x)
44 (declare (type cons c))
46 (defun reverse-collection-nondestructively (c)
47 (declare (type cons c))
49 (defun reverse-collection (c)
50 (declare (type cons c))
53 (defun measure-strategy (name test-func bench-func)
54 (declare (type (function (fixnum) t) bench-func)
55 (type (function (fixnum) list) test-func))
57 (ref (loop for i below n collect i))
58 (out (funcall test-func n)))
59 (unless (equal out ref)
60 (error "Generator ~A failed" name)))
61 (format t "#> ~A~%" name)
63 (do ((n 0 (if (zerop n) 1 (* 16 n))))
65 (declare (type fixnum n))
66 (multiple-value-bind (cy clk) (funcall bench-func n)
67 (format t "~8D ~12,4,,,,,'eG ~12,4,,,,,'eG~%" n cy clk)))))
72 (macrolet ((bench (name (n) form)
74 (cond (firstp (setf firstp nil))
75 (t (terpri) (terpri)))
76 (measure-strategy ,(etypecase name
78 (symbol (string-downcase name)))
80 (declare (type fixnum ,n))
83 (declare (type fixnum ,n))
85 :per-rep (max ,n 1)))))))
88 (do ((i (1- n) (1- i))
89 (list nil (cons i list)))
91 (declare (type fixnum i))))
94 (let ((c (make-forward-collector)))
96 (declare (type fixnum i))
97 (forward-collect c i))
98 (forward-collection c)))
101 (with-macro-collector (collect collection)
103 (declare (type fixnum i))
108 (let ((c (make-reverse-collector)))
110 (declare (type fixnum i))
111 (reverse-collect c i))
112 (reverse-collection c)))
115 (let ((c (make-reverse-collector)))
117 (declare (type fixnum i))
118 (reverse-collect c i))
119 (reverse-collection-nondestructively c)))
122 (loop for i below n collect i)))))
124 #+(or cl-launch runlisp-script)