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 | |
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.
-rw-r--r-- | oop/ChangeLog | 8 | ||||
-rw-r--r-- | oop/goops.scm | 14 | ||||
-rw-r--r-- | oop/goops/stklos.scm | 4 |
3 files changed, 18 insertions, 8 deletions
diff --git a/oop/ChangeLog b/oop/ChangeLog index df483c652..0bde849e4 100644 --- a/oop/ChangeLog +++ b/oop/ChangeLog @@ -1,3 +1,11 @@ +2002-07-08 Dirk Herrmann <D.Herrmann@tu-bs.de> + + * 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. + 2002-07-07 Dirk Herrmann <D.Herrmann@tu-bs.de> * goops/save.scm (restore): Replaced "macro" by mmacro. 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>)) diff --git a/oop/goops/stklos.scm b/oop/goops/stklos.scm index 4d84df444..10e0eba3b 100644 --- a/oop/goops/stklos.scm +++ b/oop/goops/stklos.scm @@ -1,4 +1,4 @@ -;;;; Copyright (C) 1999 Free Software Foundation, Inc. +;;;; Copyright (C) 1999,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 @@ -81,7 +81,7 @@ (supers caddr) (slots cadddr) (rest cddddr)) - (procedure->macro + (procedure->memoizing-macro (lambda (exp env) (standard-define-class-transformer `(define-class ,(name exp) ,(supers exp) ,@(slots exp) |