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)