29 lines
1.2 KiB
Scheme
29 lines
1.2 KiB
Scheme
(define-module (d- oop)
|
|
#:use-module (srfi srfi-9)
|
|
#:use-module (srfi srfi-9 gnu)
|
|
#:export (define-record))
|
|
|
|
|
|
;; Super quick record definition
|
|
(define-syntax define-record
|
|
(lambda (ctx)
|
|
(define (syntax-append id . syns)
|
|
(datum->syntax id (apply symbol-append (map syntax->datum syns))))
|
|
(syntax-case ctx ()
|
|
[(_ name field ...)
|
|
(with-syntax ([rec-name (syntax-append #'name #'< #'name #'>)]
|
|
[ctor (syntax-append #'name #'make- #'name)]
|
|
[pred (syntax-append #'name #'name #'?)]
|
|
[(proc ...) (map (lambda (f) (syntax-append f #'name #'- f))
|
|
#'(field ...))]
|
|
[(getter ...) (map (lambda (f) (syntax-append f #'name #'- f #'-ref))
|
|
#'(field ...))]
|
|
[(setter ...) (map (lambda (f) (syntax-append f #'name #'- f #'-set!))
|
|
#'(field ...))])
|
|
#'(begin
|
|
(define-record-type rec-name
|
|
(ctor field ...)
|
|
pred
|
|
(field getter setter) ...)
|
|
(define proc (make-procedure-with-setter getter setter)) ...))])))
|