sicp-ex-3.25

<< Previous exercise (3.24) | Index | Next exercise (3.26) >>

 (define (fold-left op init seq) 
   (define (iter ans rest) 
     (if (null? rest) 
         ans 
         (iter (op ans (car rest)) 
               (cdr rest)))) 
   (iter init seq)) 
  
 (define (make-table same-key?) 
   (define (associate key records) 
     (cond ((null? records) #f) 
           ((same-key? key (caar records)) (car records)) 
           (else (associate key (cdr records))))) 
  
   (let ((the-table (list '*table*))) 
     (define (lookup keys) 
       (define (lookup-record record-list key) 
         (if record-list 
             (let ((record (associate key record-list))) 
               (if record 
                   (cdr record) 
                   #f)) 
             #f)) 
       (fold-left lookup-record (cdr the-table) keys)) 
  
     (define (insert! keys value) 
       (define (descend table key) 
         (let ((record (associate key (cdr table)))) 
           (if record 
               (cdr record) 
               (let ((new (cons (list key) 
                                (cdr table)))) 
                 (set-cdr! table new) 
                 (car new))))) 
       (set-cdr! (fold-left descend the-table keys) 
                 value)) 
  
     ;; N.B. PRINT will break if a record has a list structure for a value. 
     (define (print) 
       (define (indent tabs) 
         (for-each (lambda (x) (display #\tab)) (iota tabs))) 
  
       (define (print-record rec level) 
         (indent level) 
         (display (car rec)) 
         (display ": ") 
         (if (list? rec) 
             (begin (newline) 
                    (print-table rec (1+ level))) 
             (begin (display (cdr rec)) 
                    (newline)))) 
              
       (define (print-table table level) 
         (if (null? (cdr table)) 
             (begin (display "-no entries-") 
                    (newline)) 
             (for-each (lambda (record) 
                         (print-record record level)) 
                       (cdr table)))) 
  
       (print-table the-table 0)) 
  
     (define (dispatch m) 
       (cond ((eq? m 'lookup) lookup) 
             ((eq? m 'insert!) insert!) 
             ((eq? m 'print) print) 
             (else (error "Undefined method" m)))) 
  
     dispatch)) 

⇒(define op-table (make-table eq?))
⇒(define put (op-table 'insert!))
⇒(define get (op-table 'lookup))
⇒((op-table 'print))
-no entries-
⇒(put '(letters a) 97)  ; Two dimensions
⇒(put '(letters b) 98)
⇒(put '(math +) 43)
⇒(put '(math -) 45)
⇒(put '(math *) 42)
⇒(put '(greek majiscule Λ) 923)  ; Three dimensions
⇒(put '(greek miniscule λ) 955)
⇒(put '(min) 42)  ; One dimension
⇒(put '(max) 955)
⇒(get '(min))
42
⇒(get '(letters b))
98
⇒(get '(greek majiscule Λ))
923
⇒(get '(dfashoigrar asdfasdf retaqw))
#f
⇒((op-table 'print))
max: 955
min: 42
greek: 
        majiscule: 
                Λ: 923
        miniscule: 
                λ: 955
math: 
        +: 43
        *: 42
        -: 45
letters: 
        a: 97
        b: 98

I don't think we need change the procedure make-table. If we use a list as the key, all things can keep the same.