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