;; Note: you do not need to modify any of this code!!!!!
;; This procedure creates the table. It is define on page 271
;; of SCIP book.
(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 "Unknow operation - Table" m))))
dispatch))
;; This procedure applies a generic operation to some arguments.
;; It is defined on page 184 of the SICP textbook
(define (apply-generic op . args)
(let ((type-tags (map type-tag args)))
(let ((proc (get op type-tags)))
(if proc
(apply proc (map contents args))
(error
"No method for these types - APPLY-GENERIC"
(list op type-tags))))))
(define operation-table (make-table))
;; Below are the get and put functions that get the entries and
;; put the entries in the table. See page 181 of SCIP textbook
(define get (operation-table 'lookup-proc))
(define put (operation-table 'insert-proc!))
;; This procedure attaches a tag to a list.
(define (attach-tag type-tag contents)
(cons type-tag contents))
;; This procedure returns the tag of a list
(define (type-tag datum)
(if (pair? datum)
(car datum)
(error "Bad tagged datum - TYPE-TAG" datum)))
;; This procedure strips the tag of a list and returns a list.
(define (contents datum)
(if (pair? datum)
(cdr datum)
(error "Bad tagged datum - CONTENTS" datum)))