;;; -*- Mode:SCHEME; Package:SCHEME; Readtable:SCHEME; Base:10 -*-

(define (make-tree-table id)
  (let ((table-alist '()))
    (let ((lookup
	    (lambda (key if-found if-not-found)
	      (letrec ((scan (lambda (tail)
			       (if (null? tail)
				   (if-not-found)
				   (let ((entry (first tail)))
				     (if (alikev? key (first entry))
					 (if-found entry)
					 (scan (rest tail))))))))
		(scan table-alist)))))
      (object nil
	((table-entry self key) (lookup key second (lambda () nil)))
	((set-table-entry self key new-value)
	 (lookup key
		 (lambda (entry)
		   (set (second entry) new-value))
		 (lambda ()
		   (set! table-alist (cons (list key new-value) table-alist)))))
	((table? self) t)
	((identification self) id)
	((print self stream) (format stream "#{HACK-TREE-TABLE ~S}" (identification self)))))))