Skip to content
Find file
Fetching contributors…
Cannot retrieve contributors at this time
91 lines (80 sloc) 2.32 KB
(in-package :loop)
(declaim (inline each))
(defun each (fn generator)
(declare (function generator))
(multiple-value-bind (update-fn end-fn apply-fn) (funcall generator)
(declare (function update-fn end-fn apply-fn))
(loop UNTIL (funcall end-fn)
DO (funcall apply-fn fn)
(funcall update-fn))))
(declaim (inline reduce))
(defun reduce (fn init generator)
(let ((acc init))
(each (lambda (x)
(setf acc (funcall fn acc x)))
generator)
acc))
(declaim (inline collect))
(defun collect (generator)
(nreverse (reduce (lambda (acc x) (cons x acc))
'()
generator)))
(declaim (inline all? any?))
(defun all? (pred-fn generator)
(each (lambda (x)
(unless (funcall pred-fn x)
(return-from all? nil)))
generator)
t)
(defun any? (pred-fn generator)
(each (lambda (x)
(when (funcall pred-fn x)
(return-from any? t)))
generator)
nil)
(declaim (inline max min))
(defun max (score-fn generator)
(let ((max-elem nil)
(max-score nil))
(each (lambda (elem)
(let ((score (funcall score-fn elem)))
(when (or (null max-score)
(< max-score score))
(setf max-elem elem
max-score score))))
generator)
(values max-score max-elem)))
(defun min (score-fn generator)
(let ((min-elem nil)
(min-score nil))
(each (lambda (elem)
(let ((score (funcall score-fn elem)))
(when (or (null min-score)
(< score min-score))
(setf min-elem elem
min-score score))))
generator)
(values min-score min-elem)))
(declaim (inline find))
(defun find (pred-fn generator)
(each (lambda (x)
(when (funcall pred-fn x)
(return-from find (values x t))))
generator)
(values nil nil))
(declaim (inline count))
(defun count (pred-fn generator)
(let ((num 0))
(declare (fixnum num))
(each (lambda (x)
(when (funcall pred-fn x)
(incf num)))
generator)
num))
(declaim (inline sum))
(defun sum (score-fn generator)
(let ((total 0))
(each (lambda (x)
(incf total (funcall score-fn x)))
generator)
total))
Something went wrong with that request. Please try again.