mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-14 05:12:38 -08:00
Code Issues Projects Releases Packages Wiki Activity

New macros for handlig the :COUNT argument in sequence functions.

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2010-05-20 23:25:44 +02:00
parent 56791d24b8
commit efd6488bc6
1 changed files with 29 additions and 7 deletions
Download patch file Download diff file Expand all files Collapse all files

36
src/lsp/seqmacros.lsp
View file

@ -14,6 +14,14 @@
(in-package "SYSTEM")
(defmacro with-count ((count &optional (value count) &key output)
&body body)
`(let ((,count (sequence-count ,value)))
(declare (fixnum ,count))
(if (plusp ,count)
,@body
,output)))
(defmacro with-predicate ((predicate) &body body)
`(let ((,predicate (si::coerce-to-function ,predicate)))
(declare (function ,predicate))
@ -58,9 +66,15 @@
`(locally (declare (optimize (safety 0) (speed 3) (debug 0))) ,@body))
(defmacro do-vector ((elt vector start end
&key from-end output (index (gensym)))
&key from-end output setter (index (gensym)))
&body body)
(with-unique-names (%vector %count)
(when setter
(setf body `((macrolet ((,setter (value)
`(reckless (si::aset ,',%vector
,',index
,value))))
,@body))))
(if from-end
`(do* ((,%vector ,vector)
(,index ,end)
@ -79,8 +93,14 @@
(let ((,elt (reckless (aref ,%vector ,index))))
,@body)))))
(defmacro do-sublist ((elt list start end &key output (index (gensym))) &body body)
(defmacro do-sublist ((elt list start end &key output
setter (index (gensym)))
&body body)
(with-unique-names (%sublist %count)
(when setter
(setf body `((macrolet ((,setter (value)
`(reckless (rplaca ,',%sublist ,value))))
,@body))))
`(do* ((,index ,start (1+ ,index))
(,%sublist (nthcdr ,index ,list) (cdr ,%sublist))
(,%count (- ,end ,index) (1- ,%count)))
@ -90,16 +110,18 @@
(let ((,elt (car ,%sublist)))
,@body))))
(defmacro do-sequence ((elt sequence start end &key (index (gensym)) output specialize)
(defmacro do-sequence ((elt sequence start end &rest args
&key setter index output specialize)
&body body)
(if specialize
(with-unique-names (%sequence)
(setf args (copy-list args))
(remf args :specialize)
(setf args (list* elt %sequence start end args))
`(let ((,%sequence ,sequence))
(if (listp ,%sequence)
(do-sublist (,elt ,%sequence ,start ,end :output ,output :index ,index)
,@body)
(do-vector (,elt ,%sequence ,start ,end :output ,output :index ,index)
,@body))))
(do-sublist ,args ,@body)
(do-vector ,args ,@body))))
(with-unique-names (%sequence %start %i %count)
`(do* ((,%sequence ,sequence)
(,index ,start (1+ ,index))