Updated list library to most recent revision of the SRFI. Olin

This commit is contained in:
marting 1999-10-05 18:49:20 +00:00
parent dbf3e322eb
commit 19995a158c
4 changed files with 567 additions and 192 deletions

View File

@ -26,15 +26,19 @@
;;; take drop
;;; take-right drop-right
;;; take! drop-right!
;;; split-at split-at!
;;; last last-pair
;;; zip unzip1 unzip2 unzip3 unzip4 unzip5
;;; count
;;; append! append-reverse append-reverse!
;;; unfold fold fold-right pair-fold pair-fold-right reduce reduce-right
;;; append! append-reverse append-reverse! concatenate concatenate!
;;; unfold fold pair-fold reduce
;;; unfold-right fold-right pair-fold-right reduce-right
;;; append-map append-map! map! pair-for-each filter-map map-in-order
;;; filter partition remove
;;; filter! partition! remove!
;;; find find-tail any every list-index
;;; take-while drop-while take-while!
;;; span break span! break!
;;; delete delete!
;;; alist-cons alist-copy
;;; delete-duplicates delete-duplicates!
@ -246,7 +250,7 @@
;;; (cons* a1 a2 ... an) = (cons a1 (cons a2 (cons ... an)))
;;; (cons* a1) = a1 (cons* a1 a2 ...) = (cons a1 (cons* a2 ...))
;;;
;;; (cons first (unfold-right not-pair? car cdr rest values))
;;; (cons first (unfold not-pair? car cdr rest values))
(define (cons* first . rest)
(let recur ((x first) (rest rest))
@ -254,7 +258,7 @@
(cons x (recur (car rest) (cdr rest)))
x)))
;;; (unfold-right not-pair? car cdr lis values)
;;; (unfold not-pair? car cdr lis values)
(define (list-copy lis)
(let recur ((lis lis))
@ -571,6 +575,21 @@
; lis)))
; (list-tail lis k)))
(define (split-at x k)
(check-arg integer? k split-at)
(let recur ((lis x) (k k))
(if (zero? k) (values '() lis)
(receive (prefix suffix) (recur (cdr lis) (- k 1))
(values (cons (car lis) prefix) suffix)))))
(define (split-at! x k)
(check-arg integer? k split-at!)
(if (zero? k) (values '() x)
(let* ((prev (drop x (- k 1)))
(suffix (cdr prev)))
(set-cdr! prev '())
(values x suffix))))
(define (last lis) (car (last-pair lis)))
@ -625,8 +644,8 @@
(cons (car (cddddr elt)) e)))))))
;;; append! append-reverse append-reverse!
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; append! append-reverse append-reverse! concatenate concatenate!
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (append! . lists)
;; First, scan through lists looking for a non-empty one.
@ -679,6 +698,8 @@
(lp next-rev rev-head)))))
(define (concatenate lists) (reduce-right append '() lists))
(define (concatenate! lists) (reduce-right append! '() lists))
;;; Fold/map internal utilities
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -778,25 +799,25 @@
;;; fold/unfold
;;;;;;;;;;;;;;;
(define (unfold p f g seed . maybe-tail)
(check-arg procedure? p unfold)
(check-arg procedure? f unfold)
(check-arg procedure? g unfold)
(define (unfold-right p f g seed . maybe-tail)
(check-arg procedure? p unfold-right)
(check-arg procedure? f unfold-right)
(check-arg procedure? g unfold-right)
(let lp ((seed seed) (ans (:optional maybe-tail '())))
(if (p seed) ans
(lp (g seed)
(cons (f seed) ans)))))
(define (unfold-right p f g seed . maybe-tail-gen)
(check-arg procedure? p unfold-right)
(check-arg procedure? f unfold-right)
(check-arg procedure? g unfold-right)
(define (unfold p f g seed . maybe-tail-gen)
(check-arg procedure? p unfold)
(check-arg procedure? f unfold)
(check-arg procedure? g unfold)
(if (pair? maybe-tail-gen)
(let ((tail-gen (car maybe-tail-gen)))
(if (pair? (cdr maybe-tail-gen))
(apply error "Too many arguments" unfold-right p f g seed maybe-tail-gen)
(apply error "Too many arguments" unfold p f g seed maybe-tail-gen)
(let recur ((seed seed))
(if (p seed) (tail-gen seed)
@ -1252,11 +1273,8 @@
(filter! (lambda (elt) (not (= key (car elt)))) alist)))
;;; find find-tail any every list-index
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; ANY returns the first true value produced by PRED.
;;; FIND returns the first list elt passed by PRED.
;;; find find-tail take-while drop-while span break any every list-index
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (find pred list)
(cond ((find-tail pred list) => car)
@ -1269,6 +1287,58 @@
(if (pred (car list)) list
(lp (cdr list))))))
(define (take-while pred lis)
(check-arg procedure? pred take-while)
(let recur ((lis lis))
(if (null-list? lis) '()
(let ((x (car lis)))
(if (pred x)
(cons x (recur (cdr lis)))
'())))))
(define (drop-while pred lis)
(check-arg procedure? pred drop-while)
(let lp ((lis lis))
(if (null-list? lis) '()
(if (pred (car lis))
(lp (cdr lis))
lis))))
(define (take-while! pred lis)
(check-arg procedure? pred take-while!)
(if (or (null-list? lis) (not (pred (car lis)))) '()
(begin (let lp ((prev lis) (rest (cdr lis)))
(if (pair? rest)
(let ((x (car rest)))
(if (pred x) (lp rest (cdr rest))
(set-cdr! prev '())))))
lis)))
(define (span pred lis)
(check-arg procedure? pred span)
(let recur ((lis lis))
(if (null-list? lis) (values '() '())
(let ((x (car lis)))
(if (pred x)
(receive (prefix suffix) (recur (cdr lis))
(values (cons x prefix) suffix))
(values '() lis))))))
(define (span! pred lis)
(check-arg procedure? pred span!)
(if (or (null-list? lis) (not (pred (car lis)))) (values '() lis)
(let ((suffix (let lp ((prev lis) (rest (cdr lis)))
(if (null-list? rest) rest
(let ((x (car rest)))
(if (pred x) (lp rest (cdr rest))
(begin (set-cdr! prev '())
rest)))))))
(values lis suffix))))
(define (break pred lis) (span (lambda (x) (not (pred x))) lis))
(define (break! pred lis) (span! (lambda (x) (not (pred x))) lis))
(define (any pred lis1 . lists)
(check-arg procedure? pred any)
(if (pair? lists)
@ -1315,8 +1385,6 @@
(if (null-list? tail)
(pred head) ; Last PRED app is tail call.
(and (pred head) (lp (car tail) (cdr tail))))))))
(define (list-index pred lis1 . lists)
(check-arg procedure? pred list-index)

View File

@ -13,17 +13,21 @@
;;; take drop
;;; take-right drop-right
;;; take! drop-right!
;;; take-while drop-while take-while!
;;; split-at split-at!
;;; span break
;;; span! break!
;;; last last-pair
;;; length+
;;; append! reverse! append-reverse append-reverse!
;;; append! reverse! append-reverse append-reverse! concatenate concatenate!
;;; zip unzip1 unzip2 unzip3 unzip4 unzip5
;;; count
;;; unfold unfold-right
;;; fold unfold pair-fold reduce
;;; fold-right unfold-right pair-fold-right reduce-right
;;; append-map append-map! map! pair-for-each filter-map map-in-order
;;; filter partition remove
;;; filter! partition! remove!
;;; filter partition remove
;;; filter! partition! remove!
;;; find find-tail any every list-index
;;; delete delete! delete-duplicates delete-duplicates!
;;; alist-cons alist-copy
@ -87,6 +91,9 @@
((take drop take-right drop-right take! drop-right!)
(proc (:value :exact-integer) :value))
((split-at split-at!)
(proc (:value :exact-integer) (some-values :value :value)))
(last (proc (:pair) :value))
(last-pair (proc (:pair) :pair))
@ -94,6 +101,7 @@
(append! (proc (:value &rest :value) :value))
(reverse! (proc (:value) :value))
((append-reverse append-reverse!) (proc (:value :value) :value))
((concatenate concatenate!) (proc (:value) :value))
(zip (proc (:value &rest :value) :value))
(unzip1 (proc (:value) :value))
@ -138,6 +146,12 @@
((find find-tail) (proc ((proc (:value) :boolean) :value) :value))
((take-while take-while! drop-while)
(proc ((proc (:value) :boolean) :value) :value))
((span break span! break!)
(proc ((proc (:value) :boolean) :value) (some-values :value :value)))
((any every)
(proc ((proc (:value &rest :value) :value) :value &rest :value) :value))

View File

@ -253,7 +253,7 @@ implementation. I have placed this source on the Net with an unencumbered,
</ul>
<li>It is written for clarity and well-commented. The current source is
706 lines of source code and 818 lines of comments and white space.
768 lines of source code and 826 lines of comments and white space.
<li>It is written for efficiency. Fast paths are provided for common
cases. Side-effecting procedures such as <code>filter!</code> avoid unnecessary,
@ -310,15 +310,16 @@ extended <a href="#R5RS">R5RS</a></abbr>
<a href="#take">take</a> <a href="#drop">drop</a>
<a href="#take-right">take-right</a> <a href="#drop-right">drop-right</a>
<a href="#take!">take!</a> <a href="#drop-right!">drop-right!</a>
<a href="#split-at">split-at</a> <a href="#split-at!">split-at!</a>
<a href="#last">last</a> <a href="#last-pair">last-pair</a>
</pre>
<dt class=proc-index> Miscellaneous: length, append, reverse, zip &amp; count
<dt class=proc-index> Miscellaneous: length, append, concatenate, reverse, zip &amp; count
<dd class=proc-index>
<pre class=proc-index>
<span class=r5rs-proc><a href="#length">length</a></span> <a href="#length+">length+</a>
<span class=r5rs-proc><a href="#append">append</a> <a href="#reverse">reverse</a></span>
<a href="#append!">append!</a> <a href="#reverse!">reverse!</a>
<span class=r5rs-proc><a href="#append">append</a></span> <a href="#concatenate">concatenate</a> <span class=r5rs-proc><a href="#reverse">reverse</a></span>
<a href="#append!">append!</a> <a href="#concatenate!">concatenate!</a> <a href="#reverse!">reverse!</a>
<a href="#append-reverse">append-reverse</a> <a href="#append-reverse!">append-reverse!</a>
<a href="#zip">zip</a> <a href="#unzip1">unzip1</a> <a href="#unzip2">unzip2</a> <a href="#unzip3">unzip3</a> <a href="#unzip4">unzip4</a> <a href="#unzip5">unzip5</a>
<a href="#count">count</a>
@ -348,6 +349,8 @@ extended <a href="#R5RS">R5RS</a></abbr>
<a href="#find">find</a> <a href="#find-tail">find-tail</a>
<a href="#any">any</a> <a href="#every">every</a>
<a href="#list-index">list-index</a>
<a href="#take-while">take-while</a> <a href="#drop-while">drop-while</a> <a href="#take-while!">take-while!</a>
<a href="#span">span</a> <a href="#break">break</a> <a href="#span!">span!</a> <a href="#break!">break!</a>
</pre>
<dt class=proc-index> Deleting
@ -563,10 +566,11 @@ operators, so we don't want to exclude these possible implementations.
<p>
The linear-update procedures in this library are
<div class=indent><code>
take! drop-right!
append! reverse! append-reverse!
take! drop-right! split-at!
append! concatenate! reverse! append-reverse!
append-map! map!
filter! partition! remove!
take-while! span! break!
delete! alist-delete! delete-duplicates!
lset-adjoin! lset-union! lset-intersection!
lset-difference! lset-xor! lset-diff+intersection!
@ -1242,6 +1246,33 @@ partition the entire universe of Scheme values.
</pre>
<!--
==== split-at!
==== split-at
============================================================================-->
<dt class=proc-def1>
<a name="split-at"></a>
<code class=proc-def>split-at&nbsp;</code><var> x i -&gt; [list object]</var>
<dt class=proc-defn>
<a name="split-at!"></a>
<code class=proc-def>split-at!</code><var> x i -&gt; [list object]</var>
<dd class=proc-def>
<code>split-at</code> splits the list <var>x</var>
at index <var>i</var>, returning a list of the
first <var>i</var> elements, and the remaining tail. It is equivalent
to
<pre class=code-example>
(values (take x i) (drop x i))
</pre>
<code>split-at!</code> is the linear-update variant. It is allowed, but not
required, to alter the argument list to produce the result.
<pre class=code-example>
(split-at '(a b c d e f g h) 3) =>
(a b c)
(d e f g h)
</pre>
<!--
==== last-pair
==== last
@ -1266,7 +1297,7 @@ partition the entire universe of Scheme values.
</dl>
<!--========================================================================-->
<h2><a name="Miscellaneous">Miscellaneous: length, append, reverse, zip &amp; count</a></h2>
<h2><a name="Miscellaneous">Miscellaneous: length, append, concatenate, reverse, zip &amp; count</a></h2>
<dl>
<!--
@ -1330,6 +1361,40 @@ partition the entire universe of Scheme values.
The last argument is never altered; the result
list shares structure with this parameter.
<!--
==== concatenate concatenate!
============================================================================-->
<dt class=proc-def1>
<a name="concatenate"></a>
<code class=proc-def>concatenate&nbsp;</code><var> list-of-lists -&gt; value</var>
<dt class=proc-defn>
<a name="concatenate!"></a>
<code class=proc-def>concatenate!</code><var> list-of-lists -&gt; value</var>
<dd class=proc-def>
These functions append the elements of their argument together.
That is, <code>concatenate</code> returns
<pre class=code-example>
(apply append list-of-lists)
</pre>
or, equivalently,
<pre class=code-example>
(reduce-right append '() list-of-lists)
</pre>
<code>concatenate!</code> is the linear-update variant, defined in
terms of <code>append!</code> instead of <code>append</code>.
<p>
Note that some Scheme implementations do not support passing more than a
certain number (<em>e.g.</em>, 64) of arguments to an n-ary procedure.
In these implementations, the <code>(apply append ...)</code> idiom
would fail when applied to long lists,
but <code>concatenate</code> would continue to function properly.
<p>
As with <code>append</code> and <code>append!</code>,
the last element of the input list may be any value at all.
<!--
==== reverse reverse!
============================================================================-->
@ -1643,6 +1708,11 @@ Otherwise, return <code>(fold <var>f</var> (car <var>list</var>) (cdr <var>li
Note: MIT Scheme and Haskell flip F's arg order for their <code>reduce</code> and
<code>fold</code> functions.
<pre class=code-example>
;; Take the max of a list of non-negative integers.
(reduce max 0 nums) ; i.e., (apply max 0 nums)
</pre>
<!--
==== reduce-right
============================================================================-->
@ -1661,14 +1731,103 @@ Otherwise, return <code>(fold <var>f</var> (car <var>list</var>) (cdr <var>li
...in other words, we compute
<code>(fold-right <var>f</var> <var>ridentity</var> <var>list</var>)</code>.
<pre class=code-example>
;; Append a bunch of lists together.
;; I.e., (apply append list-of-lists)
(reduce-right append '() list-of-lists)
</pre>
<!--
==== unfold
============================================================================-->
<dt class=proc-def>
<a name="unfold"></a>
<code class=proc-def>unfold</code><var> p f g seed [tail] -&gt; list</var>
<code class=proc-def>unfold</code><var> p f g seed [tail-gen] -&gt; list</var>
<dd class=proc-def>
<code>unfold</code> constructs a list with the following loop:
<code>unfold</code> is best described by its basic recursion:
<pre class=code-example>
(unfold <var>p</var> <var>f</var> <var>g</var> <var>seed</var>) =
(if (<var>p</var> <var>seed</var>) (<var>tail-gen</var> <var>seed</var>)
(cons (<var>f</var> <var>seed</var>)
(unfold <var>p</var> <var>f</var> <var>g</var> (<var>g</var> <var>seed</var>))))
</pre>
<dl>
<dt> <var>p</var> <dd> Determines when to stop unfolding.
<dt> <var>f</var> <dd> Maps each seed value to the corresponding list element.
<dt> <var>g</var> <dd> Maps each seed value to next seed value.
<dt> <var>seed</var> <dd> The "state" value for the unfold.
<dt> <var>tail-gen</var> <dd> Creates the tail of the list;
defaults to <code>(lambda (x) '())</code>
</dl>
<p>
In other words, we use <var>g</var> to generate a sequence of seed values
<div class=indent>
<var>seed</var>, <var>g</var>(<var>seed</var>), <var>g<sup>2</sup></var>(<var>seed</var>), <var>g<sup>3</sup></var>(<var>seed</var>), ...
</div>
These seed values are mapped to list elements by <var>f</var>,
producing the elements of the result list in a left-to-right order.
<var>P</var> says when to stop.
<p>
<code>unfold</code> is the fundamental recursive list constructor,
just as <code>fold-right</code> is
the fundamental recursive list consumer.
While <code>unfold</code> may seem a bit abstract
to novice functional programmers, it can be used in a number of ways:
<pre class=code-example>
;; List of squares: 1^2 ... 10^2
(unfold (lambda (x) (&gt; x 10))
(lambda (x) (* x x))
(lambda (x) (+ x 1))
1)
(unfold null-list? car cdr lis) ; Copy a proper list.
;; Read current input port into a list of values.
(unfold eof-object? values (lambda (x) (read)) (read))
;; Copy a possibly non-proper list:
(unfold not-pair? car cdr lis
values)
;; Append HEAD onto TAIL:
(unfold null-list? car cdr head
(lambda (x) tail))
</pre>
Interested functional programmers may enjoy noting that
<code>fold-right</code> and <code>unfold</code>
are in some sense inverses.
That is, given operations <var>knull?</var>, <var>kar</var>,
<var>kdr</var>, <var>kons</var>, and <var>knil</var> satisfying
<div class=indent>
<code>(<var>kons</var> (<var>kar</var> <var>x</var>) (<var>kdr</var> <var>x</var>))</code> = <code>x</code>
and
<code>(<var>knull?</var> <var>knil</var>)</code> = <code>#t</code>
</div>
then
<div class=indent>
<code>(fold-right <var>kons</var> <var>knil</var> (unfold <var>knull?</var> <var>kar</var> <var>kdr</var> <var>x</var>))</code> = <var>x</var>
</div>
and
<div class=indent>
<code>(unfold <var>knull?</var> <var>kar</var> <var>kdr</var> (fold-right <var>kons</var> <var>knil</var> <var>x</var>))</code> = <var>x</var>.
</div>
This combinator sometimes is called an "anamorphism;" when an
explicit <var>tail-gen</var> procedure is supplied, it is called an
"apomorphism."
<!--
==== unfold-right
============================================================================-->
<dt class=proc-def>
<a name="unfold-right"></a>
<code class=proc-def>unfold-right</code><var> p f g seed [tail] -&gt; list</var>
<dd class=proc-def>
<code>unfold-right</code> constructs a list with the following loop:
<pre class=code-example>
(let lp ((seed seed) (lis tail))
(if (p seed) lis
@ -1683,103 +1842,39 @@ Otherwise, return <code>(fold <var>f</var> (car <var>list</var>) (cdr <var>li
<dt> <var>tail</var> <dd> list terminator; defaults to <code>'()</code>.
</dl>
<p>
<code>unfold</code> is the fundamental iterative list constructor,
In other words, we use <var>g</var> to generate a sequence of seed values
<div class=indent>
<var>seed</var>, <var>g</var>(<var>seed</var>), <var>g<sup>2</sup></var>(<var>seed</var>), <var>g<sup>3</sup></var>(<var>seed</var>), ...
</div>
These seed values are mapped to list elements by <var>f</var>,
producing the elements of the result list in a right-to-left order.
<var>P</var> says when to stop.
<p>
<code>unfold-right</code> is the fundamental iterative list constructor,
just as <code>fold</code> is the
fundamental iterative list consumer.
While <code>unfold</code> may seem a bit abstract
to novice functional programmers, it can be used in a number of ways:
<pre class=code-example>
;; List of squares: 1^2 ... 10^2
(unfold zero?
(lambda (x) (* x x))
(lambda (x) (- x 1))
10)
;; Reverse a proper list.
(unfold null-list? car cdr lis)
;; Read current input port into a list of values.
(unfold eof-object? values (lambda (x) (read)) (read))
;; (append-reverse rev-head tail)
(unfold null-list? car cdr rev-head tail)
</pre>
Interested functional programmers may enjoy noting that
<code>fold</code> and <code>unfold</code>
are in some sense inverses.
That is, given operations <var>knull?</var>, <var>kar</var>,
<var>kdr</var>, <var>kons</var>, and <var>knil</var> satisfying
<div class=indent>
<code>(<var>kons</var> (<var>kar</var> <var>x</var>) (<var>kdr</var> <var>x</var>))</code> = <code>x</code>
and
<code>(<var>knull?</var> <var>knil</var>)</code> = <code>#t</code>
</div>
then
<div class=indent>
<code>(fold <var>kons</var> <var>knil</var> (unfold <var>knull?</var> <var>kar</var> <var>kdr</var> <var>x</var>))</code> = <var>x</var>
</div>
and
<div class=indent>
<code>(unfold <var>knull?</var> <var>kar</var> <var>kdr</var> (fold <var>kons</var> <var>knil</var> <var>x</var>))</code> = <var>x</var>.
</div>
This combinator presumably has some pretentious mathematical name;
interested readers are invited to communicate it to the author.
<!--
==== unfold-right
============================================================================-->
<dt class=proc-def>
<a name="unfold-right"></a>
<code class=proc-def>unfold-right</code><var> p f g seed [tail-gen] -&gt; list</var>
<dd class=proc-def>
<code>unfold</code> is best described by its basic recursion:
<pre class=code-example>
(unfold-right <var>p</var> <var>f</var> <var>g</var> <var>seed</var>) =
(if (<var>p</var> <var>seed</var>) (<var>tail-gen</var> <var>seed</var>)
(cons (<var>f</var> <var>seed</var>)
(unfold-right <var>p</var> <var>f</var> <var>g</var> (<var>g</var> <var>seed</var>))))
</pre>
<dl>
<dt> <var>p</var> <dd> Determines when to stop unfolding.
<dt> <var>f</var> <dd> Maps each seed value to the corresponding list element.
<dt> <var>g</var> <dd> Maps each seed value to next seed value.
<dt> <var>seed</var> <dd> The "state" value for the unfold.
<dt> <var>tail-gen</var> <dd> Creates the tail of the list;
defaults to <code>(lambda (x) '())</code>
</dl>
<p>
<code>unfold-right</code> is the fundamental recursive list constructor,
just as <code>fold-right</code> is
the fundamental recursive list consumer.
While <code>unfold-right</code> may seem a bit abstract
to novice functional programmers, it can be used in a number of ways:
<pre class=code-example>
;; List of squares: 1^2 ... 10^2
(unfold-right (lambda (x) (&gt; x 10))
(unfold-right zero?
(lambda (x) (* x x))
(lambda (x) (+ x 1))
1)
(unfold-right null-list? car cdr lis) ; Copy a proper list.
(lambda (x) (- x 1))
10)
;; Reverse a proper list.
(unfold-right null-list? car cdr lis)
;; Read current input port into a list of values.
(unfold-right eof-object? values (lambda (x) (read)) (read))
;; Copy a possibly non-proper list:
(unfold-right not-pair? car cdr lis
values)
;; Append HEAD onto TAIL:
(unfold-right null-list? car cdr head
(lambda (x) tail))
;; (append-reverse rev-head tail)
(unfold-right null-list? car cdr rev-head tail)
</pre>
Interested functional programmers may enjoy noting that
<code>fold-right</code> and <code>unfold-right</code>
<code>fold</code> and <code>unfold-right</code>
are in some sense inverses.
That is, given operations <var>knull?</var>, <var>kar</var>,
<var>kdr</var>, <var>kons</var>, and <var>knil</var> satisfying
@ -1790,17 +1885,15 @@ Otherwise, return <code>(fold <var>f</var> (car <var>list</var>) (cdr <var>li
</div>
then
<div class=indent>
<code>(fold-right <var>kons</var> <var>knil</var> (unfold-right <var>knull?</var> <var>kar</var> <var>kdr</var> <var>x</var>))</code> = <var>x</var>
<code>(fold <var>kons</var> <var>knil</var> (unfold-right <var>knull?</var> <var>kar</var> <var>kdr</var> <var>x</var>))</code> = <var>x</var>
</div>
and
<div class=indent>
<code>(unfold-right <var>knull?</var> <var>kar</var> <var>kdr</var> (fold-right <var>kons</var> <var>knil</var> <var>x</var>))</code> = <var>x</var>.
<code>(unfold-right <var>knull?</var> <var>kar</var> <var>kdr</var> (fold <var>kons</var> <var>knil</var> <var>x</var>))</code> = <var>x</var>.
</div>
This combinator sometimes is called an "anamorphism;" when an
explicit <var>tail-gen</var> procedure is supplied, it is called an
"apomorphism."
This combinator presumably has some pretentious mathematical name;
interested readers are invited to communicate it to the author.
<!--
==== map
@ -2194,6 +2287,104 @@ representatives:
In the circular-list case, this procedure "rotates" the list.
<p>
<code>Find-tail</code> is essentially <code>drop-while</code>,
where the sense of the predicate is inverted:
<code>Find-tail</code> searches until it finds an element satisfying
the predicate; <code>drop-while</code> searches until it finds an
element that <em>doesn't</em> satisfy the predicate.
<!--
==== take-while take-while!
============================================================================-->
<dt class=proc-def1>
<a name="take-while"></a>
<code class=proc-def>take-while&nbsp;</code><var> pred clist -&gt; list</var>
<dt class=proc-defn>
<a name="take-while!"></a>
<code class=proc-def>take-while!</code><var> pred clist -&gt; list</var>
<dd class=proc-def>
Returns the longest initial prefix of <var>clist</var> whose elements all
satisfy the predicate <var>pred</var>.
<p>
<code>Take-while!</code> is the linear-update variant. It is allowed, but not
required, to alter the argument list to produce the result.
<pre class=code-example>
(take-while even? '(2 18 3 10 22 9)) => (2 18)
</pre>
<!--
==== drop-while
============================================================================-->
<dt class=proc-def>
<a name="drop-while"></a>
<code class=proc-def>drop-while</code><var> pred clist -&gt; list</var>
<dd class=proc-def>
Drops the longest initial prefix of <var>clist</var> whose elements all
satisfy the predicate <var>pred</var>, and returns the rest of the list.
<pre class=code-example>
(drop-while even? '(2 18 3 10 22 9)) => (3 10 22 9)
</pre>
The circular-list case may be viewed as "rotating" the list.
<!--
==== span span! break break!
============================================================================-->
<dt class=proc-def1>
<a name="span"></a>
<code class=proc-def>span&nbsp;&nbsp;</code><var> pred clist -&gt; [list clist]</var>
<dt class=proc-defi>
<a name="span!"></a>
<code class=proc-def>span!&nbsp;</code><var> pred list&nbsp; -&gt; [list list]</var>
<dt class=proc-defi>
<a name="break"></a>
<code class=proc-def>break&nbsp;</code><var> pred clist -&gt; [list clist]</var>
<dt class=proc-defn>
<a name="break!"></a>
<code class=proc-def>break!</code><var> pred list&nbsp; -&gt; [list list]</var>
<dd class=proc-def>
<code>Span</code> splits the list into the longest initial prefix whose
elements all satisfy <var>pred</var>, and the remaining tail.
<code>Break</code> inverts the sense of the predicate:
the tail commences with the first element of the input list
that satisfies the predicate.
<p>
In other words:
<code>span</code> finds the intial span of elements
satisfying <var>pred</var>,
and <code>break</code> breaks the list at the first element satisfying
<var>pred</var>.
<p>
<code>Span</code> is equivalent to
<pre class=code-example>
(values (take-while <var>pred</var> <var>clist</var>)
(drop-while <var>pred</var> <var>clist</var>))
</pre>
<p>
<code>Span!</code> and <code>break!</code> are the linear-update variants.
They are allowed, but not required,
to alter the argument list to produce the result.
<pre class=code-example>
(span even? '(2 18 3 10 22 9)) =>
(2 18)
(3 10 22 9)
(break even? '(3 1 4 1 5 9)) =>
(3 1)
(4 1 5 9)
</pre>
<!--
==== any
============================================================================-->

View File

@ -1,7 +1,7 @@
The SRFI-1 list library -*- outline -*-
Olin Shivers
98/10/16
Last Update: 99/10/2
Last Update: 99/10/3
Emacs should display this document in outline mode. Say c-h m for
instructions on how to move through it by sections (e.g., c-c c-n, c-c c-p).
@ -93,7 +93,7 @@ implementation. I have placed this source on the Net with an unencumbered,
- Use of a simple CHECK-ARG procedure for argument checking.
- It is written for clarity and well-commented. The current source is
706 lines of source code and 818 lines of comments and white space.
768 lines of source code and 826 lines of comments and white space.
- It is written for efficiency. Fast paths are provided for common
cases. Side-effecting procedures such as FILTER! avoid unnecessary,
@ -137,13 +137,15 @@ Selectors
take drop
take-right drop-right
take! drop-right!
split-at split-at!
last last-pair
Miscellaneous: length, append, reverse, zip & count
Miscellaneous: length, append, concatenate, reverse, zip & count
# length
length+
# append reverse
append! reverse!
concatenate concatenate!
append-reverse append-reverse!
zip unzip1 unzip2 unzip3 unzip4 unzip5
count
@ -157,14 +159,16 @@ Fold, unfold & map
Filtering & partitioning
filter partition remove
filter! partition! remove!
filter! partition! remove!
Searching
+ member
# memq memv
find find-tail
find
any every
list-index
take-while drop-while take-while!
span break span! break!
Deleting
delete delete-duplicates
@ -724,6 +728,20 @@ drop-right! flist i -> list
(take! (circular-list 1 3 5) 8) => (1 3)
(take! (circular-list 1 3 5) 8) => (1 3 5 1 3 5 1 3)
split-at x i -> [list object]
split-at! x i -> [list object]
SPLIT-AT splits the list X at index I, returning a list of the
first I elements, and the remaining tail. It is equivalent
to
(values (take x i) (drop x i))
SPLIT-AT! is the linear-update variant. It is allowed, but not
required, to alter the argument list to produce the result.
(split-at '(a b c d e f g h) 3) =>
(a b c)
(d e f g h)
last pair -> object
last-pair pair -> pair
LAST returns the last element of the non-empty, finite list PAIR.
@ -734,8 +752,8 @@ last-pair pair -> pair
(last-pair '(a b c . d)) => (c . d)
** Miscellaneous: length, append, reverse, zip & count
======================================================
** Miscellaneous: length, append, concatenate, reverse, zip & count
===================================================================
length list -> integer R5RS
length+ clist -> integer or #f
@ -779,6 +797,25 @@ append! list1 ... -> value
the result list. The last argument is never altered; the result
list shares structure with this parameter.
concatenate list-of-lists -> value
concatenate! list-of-lists -> value
These functions append the elements of their argument together.
That is, CONCATENATE returns
(apply append list-of-lists)
or, equivalently,
(reduce-right append '() list-of-lists)
CONCATENATE! is the linear-update variant, defined in
terms of APPEND! instead of APPEND.
Note that some Scheme implementations do not support passing more than a
certain number (e.g., 64) of arguments to an n-ary procedure. In these
implementations, the (APPLY APPEND ...) idiom would fail when applied to
long lists, but CONCATENATE would continue to function properly.
As with APPEND and APPEND!, the last element of the input list
may be any value at all.
reverse list -> list R5RS
reverse! list -> list
REVERSE returns a newly allocated list consisting of the elements of
@ -979,6 +1016,9 @@ reduce f ridentity list -> value
Note: MIT Scheme and Haskell flip F's arg order for their REDUCE and
FOLD functions.
;; Take the max of a list of non-negative integers.
(reduce max 0 nums) ; i.e., (apply max 0 nums)
reduce-right f ridentity list -> value
REDUCE-RIGHT is the fold-right variant of REDUCE.
It obeys the following definition:
@ -989,8 +1029,63 @@ reduce-right f ridentity list -> value
...in other words, we compute (fold-right F RIDENTITY LIST).
;; Append a bunch of lists together.
;; I.e., (apply append list-of-lists)
(reduce-right append '() list-of-lists)
unfold p f g seed [tail] -> value
unfold p f g seed [tail-gen]-> list
UNFOLD is best described by its basic recursion:
(unfold p f g seed) = (if (p seed) (tail-gen seed)
(cons (f seed)
(unfold p f g (g seed))))
P: Determines when to stop unfolding.
F: Maps each seed value to the corresponding list element.
G: Maps each seed value to next seed value.
SEED: The "state" value for the unfold.
TAIL-GEN: creates the tail of the list; defaults to (lambda (x) '())
In other words, we use G to generate a sequence of seed values
SEED, (G SEED), (G^2 SEED), (G^3 SEED), ...
These seed values are mapped to list elements by F, producing the
elements of the result list in a left-to-right order. P says when to stop.
UNFOLD is the fundamental recursive list constructor, just as FOLD-RIGHT
is the fundamental recursive list consumer. While UNFOLD may seem a
bit abstract to novice functional programmers, it can be used in a number
of ways:
(unfold (lambda (x) (> x 10)) ; List of squares: 1^2 ... 10^2.
(lambda (x) (* x x))
(lambda (x) (+ x 1))
1)
(unfold null-list? car cdr lis) ; Copy a proper list.
;; Read current input port into a list of values.
(unfold eof-object? values (lambda (x) (read)) (read))
;; Copy a possibly non-proper list:
(unfold not-pair? car cdr lis
values)
;; Append HEAD onto TAIL:
(unfold null-list? car cdr head
(lambda (x) tail))
Interested functional programmers may enjoy noting that FOLD-RIGHT and
UNFOLD are in some sense inverses. That is, given operations KNULL?,
KAR, KDR, KONS, and KNIL satisfying
(kons (kar x) (kdr x)) = x and (knull? knil) = #t
then
(FOLD-RIGHT kons knil (UNFOLD knull? kar kdr x)) = x
and
(UNFOLD knull? kar kdr (FOLD-RIGHT kons knil x)) = x.
This combinator sometimes is called an "anamorphism;" when an
explicit TAIL-GEN procedure is supplied, it is called an
"apomorphism."
unfold-right p f g seed [tail] -> value
UNFOLD constructs a list with the following loop:
(let lp ((seed seed) (lis tail))
(if (p seed) lis
@ -1003,82 +1098,40 @@ unfold p f g seed [tail] -> value
SEED: The "state" value for the unfold.
TAIL: list terminator; defaults to '().
UNFOLD is the fundamental iterative list constructor, just as FOLD is the
fundamental iterative list consumer. While UNFOLD may seem a bit abstract
to novice functional programmers, it can be used in a number of ways:
In other words, we use G to generate a sequence of seed values
SEED, (G SEED), (G^2 SEED), (G^3 SEED), ...
These seed values are mapped to list elements by F, producing the
elements of the result list in a right-to-left order. P says when to stop.
(unfold zero? ; List of squares: 1^2 ... 10^2
(lambda (x) (* x x))
(lambda (x) (- x 1))
10)
(unfold null-list? car cdr lis) ; Reverse a proper list.
UNFOLD-RIGHT is the fundamental iterative list constructor, just as FOLD
is the fundamental iterative list consumer. While UNFOLD-RIGHT may seem a
bit abstract to novice functional programmers, it can be used in a number
of ways:
;; Read current input port into a list of values.
(unfold eof-object? values (lambda (x) (read)) (read))
;; (APPEND-REVERSE rev-head tail)
(unfold null-list? car cdr rev-head tail)
Interested functional programmers may enjoy noting that FOLD and UNFOLD
are in some sense inverses. That is, given operations KNULL?, KAR, KDR,
KONS, and KNIL satisfying
(kons (kar x) (kdr x)) = x and (knull? knil) = #t
then
(FOLD kons knil (UNFOLD knull? kar kdr x)) = x
and
(UNFOLD knull? kar kdr (FOLD kons knil x)) = x.
This combinator presumably has some pretentious mathematical name;
interested readers are invited to communicate it to the author.
unfold-right p f g seed [tail-gen]-> list
UNFOLD-RIGHT is best described by its basic recursion:
(unfold-right p f g seed) = (if (p seed) (tail-gen seed)
(cons (f seed)
(unfold-right p f g (g seed))))
P: Determines when to stop unfolding.
F: Maps each seed value to the corresponding list element.
G: Maps each seed value to next seed value.
SEED: The "state" value for the unfold.
TAIL-GEN: creates the tail of the list; defaults to (lambda (x) '())
UNFOLD-RIGHT is the fundamental recursive list constructor, just as
FOLD-RIGHT is the fundamental recursive list consumer. While UNFOLD-RIGHT
may seem a bit abstract to novice functional programmers, it can be used
in a number of ways:
(unfold-right (lambda (x) (> x 10)) ; List of squares: 1^2 ... 10^2.
(unfold-right zero? ; List of squares: 1^2 ... 10^2
(lambda (x) (* x x))
(lambda (x) (+ x 1))
1)
(lambda (x) (- x 1))
10)
(unfold-right null-list? car cdr lis) ; Copy a proper list.
(unfold-right null-list? car cdr lis) ; Reverse a proper list.
;; Read current input port into a list of values.
(unfold-right eof-object? values (lambda (x) (read)) (read))
;; Copy a possibly non-proper list:
(unfold-right not-pair? car cdr lis
values)
;; (APPEND-REVERSE rev-head tail)
(unfold-right null-list? car cdr rev-head tail)
;; Append HEAD onto TAIL:
(unfold-right null-list? car cdr head
(lambda (x) tail))
Interested functional programmers may enjoy noting that FOLD-RIGHT and
Interested functional programmers may enjoy noting that FOLD and
UNFOLD-RIGHT are in some sense inverses. That is, given operations KNULL?,
KAR, KDR, KONS, and KNIL satisfying
(kons (kar x) (kdr x)) = x and (knull? knil) = #t
then
(FOLD-RIGHT kons knil (UNFOLD-RIGHT knull? kar kdr x)) = x
(FOLD kons knil (UNFOLD-RIGHT knull? kar kdr x)) = x
and
(UNFOLD-RIGHT knull? kar kdr (FOLD-RIGHT kons knil x)) = x.
(UNFOLD-RIGHT knull? kar kdr (FOLD kons knil x)) = x.
This combinator sometimes is called an "anamorphism;" when an
explicit TAIL-GEN procedure is supplied, it is called an
"apomorphism."
This combinator presumably has some pretentious mathematical name;
interested readers are invited to communicate it to the author.
map proc clist1 clist2 ... -> list R5RS+
@ -1337,6 +1390,55 @@ find-tail pred clist -> pair or false
(find-tail (lambda (elt) (equal? x elt)) lis)
In the circular-list case, this procedure "rotates" the list.
FIND-TAIL is essentially DROP-WHILE, where the sense of the predicate
is inverted: FIND-TAIL searches until it finds an element satisfying
the predicate; DROP-WHILE searches until it finds an element that
*doesn't* satisfy the predicate.
take-while pred clist -> list
take-while! pred clist -> list
Returns the longest initial prefix of CLIST whose elements all
satisfy the predicate PRED.
TAKE-WHILE! is the linear-update variant. It is allowed, but not
required, to alter the argument list to produce the result.
(take-while even? '(2 18 3 10 22 9)) => (2 18)
drop-while pred clist -> list
Drops the longest initial prefix of LIST whose elements all
satisfy the predicate PRED, and returns the rest of the list.
(drop-while even? '(2 18 3 10 22 9)) => (3 10 22 9)
The circular-list case may be viewed as "rotating" the list.
span pred clist -> [list clist]
span! pred list -> [list list]
break pred clist -> [list clist]
break! pred list -> [list list]
SPAN splits the list into the longest initial prefix whose elements
all satisfy PRED, and the remaining tail. BREAK inverts the sense
of the predicate: the tail commences with the first element of the
input list that satisfies the predicate.
In other words: SPAN finds the intial span of elements satisfying
PRED, and BREAK breaks the list at the first element satisfying PRED.
SPAN is equivalent to (VALUES (TAKE-WHILE PRED CLIST)
(DROP-WHILE PRED CLIST)).
SPAN! and BREAK! are the linear-update variants. They are allowed, but not
required, to alter the argument list to produce the result.
(span even? '(2 18 3 10 22 9)) =>
(2 18)
(3 10 22 9)
(break even? '(3 1 4 1 5 9)) =>
(3 1)
(4 1 5 9)
any pred clist1 clist2 ... -> value
Applies the predicate across the lists, returning true if the predicate