Permalink
Browse files

2d local table

  • Loading branch information...
creasyw committed Jul 13, 2012
1 parent 251fa53 commit 6c619f1000ceef5c3c0e77f7a275d978fc3e2e8f
Showing with 35 additions and 0 deletions.
  1. +35 −0 misc/twod-table.scm
View
@@ -0,0 +1,35 @@
+(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) false))
+ false)))
+
+ (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!)
+ ((eq? m 'info) local-table)
+ (else (error "Unknown operation -- TABLE" m))))
+
+ dispatch))
+
+(define optable (make-table))
+(define get (optable 'lookup-proc))
+(define put (optable 'insert-proc!))
+(define check (optable 'info))
+

0 comments on commit 6c619f1

Please sign in to comment.