summaryrefslogtreecommitdiffstats
path: root/collect.scm
diff options
context:
space:
mode:
authorSteve Langasek <vorlon@debian.org>2005-01-10 08:53:33 +0000
committerBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:30 -0800
commite33f9eb9cf5cc29c36ce2aa7e10cd0f37ae0cc8e (patch)
treeabbf06041619e445f9d0b772b0d58132009d8234 /collect.scm
parentf559c149c83da84d0b1c285f0298c84aec564af9 (diff)
parent8466d8cfa486fb30d1755c4261b781135083787b (diff)
downloadslib-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.scm105
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" --- ;;