summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDirk Herrmann <dirk@dirk-herrmanns-seiten.de>2002-07-08 20:40:32 +0000
committerDirk Herrmann <dirk@dirk-herrmanns-seiten.de>2002-07-08 20:40:32 +0000
commit9ffa41dbaeeb2ecbe58b3f2e5e4761e4520f6e64 (patch)
tree6694791d2ad5ed5364e0bfa217ff73bedac5a869
parent658b35a01e095ff9ed026847cddb1ae61016bea2 (diff)
downloadguile-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/ChangeLog8
-rw-r--r--oop/goops.scm14
-rw-r--r--oop/goops/stklos.scm4
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)