A two dimensional table

2d-table.scm

(define (make-table)
  ;; assoc helper
  (define (assoc key records)
    (cond ((null? records) #f)
          ((equal? key (caar records)) (car records))
          (else (assoc key (cdr records)))))
  
  ;; local-table will be internal state
  ;; for the procedural object
  (let ((local-table (list '*table*)))
       
    ;; implementation for the lookup method
    (define (lookup-impl k1 k2)
      (let ((sub-table (assoc k1 (cdr local-table))))
        (if sub-table
          (let ((record (assoc k2 (cdr sub-table))))
            (if record (cdr record) #f))
          #f)))
          
    ;; implementation for the insert! method
    (define (insert-impl k1 k2 value)
      (let ((sub-table (assoc k1 (cdr local-table))))
        (if sub-table
            ;; if the sub table exists let us insert
            ;; the value with the table, but before
            ;; we do that we see if it already includes
            ;; key number two
            (let ((record (assoc k2 (cdr sub-table))))
              (if record
                  ;; oh look the record exist let us
                  ;; update the value with our new records-next
                  (set-cdr! record value)
                  
                  ;; oh looks like we've got a new value
                  ;; here let us add it to the sub-table
                  (set-cdr! sub-table 
                            (cons (cons k2 value) (cdr sub-table)))))
                          
            ;; however if we don't have that sub-table this
            ;; is our oppurtunity to create it!
            (set-cdr! local-table
                      (cons (list k1 (cons k2 value))
                            (cdr local-table)))))
      'ok)
    
    (define (display-impl)
      (display (cdr local-table))
      (newline))
  
    (define (dispatch message . arguments)
      (cond ((eq? message 'lookup)
             (apply lookup-impl arguments))
            
            ((eq? message 'insert)
             (apply insert-impl arguments))
            
            ((eq? message 'display)
             (apply display-impl arguments))
           
            ((eq? message 'debug)
             local-table)
            
            (else (error "Unknown message"))))
    
    dispatch))