Skip to content
Snippets Groups Projects
macros.lisp 39.7 KiB
Newer Older
dan's avatar
dan committed
	       ,first)
	   (declare (type ,type ,x)
		    (type (or null ,type) ,y)))))))

(defmacro threaded-push (item list next type)
  (let ((x (gensym)))
    `(let ((,x ,item))
       (declare (type ,type ,x)
		(optimize (speed 3) (safety 0)))
       (shiftf (,next ,x) ,list ,x)
       ,x)))

(defmacro threaded-pop (list next type)
  (let ((x (gensym)))
    `(let ((,x ,list))
       (declare (type (or null ,type) ,x)
		(optimize (speed 3) (safety 0)))
       (when ,x
	 (shiftf ,list (,next (the ,type ,x)) nil))
       ,x)))

(defmacro threaded-enqueue (item head tail next type)
  (let ((x (gensym)))
    `(let ((,x ,item))
       (declare (type ,type ,x)
		(optimize (speed 3) (safety 0)))
       (if (null ,tail)
	   (threaded-nconc ,x ,head ,next ,type)
	 (threaded-nconc ,x (,next (the ,type ,tail)) ,next ,type))
       (setf ,tail ,x))))

(defmacro threaded-dequeue (head tail next type)
  (let ((x (gensym)))
    `(let ((,x ,head))
       (declare (type (or null ,type) ,x)
		(optimize (speed 3) (safety 0)))
       (when ,x
	 (when (eq ,x ,tail)
	   (setf ,tail (,next (the ,type ,x))))
	 (setf ,head (,next (the ,type ,x))))
       ,x)))

(defmacro threaded-requeue (item head tail next type)
  (let ((x (gensym)))
    `(let ((,x ,item))
       (declare (type ,type ,x)
		(optimize (speed 3) (safety 0)))
       (if (null ,tail)
	   (setf ,tail (setf ,head ,x))
	 (shiftf (,next ,x) ,head ,x))
       ,x)))

(defmacro threaded-dolist ((variable list next type) &body body)
  `(block nil
     (do* ((,variable ,list (,next (the ,type ,variable))))
	  ((null ,variable))
       (declare (type (or null ,type) ,variable))
       ,@body)))

(defmacro threaded-delete (item list next type)
  (let ((x (gensym))
	(y (gensym))
	(z (gensym))
	(first (gensym)))
    `(let ((,x ,item)
	   (,first ,list))
       (declare (type ,type ,x)
		(type (or null ,type) ,first)
		(optimize (speed 3) (safety 0)))
       (when ,first
	 (if (eq ,first ,x)
	     (setf ,first (setf ,list (,next ,x)))
	   (do* ((,y ,first ,z)
		 (,z (,next ,y) (,next ,y)))
		((or (null ,z) (eq ,z ,x))
		 (when (eq ,z ,x)
		   (setf (,next ,y) (,next ,x))))
	     (declare (type ,type ,y))
	     (declare (type (or null ,type) ,z)))))
       (setf (,next ,x) nil)
       ,first)))

(defmacro threaded-length (list next type)
  (let ((x (gensym))
	(count (gensym)))
    `(do ((,x ,list (,next (the ,type ,x)))
	  (,count 0 (index1+ ,count)))
	 ((null ,x)
	  ,count)
       (declare (type (or null ,type) ,x)
		(type array-index ,count)
		(optimize (speed 3) (safety 0))))))