From 8466d8cfa486fb30d1755c4261b781135083787b Mon Sep 17 00:00:00 2001
From: Bryan Newbold <bnewbold@robocracy.org>
Date: Mon, 20 Feb 2017 00:05:29 -0800
Subject: Import Upstream version 3a1

---
 collect.scm | 105 +++++++++++++++++++++++++++++-------------------------------
 1 file changed, 51 insertions(+), 54 deletions(-)

(limited to 'collect.scm')

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" ---                    ;;
-- 
cgit v1.2.3