From 243f68d9f0d3ec5456947968be12ebda45a60883 Mon Sep 17 00:00:00 2001 From: =?utf8?q?David=20V=C3=A1zquez?= Date: Thu, 20 Jun 2013 14:06:57 +0200 Subject: [PATCH] List version of reduce --- src/sequence.lisp | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) diff --git a/src/sequence.lisp b/src/sequence.lisp index cda0b41..789a7c3 100644 --- a/src/sequence.lisp +++ b/src/sequence.lisp @@ -179,3 +179,27 @@ (defun copy-seq (sequence) (subseq sequence 0)) + +;;; Based on the SBCL's reduce implementation +(defun reduce (function sequence &key key from-end (start 0) end (initial-value nil ivp)) + (let ((key (or key #'identity)) + (end (or end (length sequence)))) + (if (= end start) + (if ivp initial-value (funcall function)) + (if from-end + (let ((sequence (nthcdr (- (length sequence) end) (reverse sequence)))) + (do ((count (if ivp start (1+ start)) + (1+ count)) + (sequence (if ivp sequence (cdr sequence)) + (cdr sequence)) + (value (if ivp initial-value (funcall key (car sequence))) + (funcall function (funcall key (car sequence)) value))) + ((>= count end) value))) + (let ((sequence (nthcdr start sequence))) + (do ((count (if ivp start (1+ start)) + (1+ count)) + (sequence (if ivp sequence (cdr sequence)) + (cdr sequence)) + (value (if ivp initial-value (funcall key (car sequence))) + (funcall function value (funcall key (car sequence))))) + ((>= count end) value))))))) -- 1.7.10.4