;; This file is table.scm.  It defines a dispatch table for data directed programming.
;; Note: you do not need to modify any of this code!!!!!

;; This procedure creates the table. It is define on page 271
;; of the SCIP.
(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.

(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)))