(module collections

        (collection? gen-keys gen-elts 
         do-elts do-keys map-elts map-keys for-each-key for-each-elt
         reduce any? every? empty? size make-vec-gen-elts
         list-gen-elts vector-gen-elts string-gen-elts)
        
        (import scheme (chicken base) (chicken format)
                (except yasos object object-with-ancestors))

        
;; COLLECTION INTERFACE

;; (collection? obj)  -- predicate
;;
;; (do-elts proc coll+) -- apply proc element-wise to collections
;; (do-keys proc coll+) -- .. return value is unspecified
;;
;; (map-elts proc coll+) -- as with do-*, but returns collection
;; (map-keys proc coll+) -- e.g. (map-keys + (list 1 2 3) (vector 1 2 3))
;;					-> #( 2 4 6 )
;;
;; (for-each-key coll proc) -- for single collection (more efficient)
;; (for-each-elt coll proc)
;;
;; (reduce proc seed coll+) -- e.g. (reduce + 0 (vector 1 2 3))
;; (any?   predicate coll+) -- e.g. (any? odd? (list 2 3 4 5))
;; (every? predicate coll+) -- e.g. (every? collection collections)
;;
;; (empty? collection)  -- I bet you can guess what these do as well...
;; (size collection)
;;
;;==============================
;; Collections must implement:
;;  collection?
;;  gen-elts
;;  gen-keys
;;  size
;;  print
;;
;; Collections should implement {typically faster}:
;;  for-each-key
;;  for-each-elt
;;==============================

(define-operation (collection? obj)
 ;; default
  (cond
    ((or (list? obj) (vector? obj) (string obj)) #t)
    (else #f)
) )

(define (empty? collection) (zero? (size collection)))

(define-operation (gen-elts <collection>) ;; return element generator
  ;; default behavior
  (cond                      ;; see utilities, below, for generators
    ((vector? <collection>) (vector-gen-elts <collection>)) 
    ((list?   <collection>) (list-gen-elts   <collection>))
    ((string? <collection>) (string-gen-elts <collection>))
    (else 
      (error "operation not supported: gen-elts "))
) )

(define-operation (gen-keys collection)
  (if (or (vector? collection) (list? collection) (string? collection))
      (let ( (max+1 (size collection)) (index 0) )
	 (lambda ()
            (cond
	      ((< index max+1)
	       (set! index (add1 index))
	       (sub1 index))
	      (else (error "no more keys in generator"))
      ) ) )
      (error "operation not handled: gen-keys " collection)
) )

(define (do-elts <proc> . <collections>)
  (let ( (max+1 (size (car <collections>)))
         (generators (map gen-elts <collections>))
       )
    (let loop ( (counter 0) )
       (cond
          ((< counter max+1)
           (apply <proc> (map (lambda (g) (g)) generators))
           (loop (add1 counter))
          )
          (else 'unspecific)  ; done
    )  )
) )

(define (do-keys <proc> . <collections>)
  (let ( (max+1 (size (car <collections>)))
         (generators (map gen-keys <collections>))
       )
    (let loop ( (counter 0) )
       (cond
          ((< counter max+1)
           (apply <proc> (map (lambda (g) (g)) generators))
           (loop (add1 counter))
          )
          (else 'unspecific)  ; done
    )  )
) )

(define (map-elts <proc> . <collections>)
  (let ( (max+1 (size (car <collections>)))
         (generators (map gen-elts <collections>))
         (vec (make-vector (size (car <collections>))))
       )
    (let loop ( (index 0) )
       (cond
          ((< index max+1)
           (vector-set! vec index (apply <proc> (map (lambda (g) (g)) generators)))
           (loop (add1 index))
          )
          (else vec)  ; done
    )  )
) )

(define (map-keys <proc> . <collections>)
  (let ( (max+1 (size (car <collections>)))
         (generators (map gen-keys <collections>))
	 (vec (make-vector (size (car <collections>))))
       )
    (let loop ( (index 0) )
       (cond
          ((< index max+1)
           (vector-set! vec index (apply <proc> (map (lambda (g) (g)) generators)))
           (loop (add1 index))
          )
          (else vec)  ; done
    )  )
) )

(define-operation (for-each-key <collection> <proc>)
   ;; default
   (do-keys <proc> <collection>)  ;; talk about lazy!
)

(define-operation (for-each-elt <collection> <proc>)
   (do-elts <proc> <collection>)
)

(define (reduce <proc> <seed> . <collections>)
   (let ( (max+1 (size (car <collections>)))
          (generators (map gen-elts <collections>))
        )
     (let loop ( (count 0) )
       (cond
          ((< count max+1)
           (set! <seed> 
                 (apply <proc> <seed> (map (lambda (g) (g)) generators)))
           (loop (add1 count))
          )
          (else <seed>)
     ) )
)  )

;; pred true for every elt?
(define (every? <pred?> . <collections>)
   (let ( (max+1 (size (car <collections>)))
          (generators (map gen-elts <collections>))
        )
     (let loop ( (count 0) )
       (cond
          ((< count max+1)
           (if (apply <pred?> (map (lambda (g) (g)) generators))
               (loop (add1 count))
               #f)
          )
          (else #t)
     ) )
)  )

;; pred true for any elt?
(define (any? <pred?> . <collections>)
   (let ( (max+1 (size (car <collections>)))
          (generators (map gen-elts <collections>))
        )
     (let loop ( (count 0) )
       (cond
          ((< count max+1)
           (if (apply <pred?> (map (lambda (g) (g)) generators))
               #t
               (loop (add1 count))
          ))
          (else #f)
     ) )
)  )



;; nota bene:  list-set! is bogus for element 0

(define (list-set! <list> <index> <value>)

  (define (set-loop last this idx)
     (cond
        ((zero? idx) 
         (set-cdr! last (cons <value> (cdr this)))
         <list>
        )
        (else (set-loop (cdr last) (cdr this) (sub1 idx)))
  )  )

  ;; main
  (if (zero? <index>)
      (cons <value> (cdr <list>))  ;; return value
      (set-loop <list> (cdr <list>) (sub1 <index>)))
)


;; generator for list elements
(define (list-gen-elts <list>)
  (lambda ()
     (if (null? <list>)
         (error "no more list elements in generator")
         (let ( (elt (car <list>)) )
           (set! <list> (cdr <list>))
           elt))
) )

(define (make-vec-gen-elts <accessor>)
  (lambda (vec)
    (let ( (max+1 (size vec))
           (index 0)
         )
      (lambda () 
         (cond ((< index max+1)
                (set! index (add1 index))
                (<accessor> vec (sub1 index))
               )
               (else #f)
      )  )
  ) )
)

(define vector-gen-elts (make-vec-gen-elts vector-ref))

(define string-gen-elts (make-vec-gen-elts string-ref))

)