[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Sample implementation

This page is part of the web mail archives of SRFI 17 from before July 7th, 2015. The new archives for SRFI 17 contain all messages, not just those from before July 7th, 2015.

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)))))
              (lambda (proc setter)
                (set! setters (cons (cons proc setter) setters))
      (set-setter! setter set-setter!)

; eof

Sample run:

> (load "srfi17.sch")
> (set! f 1)
> f
> (define x (cons 1 2))
> (set! (car x) 3)
> x
(3 . 2)
> (set! (cdr x) 20)
> x
(3 . 20)
> (set! x 5)
> x
> (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)