/usr/share/scheme48-1.9/srfi/srfi-17.scm is in scheme48 1.9-5.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 | ; Part of Scheme 48 1.9. See file COPYING for notices and license.
; Authors: Richard Kelsey, Jonathan Rees
(define-syntax set!
(syntax-rules ()
((set! (?e0 ?e1 ...) ?v)
((setter ?e0) ?e1 ... ?v))
((set! ?i ?v)
(scheme-set! ?i ?v))))
(define (setter proc)
(let ((probe (assv proc setters)))
(if probe
(cdr probe)
(assertion-violation 'setter "No setter found" proc))))
(define (set-setter! proc setter)
(let ((probe (assv proc setters)))
(if probe
(set-cdr! probe setter)
(scheme-set! setters
(cons (cons proc setter)
setters)))
(unspecific)))
(define (car-setter proc)
(lambda (p v)
(set-car! (proc p) v)))
(define (cdr-setter proc)
(lambda (p v)
(set-cdr! (proc p) v)))
(define setters
(list (cons setter set-setter!)
(cons vector-ref vector-set!)
(cons string-ref string-set!)
(cons car set-car!)
(cons cdr set-cdr!)
(cons caar (car-setter car))
(cons cdar (cdr-setter car))
(cons cadr (car-setter cdr))
(cons cddr (cdr-setter cdr))
(cons caaar (car-setter caar))
(cons cdaar (cdr-setter caar))
(cons cadar (car-setter cdar))
(cons cddar (cdr-setter cdar))
(cons caadr (car-setter cadr))
(cons cdadr (cdr-setter cadr))
(cons caddr (car-setter cddr))
(cons cdddr (cdr-setter cddr))
(cons caaaar (car-setter caaar))
(cons cdaaar (cdr-setter caaar))
(cons cadaar (car-setter cdaar))
(cons cddaar (cdr-setter cdaar))
(cons caadar (car-setter cadar))
(cons cdadar (cdr-setter cadar))
(cons caddar (car-setter cddar))
(cons cdddar (cdr-setter cddar))
(cons caaadr (car-setter caadr))
(cons cdaadr (cdr-setter caadr))
(cons cadadr (car-setter cdadr))
(cons cddadr (cdr-setter cdadr))
(cons caaddr (car-setter caddr))
(cons cdaddr (cdr-setter caddr))
(cons cadddr (car-setter cdddr))
(cons cddddr (cdr-setter cdddr))))
|