diff options
author | Dirk Herrmann <dirk@dirk-herrmanns-seiten.de> | 2002-07-08 20:40:32 +0000 |
---|---|---|
committer | Dirk Herrmann <dirk@dirk-herrmanns-seiten.de> | 2002-07-08 20:40:32 +0000 |
commit | 9ffa41dbaeeb2ecbe58b3f2e5e4761e4520f6e64 (patch) | |
tree | 6694791d2ad5ed5364e0bfa217ff73bedac5a869 /oop/goops.scm | |
parent | 658b35a01e095ff9ed026847cddb1ae61016bea2 (diff) | |
download | guile-9ffa41dbaeeb2ecbe58b3f2e5e4761e4520f6e64.tar.gz |
* goops.scm (define-generic, define-accessor): Make sure that
implicit redefines only happen on top level.
* goops.scm (define-class, define-generic, define-accessor),
goops/stklos.scm (define-class): Use mmacros instead of macros.
Diffstat (limited to 'oop/goops.scm')
-rw-r--r-- | oop/goops.scm | 14 |
1 files changed, 8 insertions, 6 deletions
diff --git a/oop/goops.scm b/oop/goops.scm index b8f63ff27..6f7721d80 100644 --- a/oop/goops.scm +++ b/oop/goops.scm @@ -1,6 +1,6 @@ ;;; installed-scm-file -;;;; Copyright (C) 1998, 1999, 2000, 2001 Free Software Foundation, Inc. +;;;; Copyright (C) 1998,1999,2000,2001,2002 Free Software Foundation, Inc. ;;;; ;;;; This program is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by @@ -224,7 +224,7 @@ (name cadr) (slots cdddr)) - (procedure->macro + (procedure->memoizing-macro (lambda (exp env) (cond ((not (top-level-env? env)) (goops-error "define-class: Only allowed at top level")) @@ -361,12 +361,13 @@ ;;; (define define-generic - (procedure->macro + (procedure->memoizing-macro (lambda (exp env) (let ((name (cadr exp))) (cond ((not (symbol? name)) (goops-error "bad generic function name: ~S" name)) - ((defined? name env) + ((and (top-level-env? env) + (defined? name env)) `(define ,name (if (is-a? ,name <generic>) (make <generic> #:name ',name) @@ -391,12 +392,13 @@ (else (make <generic> #:name name))))) (define define-accessor - (procedure->macro + (procedure->memoizing-macro (lambda (exp env) (let ((name (cadr exp))) (cond ((not (symbol? name)) (goops-error "bad accessor name: ~S" name)) - ((defined? name env) + ((and (top-level-env? env) + (defined? name env)) `(define ,name (if (and (is-a? ,name <generic-with-setter>) (is-a? (setter ,name) <generic>)) |