diff options
Diffstat (limited to 'shared')
| -rw-r--r-- | shared/sets.rkt | 3 | ||||
| -rw-r--r-- | shared/table.rkt | 37 |
2 files changed, 38 insertions, 2 deletions
diff --git a/shared/sets.rkt b/shared/sets.rkt index e20ba7f..7009d87 100644 --- a/shared/sets.rkt +++ b/shared/sets.rkt @@ -25,7 +25,7 @@ (element-of-set? (right-branch mset))) ((< x (entry mset)) (element-of-set? (left-branch mset))))) - + (define (adjoin-set x mset) (cond ((null? mset) (make-entry x '() '())) ((= x (entry mset)) mset) @@ -105,4 +105,3 @@ (list->tree (ordered-list-intersection-set (tree->list set1) (tree->list set2)))) - diff --git a/shared/table.rkt b/shared/table.rkt new file mode 100644 index 0000000..be4155e --- /dev/null +++ b/shared/table.rkt @@ -0,0 +1,37 @@ +#lang racket +(require compatibility/mlist) + +(define (make-table same-key?) + (let ((local-table (mlist '*table*))) + (define (assoc key records) + (cond ((null? records) false) + ((same-key? key (mcar (mcar records))) (mcar records)) + (else (assoc key (mcdr records))))) + (define (lookup key-1 key-2) + (let ((subtable (assoc key-1 (mcdr local-table)))) + (if subtable + (let ((record (assoc key-2 (mcdr subtable)))) + (if record + (mcdr record) + false)) + false))) + (define (insert! key-1 key-2 value) + (let ((subtable (assoc key-1 (mcdr local-table)))) + (if subtable + (let ((record (assoc key-2 (mcdr subtable)))) + (if record + (set-mcdr! record value) + (set-mcdr! subtable + (mcons (mcons key-2 value) + (mcdr subtable))))) + (set-mcdr! local-table + (mcons (mlist key-1 (mcons key-2 value)) (mcdr 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 tbl (make-table (lambda (a b) (equal? a b)))) +((tbl 'insert-proc) 'test 'message "hi") +((tbl 'lookup-proc) 'test 'message) |