src/sicp/ex3_25.rkt

   1 #lang r5rs
   2
   3 (define (lookup key table)
   4   (let ((record (assoc key (cdr table))))
   5     (if record
   6         (cdr record)
   7         #f)))
   8
   9 (define (assoc key records)
  10   (cond ((null? records) #f)
  11         ((equal? key (caar records)) (car records))
  12         (else (assoc key (cdr records)))))
  13
  14 (define (insert! key value table)
  15   (let ((record (assoc key (cdr table))))
  16     (if record
  17         (set-cdr! record value)
  18         (set-cdr! table
  19                   (cons (cons key value) (cdr table)))))
  20   'ok)
  21
  22 (define (assoc-in key-list records)
  23   (if (not (null? key-list))
  24       (if (not (null? (cdr key-list)))
  25           (assoc-in (cdr key-list)
  26                     (assoc (car key-list) (cdr records)))
  27           (assoc (car key-list) (cdr records)))
  28       #f))
  29
  30 (define (lookup-in key-list records)
  31   (let ((record (assoc-in key-list records)))
  32     (if record
  33         (cdr record)
  34         #f)))
  35
  36 (define (form-table keys value)
  37   (cond
  38     ((null? (cdr keys)) (cons (car keys) value))
  39     (else (list (car keys)
  40                 (form-table (cdr keys) value)))))
  41
  42 (define (insert-in! key-list value records)
  43   (let loop ((k (car key-list))
  44              (ks (cdr key-list))
  45              (table (cdr records)))
  46     (let ((record (assoc k table)))
  47       (if record
  48           (if (null? ks)
  49               (set-cdr! record value)
  50               (loop (car ks) (cdr ks) (cdr record)))
  51           (if (null? ks)
  52               (set-cdr! table
  53                         (cons (cons k value)
  54                               (cdr table)))
  55               (set-cdr! records
  56                         (cons (list k
  57                                     (form-table ks value))
  58                               (cdr records))))))))
  59
  60
  61
  62
  63
  64 #|
  65 > (define t (list '*table*
  66                   (list 'math
  67                         (cons '+ 43)
  68                         (cons '- 45)
  69                         (cons '* 42))
  70                   (list 'letters
  71                         (cons 'a 97)
  72                         (cons 'b 98))))
  73
  74 > (lookup-in '(math +) t)
  75 43
  76 > (lookup-in '(math /) t)
  77 #f
  78 > (lookup-in '(letters /) t)
  79 #f
  80 > (lookup-in '(letters a) t)
  81 97
  82 >
  83 |#