42 lines
1.2 KiB
Scheme
42 lines
1.2 KiB
Scheme
|
;;; -*-Scheme-*-
|
||
|
|
;;;
|
||
|
|
;;; Utility macros for use with the record extension.
|
||
|
|
|
||
|
|
(define-macro (define-record-type name fields)
|
||
|
|
(let* ((rtd (eval `(make-record-type ',name ',fields)))
|
||
|
|
(namestr (symbol->string name)))
|
||
|
|
`(begin
|
||
|
|
(define
|
||
|
|
,(string->symbol (string-append namestr "-record")) ,rtd)
|
||
|
|
(define
|
||
|
|
,(string->symbol (string-append "make-" namestr "-record"))
|
||
|
|
,(record-constructor rtd '()))
|
||
|
|
(define
|
||
|
|
,(string->symbol (string-append namestr "-record?"))
|
||
|
|
,(record-predicate rtd)) #v)))
|
||
|
|
|
||
|
|
(define-macro (define-record-accessors rtd)
|
||
|
|
(let* ((r (eval rtd)))
|
||
|
|
`(begin
|
||
|
|
,@(map (lambda (field)
|
||
|
|
`(define (
|
||
|
|
,(string->symbol (string-append (record-type-name r) "-"
|
||
|
|
(symbol->string field)))
|
||
|
|
record)
|
||
|
|
(,(record-accessor r field) record)))
|
||
|
|
(record-type-field-names r)) #v)))
|
||
|
|
|
||
|
|
(define-macro (define-record-modifiers rtd)
|
||
|
|
(let* ((r (eval rtd)))
|
||
|
|
`(begin
|
||
|
|
,@(map (lambda (field)
|
||
|
|
`(define (
|
||
|
|
,(string->symbol (string-append
|
||
|
|
"set-" (record-type-name r) "-"
|
||
|
|
(symbol->string field) "!"))
|
||
|
|
record value)
|
||
|
|
(,(record-modifier r field) record value)))
|
||
|
|
(record-type-field-names r)) #v)))
|
||
|
|
|
||
|
|
(provide 'recordutil)
|