mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 11:50:28 +02:00
aa592f96b0
* testsuite: Move to... * test-suite/vm: ... here. * Makefile.am (SUBDIRS): Remove `testsuite'. * configure.ac: Output `test-suite/vm/Makefile' instead of `testsuite/Makefile'. * test-suite/Makefile.am (SUBDIRS): Add `vm'.
20 lines
644 B
Scheme
20 lines
644 B
Scheme
(define the-struct (vector 1 2))
|
|
|
|
(define get/set
|
|
(make-procedure-with-setter
|
|
(lambda (struct name)
|
|
(case name
|
|
((first) (vector-ref struct 0))
|
|
((second) (vector-ref struct 1))
|
|
(else #f)))
|
|
(lambda (struct name val)
|
|
(case name
|
|
((first) (vector-set! struct 0 val))
|
|
((second) (vector-set! struct 1 val))
|
|
(else #f)))))
|
|
|
|
(and (eq? (vector-ref the-struct 0) (get/set the-struct 'first))
|
|
(eq? (vector-ref the-struct 1) (get/set the-struct 'second))
|
|
(begin
|
|
(set! (get/set the-struct 'second) 77)
|
|
(eq? (vector-ref the-struct 1) (get/set the-struct 'second))))
|