Tue May 5 13:15:41 CEST 2009

Data structure of the day: reference counter.

This macro builds a data structure for reference counting and
histogram building.

(define-struct entry-ref (object refs) #:mutable)
(define (add-ref! hash object entry)
  (let ((er (hash-ref hash object
                      (lambda ()
                        (let ((er (make-entry-ref object '())))
                          (hash-set! hash object er)
    (set-entry-ref-refs! er (cons entry (entry-ref-refs er)))
(define-syntax (define-ref-struct stx)
  (define (fmt fmt-string . a)
    (datum->syntax (car a)
                    (apply format fmt-string (map syntax->datum a)))))
  (syntax-case stx ()
    ((_ name (fieldname ...))
     (let ((fieldnames (syntax->list #'(fieldname ...))))
           (list* (fmt "make-~s" #'name)
                  (fmt "make-rc-~s" #'name)
                  (for/list ((f fieldnames))
                    (list (fmt "set-~s-~s!" #'name f)
                          (fmt "~s-ref" f))))
           (set-field! field-param) ...)
              (define-struct name (fieldname ...) #:mutable)
              (define field-param (make-parameter (make-hash))) ...
              (define (make-rc-instance fieldname ...)
                (let ((instance (make-instance fieldname ...)))
                  (set-field! instance
                              (add-ref! (field-param)
                                        fieldname instance))

So I removed this completely (the names complicate it greatly) and
created this function to work on tables instead:

(define (table-share table)

  ;; Register the object and put a shared instance in the vector.
  (define ((register! vec) hash object i)
    (vector-set! vec i
                  (add-ref! hash object vec))))
  (let* ((n (vector-length (car table)))
         (hashes (build-vector n (lambda _ (make-hash)))))
     (for/list ((entry table))
       (let ((v (make-vector n)))
         (for ((column entry)
               (hash hashes)
               (i (in-naturals)))
           ((register! v) hash column i))

Now I've updated this to generated a memoized expression by wrapping
it in a 'let expression that produces the table with shared data when
'eval ed.  This might come in handy somewhere else..  (aka memoization
aka common subexpression elimination).

box> (table->let (list (vector "foo" "a") 
                       (vector "foo" "b")
                       (vector "foo" "c")))
(let ((0:0 '"foo") 
      (1:2 '"c")
      (1:0 '"a")
      (1:1 '"b"))
  (list (vector 0:0 1:0) 
        (vector 0:0 1:1) 
        (vector 0:0 1:2)))