1 ;;; srfi-17.scm --- Generalized set!
3 ;; Copyright (C) 2001, 2002, 2003, 2006 Free Software Foundation, Inc.
5 ;; This library is free software; you can redistribute it and/or
6 ;; modify it under the terms of the GNU Lesser General Public
7 ;; License as published by the Free Software Foundation; either
8 ;; version 2.1 of the License, or (at your option) any later version.
10 ;; This library is distributed in the hope that it will be useful,
11 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
12 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
13 ;; Lesser General Public License for more details.
15 ;; You should have received a copy of the GNU Lesser General Public
16 ;; License along with this library; if not, write to the Free Software
17 ;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
19 ;;; Author: Matthias Koeppe <mkoeppe@mail.math.uni-magdeburg.de>
23 ;; This is an implementation of SRFI-17: Generalized set!
25 ;; It exports the Guile procedure `make-procedure-with-setter' under
26 ;; the SRFI name `getter-with-setter' and exports the standard
27 ;; procedures `car', `cdr', ..., `cdddr', `string-ref' and
28 ;; `vector-ref' as procedures with setters, as required by the SRFI.
30 ;; SRFI-17 was heavily criticized during its discussion period but it
31 ;; was finalized anyway. One issue was its concept of globally
32 ;; associating setter "properties" with (procedure) values, which is
33 ;; non-Schemy. For this reason, this implementation chooses not to
34 ;; provide a way to set the setter of a procedure. In fact, (set!
35 ;; (setter PROC) SETTER) signals an error. The only way to attach a
36 ;; setter to a procedure is to create a new object (a "procedure with
37 ;; setter") via the `getter-with-setter' procedure. This procedure is
38 ;; also specified in the SRFI. Using it avoids the described
41 ;; This module is fully documented in the Guile Reference Manual.
45 (define-module (srfi srfi-17)
46 :export (getter-with-setter)
47 :replace (;; redefined standard procedures
49 car cdr caar cadr cdar cddr caaar caadr cadar caddr cdaar
50 cdadr cddar cdddr caaaar caaadr caadar caaddr cadaar cadadr
51 caddar cadddr cdaaar cdaadr cdadar cdaddr cddaar cddadr
52 cdddar cddddr string-ref vector-ref))
54 (cond-expand-provide (current-module) '(srfi-17))
58 (define getter-with-setter make-procedure-with-setter)
64 (error "Setting setters is not supported for a good reason."))))
66 ;;; Redefine R5RS procedures to appropriate procedures with setters
68 (define (compose-setter setter location)
70 (setter (location obj) value)))
73 (getter-with-setter (@ (guile) car)
76 (getter-with-setter (@ (guile) cdr)
80 (getter-with-setter (@ (guile) caar)
81 (compose-setter set-car! (@ (guile) car))))
83 (getter-with-setter (@ (guile) cadr)
84 (compose-setter set-car! (@ (guile) cdr))))
86 (getter-with-setter (@ (guile) cdar)
87 (compose-setter set-cdr! (@ (guile) car))))
89 (getter-with-setter (@ (guile) cddr)
90 (compose-setter set-cdr! (@ (guile) cdr))))
93 (getter-with-setter (@ (guile) caaar)
94 (compose-setter set-car! (@ (guile) caar))))
96 (getter-with-setter (@ (guile) caadr)
97 (compose-setter set-car! (@ (guile) cadr))))
99 (getter-with-setter (@ (guile) cadar)
100 (compose-setter set-car! (@ (guile) cdar))))
102 (getter-with-setter (@ (guile) caddr)
103 (compose-setter set-car! (@ (guile) cddr))))
105 (getter-with-setter (@ (guile) cdaar)
106 (compose-setter set-cdr! (@ (guile) caar))))
108 (getter-with-setter (@ (guile) cdadr)
109 (compose-setter set-cdr! (@ (guile) cadr))))
111 (getter-with-setter (@ (guile) cddar)
112 (compose-setter set-cdr! (@ (guile) cdar))))
114 (getter-with-setter (@ (guile) cdddr)
115 (compose-setter set-cdr! (@ (guile) cddr))))
118 (getter-with-setter (@ (guile) caaaar)
119 (compose-setter set-car! (@ (guile) caaar))))
121 (getter-with-setter (@ (guile) caaadr)
122 (compose-setter set-car! (@ (guile) caadr))))
124 (getter-with-setter (@ (guile) caadar)
125 (compose-setter set-car! (@ (guile) cadar))))
127 (getter-with-setter (@ (guile) caaddr)
128 (compose-setter set-car! (@ (guile) caddr))))
130 (getter-with-setter (@ (guile) cadaar)
131 (compose-setter set-car! (@ (guile) cdaar))))
133 (getter-with-setter (@ (guile) cadadr)
134 (compose-setter set-car! (@ (guile) cdadr))))
136 (getter-with-setter (@ (guile) caddar)
137 (compose-setter set-car! (@ (guile) cddar))))
139 (getter-with-setter (@ (guile) cadddr)
140 (compose-setter set-car! (@ (guile) cdddr))))
142 (getter-with-setter (@ (guile) cdaaar)
143 (compose-setter set-cdr! (@ (guile) caaar))))
145 (getter-with-setter (@ (guile) cdaadr)
146 (compose-setter set-cdr! (@ (guile) caadr))))
148 (getter-with-setter (@ (guile) cdadar)
149 (compose-setter set-cdr! (@ (guile) cadar))))
151 (getter-with-setter (@ (guile) cdaddr)
152 (compose-setter set-cdr! (@ (guile) caddr))))
154 (getter-with-setter (@ (guile) cddaar)
155 (compose-setter set-cdr! (@ (guile) cdaar))))
157 (getter-with-setter (@ (guile) cddadr)
158 (compose-setter set-cdr! (@ (guile) cdadr))))
160 (getter-with-setter (@ (guile) cdddar)
161 (compose-setter set-cdr! (@ (guile) cddar))))
163 (getter-with-setter (@ (guile) cddddr)
164 (compose-setter set-cdr! (@ (guile) cdddr))))
167 (getter-with-setter (@ (guile) string-ref)
171 (getter-with-setter (@ (guile) vector-ref)
174 ;;; srfi-17.scm ends here