ompayne
/
sicp
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Add insert! for 3.25 

Could do with some tidying up but seems to work OK.
This commit is contained in:
Oliver Payne 2022-05-12 22:57:59 +01:00
parent 2f2e704cf6
commit 791c601d29
1 changed files with 26 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
3_25.rkt
View File

@ -5,40 +5,44 @@
(define (make-table)
(list '*table*))
;;(define (find-record
(define (assoc key records)
(cond ((null? records) false)
((equal? key (caar records)) (car records))
(else (assoc key (cdr records)))))
(define (table? l)
(pair? (cdr l)))
(define (empty? table)
(not (list? (cdr table))))
(trace-define (lookup keys table)
(cond ((null? keys) (cdr table))
((not (table? table)) false)
((empty? table) false)
(else
(let ((subtable (assoc (car keys) (cdr table))))
(if subtable
(lookup (cdr keys) subtable)
false)))))
(define (insert! key-1 key-2 value table)
(let ((subtable (assoc key-1 (cdr 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! table
(cons (list key-1
(cons key-2 value))
(cdr table)))))
(define (insert! keys value table)
(trace-define (insert-subtable! keys subtable)
(if (and (not (null? keys))
(not (null? subtable)))
(let* ((key (car keys))
(record (assoc (car keys) (cdr subtable))))
(if record
(if (= (length keys) 1)
(set-cdr! record value))
(set-cdr! subtable
(cons (cons key
(if (= (length keys) 1)
value
'()))
(cdr subtable))))
(let ((next-subtable (assoc key (cdr subtable))))
(insert-subtable! (cdr keys) next-subtable)))))
(insert-subtable! keys table)
'ok)
(#%require (only racket/base module+))
(module+ test
@ -46,7 +50,8 @@
(test-begin
(define t (make-table))
(insert! 10 10 'a t)
(insert! '(10 10) 'a t)
(check-equal? (lookup '(10 10) t) 'a)
(check-equal? (lookup '(10 10 10) t) false))
)
(check-equal? (lookup '(10 10 10) t) false)
(insert! '(20) 'b t)
(check-equal? (lookup '(20) t) 'b)))