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
|
; Part of Scheme 48 1.9. See file COPYING for notices and license.
; Authors: Richard Kelsey, Jonathan Rees, Robert Ransom
; This is JAR's define-record-type, which doesn't resemble Richard's.
; There's no implicit name concatenation, so it can be defined
; entirely using syntax-rules. Example:
; (define-record-type foo :foo
; (make-foo x y)
; foo? - predicate name is optional
; (x foo-x)
; (y foo-y)
; (z foo-z set-foo-z!))
(define-syntax define-record-type
(syntax-rules ()
((define-record-type ?type ; compatibility with SRFI 9
(?constructor ?arg ...) . ?more)
(define-record-type ?type ?type
(?constructor ?arg ...) . ?more))
((define-record-type ?id ?type
(?constructor ?arg ...)
(?field . ?field-stuff)
...)
(begin (define ?type (make-record-type '?id '(?field ...)))
(define ?constructor (record-constructor ?type '(?arg ...)))
(define-accessors ?type (?field . ?field-stuff) ...)))
((define-record-type ?id ?type
(?constructor ?arg ...)
?pred
?more ...)
(begin (define-record-type ?id ?type
(?constructor ?arg ...)
?more ...)
(define ?pred (record-predicate ?type))))))
; Straightforward version
(define-syntax define-accessors
(syntax-rules ()
((define-accessors ?type ?field-spec ...)
(begin (define-accessor ?type . ?field-spec) ...))))
(define-syntax define-accessor
(syntax-rules ()
((define-accessor ?type ?field ?accessor)
(define ?accessor (record-accessor ?type '?field)))
((define-accessor ?type ?field ?accessor ?modifier)
(begin (define ?accessor (record-accessor ?type '?field))
(define ?modifier (record-modifier ?type '?field))))
((define-accessor ?type ?field)
(begin))))
|
