diff options
author | Andy Wingo <wingo@pobox.com> | 2011-09-02 11:36:14 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2011-09-02 11:36:14 +0200 |
commit | 0c65f52c6d45f60e197fad7162d05c0fce89e817 (patch) | |
tree | 36b801d56064c1686befe9c3de561ade6cd6e2fa /module/oop/goops.scm | |
parent | 1bbe0a631c4e72fffc033cb4f83eba7252ce3c9c (diff) | |
download | guile-0c65f52c6d45f60e197fad7162d05c0fce89e817.tar.gz |
more define-syntax-rule usage
* module/ice-9/boot-9.scm:
* module/ice-9/control.scm:
* module/ice-9/futures.scm:
* module/ice-9/optargs.scm:
* module/ice-9/poll.scm:
* module/ice-9/receive.scm:
* module/ice-9/threads.scm:
* module/ice-9/vlist.scm:
* module/language/assembly/compile-bytecode.scm:
* module/language/ecmascript/compile-tree-il.scm:
* module/language/tree-il.scm:
* module/oop/goops.scm:
* module/oop/goops/simple.scm:
* module/oop/goops/stklos.scm:
* module/srfi/srfi-1.scm:
* module/srfi/srfi-35.scm:
* module/srfi/srfi-39.scm:
* module/srfi/srfi-45.scm:
* module/srfi/srfi-67/compare.scm:
* module/sxml/match.scm:
* module/system/repl/error-handling.scm:
* module/system/repl/repl.scm:
* module/system/vm/inspect.scm:
* module/texinfo.scm:
* module/web/server.scm: Use define-syntax-rule, where it makes sense.
Diffstat (limited to 'module/oop/goops.scm')
-rw-r--r-- | module/oop/goops.scm | 37 |
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)))) |