#| BEGIN (Write your solution here) |#
(require compatibility/mlist)

;; -- dispatching table --

(define (make-table)
  (let ((local-table (mlist '*table*)))
    (define (lookup key-1 key-2)
      (let ((subtable (massoc key-1 (mcdr local-table))))
        (if subtable
            (let ((record (massoc key-2 (mcdr subtable))))
              (if record
                  (mcdr record)
                  #f))
            #f)))
    (define (insert! key-1 key-2 value)
      (let ((subtable (massoc key-1 (mcdr local-table))))
        (if subtable
            (let ((record (massoc key-2 (mcdr subtable))))
              (if record
                  (set-mcdr! record value)
                  (set-mcdr! subtable
                             (mcons (mcons key-2 value)
                                    (mcdr subtable)))))
            (set-mcdr! local-table
                       (mcons (mlist key-1
                                     (mcons key-2 value))
                              (mcdr local-table)))))
      'ok)    
    (define (dispatch m)
      (cond ((eq? m 'lookup-proc) lookup)
            ((eq? m 'insert-proc!) insert!)
            (else (error "Unknown operation -- TABLE" m))))
    dispatch))

(define operation-table (make-table))
(define get (operation-table 'lookup-proc))
(define put (operation-table 'insert-proc!))

;; -- division1 records

(define (install-div1-package)
  (define (get-key record key)
    (if (null? record)
        #f
        (let ((pair (car record)))
          (if (eq? (car pair) key)
              (cdr pair)
              (get-key (cdr record) key)))))
  (define (get-record records need-name)
    (if (null? records)
        '()
        (let ((record (car records)))
          (let ((name (get-key record 'name)))
            (if (string=? name need-name)
                (attach-tag 'ins1-record record)
                (get-record (cdr records) need-name))))))
  (define (get-salary record)
    (get-key record 'salary))
  (put 'get-record 'ins1-record get-record)
  (put 'get-salary 'ins1-record get-salary))

;; -- division2 records

(define (install-div2-package)
  (define (get-record records need-name)
    (if (null? records)
        '()
        (let ((record (car records)))
          (let ((name (car record)))
            (if (string=? name need-name)
                (attach-tag 'ins2-record record)
                (get-record (cdr records) need-name))))))
  (define (get-salary record)
    (let ((info (cadr record)))
      (caddr info)))
  (put 'get-record 'ins2-record get-record)
  (put 'get-salary 'ins2-record get-salary))

;; -- generic selectors --

(define (get-record records name)
  ((get 'get-record (type-tag records)) (cdr records) name))

(define (get-salary tagged-record)
  ((get 'get-salary (type-tag tagged-record)) (cdr tagged-record)))

(define (find-employee-record div-records-list name)
  (if (null? div-records-list)
      '()
      (let ((div-records (car div-records-list)))
        (let ((record (get-record div-records name)))
          (if (not (null? record))
              (cdr record)
              (find-employee-record (cdr div-records-list) name))))))

(install-div1-package)
(install-div2-package)
#| END |#