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

New macros for efficiently traversing arrays and lists

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2010-05-20 16:46:25 +02:00
parent a6f441f8f9
commit f30d551724
1 changed files with 53 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

54
src/lsp/seqmacros.lsp
View file

@ -48,9 +48,61 @@
(funcall ,',%test-fn ,v1 ,v2)))))
,@(if key `((with-key (,key) ,@body)) body)))))
(defmacro with-start-end (start end seq &body body)
(defmacro with-start-end ((start end seq) &body body)
`(multiple-value-bind (,start ,end)
(sequence-start-end 'subseq ,seq ,start ,end)
(declare (fixnum ,start ,end))
,@body))
(defmacro reckless (&body body)
`(locally (declare (optimize (safety 0) (speed 3) (debug 0))) ,@body))
(defmacro do-vector ((elt vector start end &key from-end output) &body body)
(with-unique-names (%vector %i %count)
(if from-end
`(do* ((,%vector ,vector)
(,%i ,end)
(,%count ,start))
((= ,%i ,%count) ,output)
(declare (fixnum ,%i ,%count)
(vector ,%vector))
(let ((,elt (reckless (aref ,%vector (setf ,%i (1- ,%i))))))
,@body))
`(do* ((,%vector ,vector)
(,%i ,start (1+ ,%i))
(,%count ,end))
((= ,%i ,%count) ,output)
(declare (fixnum ,%i ,%count)
(vector ,%vector))
(let ((,elt (reckless (aref ,%vector ,%i))))
,@body)))))
(defmacro do-sublist ((elt list start end &key output) &body body)
(with-unique-names (%sublist %i %count)
`(do* ((,%i ,start)
(,%sublist (nthcdr ,%i ,list) (cdr ,%sublist))
(,%count (- ,end ,%i) (1- ,%count)))
((<= ,%count 0) ,output)
(declare (fixnum ,%i ,%count)
(cons ,%sublist))
(let ((,elt (car ,%sublist)))
,@body))))
(defmacro do-sequence ((elt sequence start end &key output specialize) &body body)
(if specialize
(with-unique-names (%sequence)
`(let ((,%sequence ,sequence))
(if (listp ,%sequence)
(do-sublist (,elt ,%sequence ,start ,end :output ,output)
,@body)
(do-vector (,elt ,%sequence ,start ,end :output ,output)
,@body))))
(with-unique-names (%sequence %start %i %count)
`(do* ((,%sequence ,sequence)
(,%start ,start)
(,%i (make-seq-iterator ,%sequence ,%start)
(seq-iterator-next ,%sequence ,%i))
(,%count (- ,end ,start) (1- ,%count)))
((or (null ,%i) (not (plusp ,%count))) ,output)
(let ((,elt (seq-iterator-ref ,%sequence ,%i)))
,@body)))))