RE: Implementing 2d-put! and 2d-get in DrScheme

["Anton van Straaten" <anton@appsolutions.com>]

Attached below is an MzScheme version of MIT Scheme's association table
(prop2d.scm).  It follows the spec at:
http://www.swiss.ai.mit.edu/projects/scheme/documentation/scheme_12.html#SEC
106

Following the implementation in prop2d.scm, which used an MIT Scheme
mechanism for weak references to objects, this implementation uses
MzScheme's weak hash tables.  This obviated the MIT code related to weak
references and garbage collection (at least, I think it did).

If this were going to be used for any purpose other than compatibility with
MIT Scheme, I would give it a constructor (e.g.
"make-2d-association-table"), add an association table parameter to the
accessors and mutators, eliminate the global variable "system-properties",
and package it all in a module.

-Anton


(define system-properties (make-hash-table-weak))

(define (not-found) #f)

(define (2d-put! x y value)
  (let* ((add-new-bucket
          (lambda ()
            (let ((new-bucket (make-hash-table-weak)))
              (hash-table-put! system-properties x new-bucket)
              new-bucket)))
         (bucket (hash-table-get system-properties x add-new-bucket)))
    (hash-table-put! bucket y value)))

(define (2d-get x y)
  (let ((bucket (hash-table-get system-properties x not-found)))
    (if bucket
        (hash-table-get bucket y not-found)
        #f)))

(define (2d-remove! x y)
  (let ((bucket (hash-table-get system-properties x not-found)))
    (if bucket
        (hash-table-remove! bucket y))))

(define (2d-get-alist-x x)
  (let ((bucket (hash-table-get system-properties x not-found)))
    (if bucket
      (hash-table-map bucket (lambda (k v) (cons k v)))
      '())))

(define (2d-get-alist-y y)
  (let ((alist '()))
    (hash-table-for-each
     system-properties
     (lambda (k x-bucket)
       (let/cc done
         (let ((v (hash-table-get x-bucket y done)))
           (set! alist (cons (cons k v) alist))))))
    alist))