123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175 |
- (define-module (srfi srfi-17)
- :export (getter-with-setter)
- :replace (
- setter
- car cdr caar cadr cdar cddr caaar caadr cadar caddr cdaar
- cdadr cddar cdddr caaaar caaadr caadar caaddr cadaar cadadr
- caddar cadddr cdaaar cdaadr cdadar cdaddr cddaar cddadr
- cdddar cddddr string-ref vector-ref))
- (cond-expand-provide (current-module) '(srfi-17))
- (define getter-with-setter make-procedure-with-setter)
- (define setter
- (getter-with-setter
- (@ (guile) setter)
- (lambda args
- (error "Setting setters is not supported for a good reason."))))
- (define (compose-setter setter location)
- (lambda (obj value)
- (setter (location obj) value)))
- (define car
- (getter-with-setter (@ (guile) car)
- set-car!))
- (define cdr
- (getter-with-setter (@ (guile) cdr)
- set-cdr!))
- (define caar
- (getter-with-setter (@ (guile) caar)
- (compose-setter set-car! (@ (guile) car))))
- (define cadr
- (getter-with-setter (@ (guile) cadr)
- (compose-setter set-car! (@ (guile) cdr))))
- (define cdar
- (getter-with-setter (@ (guile) cdar)
- (compose-setter set-cdr! (@ (guile) car))))
- (define cddr
- (getter-with-setter (@ (guile) cddr)
- (compose-setter set-cdr! (@ (guile) cdr))))
- (define caaar
- (getter-with-setter (@ (guile) caaar)
- (compose-setter set-car! (@ (guile) caar))))
- (define caadr
- (getter-with-setter (@ (guile) caadr)
- (compose-setter set-car! (@ (guile) cadr))))
- (define cadar
- (getter-with-setter (@ (guile) cadar)
- (compose-setter set-car! (@ (guile) cdar))))
- (define caddr
- (getter-with-setter (@ (guile) caddr)
- (compose-setter set-car! (@ (guile) cddr))))
- (define cdaar
- (getter-with-setter (@ (guile) cdaar)
- (compose-setter set-cdr! (@ (guile) caar))))
- (define cdadr
- (getter-with-setter (@ (guile) cdadr)
- (compose-setter set-cdr! (@ (guile) cadr))))
- (define cddar
- (getter-with-setter (@ (guile) cddar)
- (compose-setter set-cdr! (@ (guile) cdar))))
- (define cdddr
- (getter-with-setter (@ (guile) cdddr)
- (compose-setter set-cdr! (@ (guile) cddr))))
- (define caaaar
- (getter-with-setter (@ (guile) caaaar)
- (compose-setter set-car! (@ (guile) caaar))))
- (define caaadr
- (getter-with-setter (@ (guile) caaadr)
- (compose-setter set-car! (@ (guile) caadr))))
- (define caadar
- (getter-with-setter (@ (guile) caadar)
- (compose-setter set-car! (@ (guile) cadar))))
- (define caaddr
- (getter-with-setter (@ (guile) caaddr)
- (compose-setter set-car! (@ (guile) caddr))))
- (define cadaar
- (getter-with-setter (@ (guile) cadaar)
- (compose-setter set-car! (@ (guile) cdaar))))
- (define cadadr
- (getter-with-setter (@ (guile) cadadr)
- (compose-setter set-car! (@ (guile) cdadr))))
- (define caddar
- (getter-with-setter (@ (guile) caddar)
- (compose-setter set-car! (@ (guile) cddar))))
- (define cadddr
- (getter-with-setter (@ (guile) cadddr)
- (compose-setter set-car! (@ (guile) cdddr))))
- (define cdaaar
- (getter-with-setter (@ (guile) cdaaar)
- (compose-setter set-cdr! (@ (guile) caaar))))
- (define cdaadr
- (getter-with-setter (@ (guile) cdaadr)
- (compose-setter set-cdr! (@ (guile) caadr))))
- (define cdadar
- (getter-with-setter (@ (guile) cdadar)
- (compose-setter set-cdr! (@ (guile) cadar))))
- (define cdaddr
- (getter-with-setter (@ (guile) cdaddr)
- (compose-setter set-cdr! (@ (guile) caddr))))
- (define cddaar
- (getter-with-setter (@ (guile) cddaar)
- (compose-setter set-cdr! (@ (guile) cdaar))))
- (define cddadr
- (getter-with-setter (@ (guile) cddadr)
- (compose-setter set-cdr! (@ (guile) cdadr))))
- (define cdddar
- (getter-with-setter (@ (guile) cdddar)
- (compose-setter set-cdr! (@ (guile) cddar))))
- (define cddddr
- (getter-with-setter (@ (guile) cddddr)
- (compose-setter set-cdr! (@ (guile) cdddr))))
- (define string-ref
- (getter-with-setter (@ (guile) string-ref)
- string-set!))
- (define vector-ref
- (getter-with-setter (@ (guile) vector-ref)
- vector-set!))
|