/[gcl]/gcl/lsp/gcl_seq.lsp
ViewVC logotype

Diff of /gcl/lsp/gcl_seq.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.4 by camm, Tue Aug 9 00:46:01 2005 UTC revision 1.5 by pfdietz, Sat Aug 27 14:29:19 2005 UTC
# Line 113  Line 113 
113    
114    
115  (defun some (predicate sequence &rest more-sequences)  (defun some (predicate sequence &rest more-sequences)
116    (setq more-sequences (cons sequence more-sequences))    (cond
117    (do ((i 0 (1+ i))      ((and (listp sequence) (null more-sequences))
118         (l (apply #'min (mapcar #'length more-sequences))))       ;; special case -- only one sequence, and it's a list
119        ((>= i l) nil)       (dolist (e sequence nil)
120      (declare (fixnum i l))         (let ((that-value (funcall predicate e)))
121      (let ((that-value           (when that-value (return that-value)))))
122             (apply predicate      (t
123                    (mapcar #'(lambda (z) (elt z i)) more-sequences))))       (setq more-sequences (cons sequence more-sequences))
124        (when that-value (return that-value)))))       (do ((i 0 (1+ i))
125              (l (apply #'min (mapcar #'length more-sequences))))
126             ((>= i l) nil)
127           (declare (fixnum i l))
128           (let ((that-value
129                  (apply predicate
130                         (mapcar #'(lambda (z) (elt z i)) more-sequences))))
131             (when that-value (return that-value)))))))
132    
133  (defun every (predicate sequence &rest more-sequences)  (defun every (predicate sequence &rest more-sequences)
134    (setq more-sequences (cons sequence more-sequences))    (cond
135    (do ((i 0 (1+ i))      ((and (listp sequence) (null more-sequences))
136         (l (apply #'min (mapcar #'length more-sequences))))       ;; special case -- only one sequence, and it's a list
137        ((>= i l) t)       (dolist (e sequence t)
138      (declare (fixnum i l))         (unless (funcall predicate e) (return nil))))
139      (unless (apply predicate (mapcar #'(lambda (z) (elt z i)) more-sequences))      (t
140              (return nil))))       (setq more-sequences (cons sequence more-sequences))
141         (do ((i 0 (1+ i))
142              (l (apply #'min (mapcar #'length more-sequences))))
143             ((>= i l) t)
144           (declare (fixnum i l))
145           (unless (apply predicate (mapcar #'(lambda (z) (elt z i)) more-sequences))
146             (return nil))))))
147    
148    
149  (defun notany (predicate sequence &rest more-sequences)  (defun notany (predicate sequence &rest more-sequences)

Legend:
Removed from v.1.4  
changed lines
  Added in v.1.5

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26