summaryrefslogtreecommitdiffstats
path: root/collect.scm
diff options
context:
space:
mode:
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" --- ;;