44 lines
		
	
	
		
			1.0 KiB
		
	
	
	
		
			Scheme
		
	
	
	
			
		
		
	
	
			44 lines
		
	
	
		
			1.0 KiB
		
	
	
	
		
			Scheme
		
	
	
	
;;
 | 
						|
;; Two dimensional table, from: [SICP 2ed. p. 271]
 | 
						|
;;
 | 
						|
 | 
						|
(define (make-table)
 | 
						|
  (let ((local-table (list '*table*)))
 | 
						|
    (define (lookup key-1 key-2)
 | 
						|
      (let ((subtable (assoc key-1 (cdr local-table))))
 | 
						|
	(if subtable
 | 
						|
	    (let ((record (assoc key-2 (cdr subtable))))
 | 
						|
	      (if record
 | 
						|
		  (cdr record)
 | 
						|
		  #f))
 | 
						|
	    #f)))
 | 
						|
    (define (insert! key-1 key-2 value)
 | 
						|
      (let ((subtable (assoc key-1 (cdr local-table))))
 | 
						|
	(if subtable
 | 
						|
	    (let ((record (assoc key-2 (cdr subtable))))
 | 
						|
	      (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))
 | 
						|
			     
 | 
						|
;;
 | 
						|
;; Tagged list from [SICP 2ed. p. 369]
 | 
						|
;;
 | 
						|
 | 
						|
(define (tagged-list? exp tag)
 | 
						|
  (if (pair? exp)
 | 
						|
      (eq? (car exp) tag)
 | 
						|
      false))
 | 
						|
 |