Re: Initial comments & questions Alex Shinn 31 Mar 2004 08:33 UTC

Sorry, this was a mix of two different ideas with a bug.  First is the
straightforward syntax-rules implementation via temp variables:

  (define-syntax with-slots
    (syntax-rules ()
      ((with-slots () obj . body) (begin . body))
      ((with-slots (slot1 slot2 ...) obj . body)
       (let ((slot1 (slot-ref obj 'slot1)))
         (with-slots (slot2 ...) obj body)))))

which is what the previous post ended up being.  This has two problems:

1) it doesn't reflect updates to the object's slots, via slot-set! or
other procedures which may mutate the object between the binding and the

  (with-slots (a b c) my-obj (slot-set! my-obj 'a 5) (+ a b c))
  => 111

2) it doesn't let us use CL-style setf:

;; quick setf implementation

(define (slot-set! obj slot val)
  (vector-set! obj (case slot ((a) 0) ((b) 1) ((c) 2) ((d) 3)) val))

(define (compute-setter proc)
  (cond ((eq? proc car) set-car!)
        ((eq? proc vector-ref) vector-set!)
        ((eq? proc slot-ref) slot-set!)))

(define-syntax setf
  (syntax-rules ()
    ((setf (proc args ...) val)
     ((compute-setter proc) args ... val))
    ((setf x val) (set! x val))))

;; my-obj is unchanged
(with-slots (a b) my-obj (setf a (+ a b)))

The following version of with-slots-computation instead of using temp
variables translates the symbols to direct calls to slot-ref:

(define-syntax-computation with-slots-computation
  (computation-rules ()
    ((with-slots-computation () obj . body)
     (syntax-return (begin . body)))
    ((with-slots-computation (slot1 slot2 ...) obj . body)
     (syntax-do (inner1 <- (with-slots-computation (slot2 ...) obj . body))
       (syntax-replace slot1 (slot-ref obj 'slot1) inner1)))))

(syntax-inspect (with-slots-computation (a) my-obj (+ a 1)))
=> (begin (+ (slot-ref my-obj 'a) 1))

And now intermediate mutations and setf work:

(with-slots (a b c) my-obj (setf a (+ a b c)))
#(111 10 100 1000)

But after this the previous example re-binding a fails:

(with-slots (a b) my-obj (let ((a 5)) (add a b)))

Error: invalid syntax (let (((...) 5)) (add (slot-ref my-obj (...)) (slot-ref my-obj (...)))).

We're blindly replacing "a" anywhere in the expression, even in a let
binding.  To fix this we'd need to resort to code walking techniques,
which really need the syntax-expand form Taylor suggested.  However, so
long as you don't use the bound slot names for any other purpose in the
literal, non-expanded body of the expression you're fine :)

[Note: everything is still slow due to memory constraints and thrashing.
I have no idea how it's sucking up >200MB of my RAM.]