;;; -*-Scheme-*-
;;; 
;;; Scheme provides automatic garbage collection.  However, sometimes
;;; you know early that an object of a particular type will not be
;;; used again, so you would like to make it available for re-use.
;;; 
;;; This file provides three functions:
;;;	(make-pool allocator) => pool
;;;	(allocate pool) => object
;;;	(release pool object) => unspecified
;;; The idea is that a pool consists of a list of available objects and
;;; a function (the allocator) for allocating and initialising new ones.
;;; When you try to allocate an object from the pool, if there are any
;;; available objects it will return one of them.  If there aren't any,
;;; it will call the allocator to make a new one.
;;; When you have finished with an object, you can add it to the pool
;;; by calling release.
;;; When a garbage collection occurs, every pool is forcibly emptied.
;;; If there are other references to an object in a pool, it will
;;; survive, so this is quite safe.
;;; Using this package can save a fair bit of garbage collection.
;;; You will never get your hands on invalid pointers.  On the other
;;; hand, you had better be *sure* that you have finished with an
;;; object before putting it back in a pool.

;;; The representation of a pool is a pair
;;;	(<allocation function> . <weak reference to list of objects>)

(define (make-pool allocator)
    (cons allocator (cons-weak-ref '() '()) ))

(define (pool? object)
    (and (pair? object)
	 (procedure? (car object))
	 (weak-ref? (cdr object))
	 (null? (weak-default (cdr object)) )) )

(define (allocate pool)
    (let ((available (weak-contents (cdr pool))))
	(if (null? available) ((car pool))
	    (begin (weak-set-contents! (cdr pool) (cdr available))
		   (car available)) )))

(define (release pool object)
    (weak-set-contents! (cdr pool)
	(cons object (weak-contents (cdr pool)) )))

