my attempt to do the exercises in sicp.

Monday, November 30, 2009

sicp exercise 3.24


; Exercise 3.24.  In the table implementations above, the keys are tested for equality using equal? (called by assoc). This is not always the appropriate test. For instance, we might have a table with numeric keys in which we don't need an exact match to the number we're looking up, but only a number within some tolerance of it. Design a table constructor make-table that takes as an argument a same-key? procedure that will be used to test ``equality'' of keys. Make-table should return a dispatch procedure that can be used to access appropriate lookup and insert! procedures for a local table.
;


(define false #f)

(define (make-table same-key1? same-key2?)
  (define (myassoc key lst same-key?)
    (define (iter items)
      (cond ((null? items) false)
            ((same-key? (caar items) key) (car items))
            (else (iter (cdr items)))))
    (iter lst))
  (let ((local-table (list '*table*)))
    (define (lookup key-1 key-2)
      (let ((subtable (myassoc key-1 (cdr local-table) same-key1?)))
        (if subtable
            (let ((record (myassoc key-2 (cdr subtable) same-key2?)))
              (if record
                  (cdr record)
                  false))
            false)))
    (define (insert! key-1 key-2 value)
      (let ((subtable (myassoc key-1 (cdr local-table) same-key1?)))
        (if subtable
            (let ((record (myassoc key-2 (cdr subtable) same-key2?)))
              (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))


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

(put 'key1 'key2 100)
(display (get 'key1 'key2))(newline)


No comments: