summaryrefslogtreecommitdiff
path: root/module/oop/goops.scm
diff options
context:
space:
mode:
Diffstat (limited to 'module/oop/goops.scm')
-rw-r--r--module/oop/goops.scm37
1 files changed, 16 insertions, 21 deletions
diff --git a/module/oop/goops.scm b/module/oop/goops.scm
index 0845d29e9..e1908abf0 100644
--- a/module/oop/goops.scm
+++ b/module/oop/goops.scm
@@ -288,21 +288,18 @@
#'(define-class-pre-definitions (rest ...)
out ... (define-class-pre-definition (slotopt ...)))))))
-(define-syntax define-class
- (syntax-rules ()
- ((_ name supers slot ...)
- (begin
- (define-class-pre-definitions (slot ...))
- (if (and (defined? 'name)
- (is-a? name <class>)
- (memq <object> (class-precedence-list name)))
- (class-redefinition name
- (class supers slot ... #:name 'name))
- (toplevel-define! 'name (class supers slot ... #:name 'name)))))))
+(define-syntax-rule (define-class name supers slot ...)
+ (begin
+ (define-class-pre-definitions (slot ...))
+ (if (and (defined? 'name)
+ (is-a? name <class>)
+ (memq <object> (class-precedence-list name)))
+ (class-redefinition name
+ (class supers slot ... #:name 'name))
+ (toplevel-define! 'name (class supers slot ... #:name 'name)))))
-(define-syntax standard-define-class
- (syntax-rules ()
- ((_ arg ...) (define-class arg ...))))
+(define-syntax-rule (standard-define-class arg ...)
+ (define-class arg ...))
;;;
;;; {Generic functions and accessors}
@@ -390,13 +387,11 @@
(else (make <generic> #:name name))))
;; same semantics as <generic>
-(define-syntax define-accessor
- (syntax-rules ()
- ((_ name)
- (define name
- (cond ((not (defined? 'name)) (ensure-accessor #f 'name))
- ((is-a? name <accessor>) (make <accessor> #:name 'name))
- (else (ensure-accessor name 'name)))))))
+(define-syntax-rule (define-accessor name)
+ (define name
+ (cond ((not (defined? 'name)) (ensure-accessor #f 'name))
+ ((is-a? name <accessor>) (make <accessor> #:name 'name))
+ (else (ensure-accessor name 'name)))))
(define (make-setter-name name)
(string->symbol (string-append "setter:" (symbol->string name))))