44 lines
1.0 KiB
Scheme
44 lines
1.0 KiB
Scheme
|
;;
|
||
|
|
;; Two dimensional table, from: [SICP 2ed. p. 271]
|
||
|
|
;;
|
||
|
|
|
||
|
|
(define (make-table)
|
||
|
|
(let ((local-table (list '*table*)))
|
||
|
|
(define (lookup key-1 key-2)
|
||
|
|
(let ((subtable (assoc key-1 (cdr local-table))))
|
||
|
|
(if subtable
|
||
|
|
(let ((record (assoc key-2 (cdr subtable))))
|
||
|
|
(if record
|
||
|
|
(cdr record)
|
||
|
|
#f))
|
||
|
|
#f)))
|
||
|
|
(define (insert! key-1 key-2 value)
|
||
|
|
(let ((subtable (assoc key-1 (cdr local-table))))
|
||
|
|
(if subtable
|
||
|
|
(let ((record (assoc key-2 (cdr subtable))))
|
||
|
|
(if record
|
||
|
|
(set-cdr! record value)
|
||
|
|
(set-cdr! subtable
|
||
|
|
(cons (cons key-2 value)
|
||
|
|
(cdr subtable)))))
|
||
|
|
(set-cdr! local-table
|
||
|
|
(cons (list key-1
|
||
|
|
(cons key-2 value))
|
||
|
|
(cdr local-table)))))
|
||
|
|
'ok)
|
||
|
|
(define (dispatch m)
|
||
|
|
(cond ((eq? m 'lookup-proc) lookup)
|
||
|
|
((eq? m 'insert-proc!) insert!)
|
||
|
|
(else (error "Unknown operation -- TABLE" m))))
|
||
|
|
dispatch))
|
||
|
|
|
||
|
|
;;
|
||
|
|
;; Tagged list from [SICP 2ed. p. 369]
|
||
|
|
;;
|
||
|
|
|
||
|
|
(define (tagged-list? exp tag)
|
||
|
|
(if (pair? exp)
|
||
|
|
(eq? (car exp) tag)
|
||
|
|
false))
|
||
|
|
|