diff options
author | Steve Langasek <vorlon@debian.org> | 2005-01-10 08:53:33 +0000 |
---|---|---|
committer | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:30 -0800 |
commit | e33f9eb9cf5cc29c36ce2aa7e10cd0f37ae0cc8e (patch) | |
tree | abbf06041619e445f9d0b772b0d58132009d8234 /collect.scm | |
parent | f559c149c83da84d0b1c285f0298c84aec564af9 (diff) | |
parent | 8466d8cfa486fb30d1755c4261b781135083787b (diff) | |
download | slib-e33f9eb9cf5cc29c36ce2aa7e10cd0f37ae0cc8e.tar.gz slib-e33f9eb9cf5cc29c36ce2aa7e10cd0f37ae0cc8e.zip |
Import Debian changes 3a1-4.2debian/3a1-4.2
slib (3a1-4.2) unstable; urgency=low
* Non-maintainer upload.
* Add guile.init.local for use within the build dir, since otherwise we
have an (earlier unnoticed) circular build-dep due to a difference
between scm and guile.
slib (3a1-4.1) unstable; urgency=low
* Non-maintainer upload.
* Build-depend on guile-1.6 instead of scm, since the new version of
scm is wedged in unstable (closes: #281809).
slib (3a1-4) unstable; urgency=low
* Also check for expected creation on slibcat. (Closes: #240096)
slib (3a1-3) unstable; urgency=low
* Also check for /usr/share/guile/1.6/slib before installing for guile
1.6. (Closes: #239267)
slib (3a1-2) unstable; urgency=low
* Add format.scm back into slib until gnucash stops using it.
* Call guile-1.6 new-catalog (Closes: #238231)
slib (3a1-1) unstable; urgency=low
* New upstream release
* Remove Info section from doc-base file (Closes: #186950)
* Remove period from end of description (linda, lintian)
* html gen fixed upstream (Closes: #111778)
slib (2d4-2) unstable; urgency=low
* Fix url for upstream source (Closes: #144981)
* Fix typo in slib.texi (enquque->enqueue) (Closes: #147475)
* Add build depends.
slib (2d4-1) unstable; urgency=low
* New upstream.
slib (2d3-1) unstable; urgency=low
* New upstream.
* Remove texi2html call in debian/rules. Now done upstream. Add make
html instead.
* Changes to rules and doc-base to conform to upstream html gen
* Clean up upstream makefile to make sure it cleans up after itself.
Diffstat (limited to 'collect.scm')
-rw-r--r-- | collect.scm | 105 |
1 files changed, 51 insertions, 54 deletions
diff --git a/collect.scm b/collect.scm index 35a333d..05bc2cf 100644 --- a/collect.scm +++ b/collect.scm @@ -2,49 +2,55 @@ ; COPYRIGHT (c) Kenneth Dickey 1992 ; ; This software may be used for any purpose whatever -; without warrantee of any kind. +; without warranty of any kind. ; AUTHOR Ken Dickey ; DATE 1992 September 1 ; LAST UPDATED 1992 September 2 ; NOTES Expository (optimizations & checks elided). ; Requires YASOS (Yet Another Scheme Object System). +(require 'object) (require 'yasos) -(define-operation (collect:collection? obj) +(define collect:size size) +(define collect:print print) + +;@ +(define-operation (collection? obj) ;; default (cond ((or (list? obj) (vector? obj) (string? obj)) #t) (else #f) ) ) - -(define (collect:empty? collection) (zero? (yasos:size collection))) - -(define-operation (collect:gen-elts <collection>) ;; return element generator +;@ +(define (empty? collection) (zero? (collect:size collection))) +;@ +(define-operation (gen-elts <collection>) ;; return element generator ;; default behavior (cond ;; see utilities, below, for generators ((vector? <collection>) (collect:vector-gen-elts <collection>)) ((list? <collection>) (collect:list-gen-elts <collection>)) ((string? <collection>) (collect:string-gen-elts <collection>)) (else - (slib:error "Operation not supported: GEN-ELTS " (yasos:print obj #f))) + (slib:error 'gen-elts 'operation-not-supported + (collect:print <collection> #f))) ) ) - -(define-operation (collect:gen-keys collection) +;@ +(define-operation (gen-keys collection) (if (or (vector? collection) (list? collection) (string? collection)) - (let ( (max+1 (yasos:size collection)) (index 0) ) + (let ( (max+1 (collect:size collection)) (index 0) ) (lambda () (cond ((< index max+1) (set! index (collect:add1 index)) (collect:sub1 index)) - (else (slib:error "no more keys in generator")) + (else (slib:error 'no-more 'keys 'in 'generator)) ) ) ) - (slib:error "Operation not handled: GEN-KEYS " collection) + (slib:error 'gen-keys 'operation-not-handled collection) ) ) - -(define (collect:do-elts <proc> . <collections>) - (let ( (max+1 (yasos:size (car <collections>))) +;@ +(define (do-elts <proc> . <collections>) + (let ( (max+1 (collect:size (car <collections>))) (generators (map collect:gen-elts <collections>)) ) (let loop ( (counter 0) ) @@ -56,9 +62,9 @@ (else 'unspecific) ; done ) ) ) ) - -(define (collect:do-keys <proc> . <collections>) - (let ( (max+1 (yasos:size (car <collections>))) +;@ +(define (do-keys <proc> . <collections>) + (let ( (max+1 (collect:size (car <collections>))) (generators (map collect:gen-keys <collections>)) ) (let loop ( (counter 0) ) @@ -70,11 +76,11 @@ (else 'unspecific) ; done ) ) ) ) - -(define (collect:map-elts <proc> . <collections>) - (let ( (max+1 (yasos:size (car <collections>))) +;@ +(define (map-elts <proc> . <collections>) + (let ( (max+1 (collect:size (car <collections>))) (generators (map collect:gen-elts <collections>)) - (vec (make-vector (yasos:size (car <collections>)))) + (vec (make-vector (collect:size (car <collections>)))) ) (let loop ( (index 0) ) (cond @@ -85,11 +91,11 @@ (else vec) ; done ) ) ) ) - -(define (collect:map-keys <proc> . <collections>) - (let ( (max+1 (yasos:size (car <collections>))) +;@ +(define (map-keys <proc> . <collections>) + (let ( (max+1 (collect:size (car <collections>))) (generators (map collect:gen-keys <collections>)) - (vec (make-vector (yasos:size (car <collections>)))) + (vec (make-vector (collect:size (car <collections>)))) ) (let loop ( (index 0) ) (cond @@ -100,18 +106,18 @@ (else vec) ; done ) ) ) ) - -(define-operation (collect:for-each-key <collection> <proc>) +;@ +(define-operation (for-each-key <collection> <proc>) ;; default (collect:do-keys <proc> <collection>) ;; talk about lazy! ) - -(define-operation (collect:for-each-elt <collection> <proc>) +;@ +(define-operation (for-each-elt <collection> <proc>) (collect:do-elts <proc> <collection>) ) - -(define (collect:reduce <proc> <seed> . <collections>) - (let ( (max+1 (yasos:size (car <collections>))) +;@ +(define (reduce <proc> <seed> . <collections>) + (let ( (max+1 (collect:size (car <collections>))) (generators (map collect:gen-elts <collections>)) ) (let loop ( (count 0) ) @@ -127,9 +133,9 @@ -;; pred true for every elt? -(define (collect:every? <pred?> . <collections>) - (let ( (max+1 (yasos:size (car <collections>))) +;;@ pred true for every elt? +(define (every? <pred?> . <collections>) + (let ( (max+1 (collect:size (car <collections>))) (generators (map collect:gen-elts <collections>)) ) (let loop ( (count 0) ) @@ -143,9 +149,9 @@ ) ) ) ) -;; pred true for any elt? -(define (collect:any? <pred?> . <collections>) - (let ( (max+1 (yasos:size (car <collections>))) +;;@ pred true for any elt? +(define (any? <pred?> . <collections>) + (let ( (max+1 (collect:size (car <collections>))) (generators (map collect:gen-elts <collections>)) ) (let loop ( (count 0) ) @@ -191,7 +197,7 @@ (define (collect:list-gen-elts <list>) (lambda () (if (null? <list>) - (slib:error "No more list elements in generator") + (slib:error 'no-more 'list-elements 'in 'generator) (let ( (elt (car <list>)) ) (set! <list> (cdr <list>)) elt)) @@ -200,7 +206,7 @@ ;; generator for vector elements (define (collect:make-vec-gen-elts <accessor>) (lambda (vec) - (let ( (max+1 (yasos:size vec)) + (let ( (max+1 (collect:size vec)) (index 0) ) (lambda () @@ -219,18 +225,9 @@ ;;; exports: -(define collection? collect:collection?) -(define empty? collect:empty?) -(define gen-keys collect:gen-keys) -(define gen-elts collect:gen-elts) -(define do-elts collect:do-elts) -(define do-keys collect:do-keys) -(define map-elts collect:map-elts) -(define map-keys collect:map-keys) -(define for-each-key collect:for-each-key) -(define for-each-elt collect:for-each-elt) -(define reduce collect:reduce) ; reduce is also in comlist.scm -(define every? collect:every?) -(define any? collect:any?) +(define collect:gen-keys gen-keys) +(define collect:gen-elts gen-elts) +(define collect:do-elts do-elts) +(define collect:do-keys do-keys) ;; --- E O F "collect.oo" --- ;; |