Sample implementation

[Lars Thomas Hansen <lth@xxxxxxxxxxx>]

I hacked up a sample implementation that, as far as I can tell, covers
the entire specification (Alternative 1 because I'm lazy).  It uses an
extension to DEFINE-SYNTAX that is particular to Twobit, but other than
that it is portable.  --lars

; SRFI 17
; 2000-01-17 / lth.  Share and enjoy.

; Use the LET* syntax scope extension in Twobit to let this SET! macro
; reference the old definition of SET! in the second clause.

(define-syntax set! let*
  (syntax-rules ()
    ((set! (?e0 ?e1 ...) ?v)
     ((setter ?e0) ?e1 ... ?v))
    ((set! ?i ?v)
     (set! ?i ?v))))

(define setter 
  (let ((setters (list (cons car  set-car!)
                       (cons cdr  set-cdr!)
                       (cons caar (lambda (p v) (set-car! (car p) v)))
                       (cons cadr (lambda (p v) (set-car! (cdr p) v)))
                       (cons cdar (lambda (p v) (set-cdr! (car p) v)))
                       (cons cddr (lambda (p v) (set-cdr! (cdr p) v)))
                       (cons vector-ref vector-set!)
                       (cons string-ref string-set!))))
    (letrec ((setter
              (lambda (proc)
                (let ((probe (assv proc setters)))
                  (if probe
                      (cdr probe)
                      (error "No setter for " proc)))))
             (set-setter!
              (lambda (proc setter)
                (set! setters (cons (cons proc setter) setters))
                (unspecified))))
      (set-setter! setter set-setter!)
      setter)))

; eof

Sample run:

> (load "srfi17.sch")
> (set! f 1)
> f
1
> (define x (cons 1 2))
> (set! (car x) 3)
> x
(3 . 2)
> (set! (cdr x) 20)
> x
(3 . 20)
> (set! x 5)
> x
5
> (set! (setter caddr) (lambda (p v) (set-car! (cddr p) v)))
> (define y (list 1 2 3))
> (set! (caddr y) 4)
> y
(1 2 4)