1;; (*tbl* (k1 v1) (k2 v2) ...)
2
3(define (tbl-mk)
4  (list '*tbl*))
5
6;; the val for key (#f if none)
7(define (tbl-get tbl key)
8  (let ((kvpair (assoc key (cdr tbl))))
9    (if kvpair
10        (cadr kvpair)
11        nil)))
12
13;; add key/val or replace the current val of key
14(define (tbl-set! tbl key val)
15  (let ((kvpair (assoc key (cdr tbl))))
16    (if kvpair
17        (set-cdr! kvpair (list val))
18        (set-cdr! tbl
19                  (cons (cons key (list val))
20                        (cdr tbl))))))
21
22;; append val to the value of key;
23;; if key is not there make a new list with just val
24;; if current value is not a list, converts it to a list first
25(define (tbl-append! tbl key val)
26  (let ((entry (assoc key (cdr tbl))))
27     (cond ((or (not entry)
28            	(not (pair? (cdr entry))))
29        	(tbl-set! tbl key (list val)))
30        ((not (pair? (cadr entry)))
31        	(set-cdr! entry (list (cons val (cdr entry)))))
32        (#t
33        	(set-cdr! entry (list (cons val (cadr entry))))))))
34
35;; run a procedure on each value in the table
36(define (tbl-for-each-val fx tbl)
37  (for-each (lambda (entry)
38              (println "tbl-for-each-val:entry=" entry)
39              (println "cdr=" (cdr entry))
40              (apply fx (cdr entry)))
41            (cdr tbl)))
42
43;; remove the entry that matches key
44(define (tbl-rm! tbl key)
45  (if (pair? (cdr tbl))
46      (if (equal? key (caadr tbl))
47          (set-cdr! tbl (cddr tbl))
48          (tbl-rm! (cdr tbl) key))))
49
50;; set table values from name/value list
51(define (tbl-set-all! tbl entrydata)
52	(if (not (null? entrydata))
53		(begin
54			(tbl-set! tbl (car entrydata) (car (cdr entrydata)))
55			(tbl-set-all! tbl (cddr entrydata))
56		)
57	))
58
59(define (tbl-build . entrydata)
60	(let ((tbl (tbl-mk)))
61		(tbl-set-all! tbl entrydata)
62		tbl
63	))
64
65(define (is-tbl? tbl)
66  (and (pair? tbl)
67       (equal? (car tbl) '*tbl*)
68       )
69  )
70
71