* goops.scm (process-class-pre-define-generic,

process-class-pre-define-accessor, process-define-generic,
process-define-accessor): New functions.
(define-class-pre-definition): Use
process-class-pre-define-generic and
process-class-pre-define-accessor; Make sure not to create a new
local variable if the variable has been imported.
(define-generic): Use process-define-generic.
(define-accessor): Use process-define-accessor.

oop/ChangeLog

@@ -1,3 +1,15 @@
+2003-03-17  Mikael Djurfeldt  <djurfeldt@nada.kth.se>
+
+	* goops.scm (process-class-pre-define-generic,
+	process-class-pre-define-accessor, process-define-generic,
+	process-define-accessor): New functions.
+	(define-class-pre-definition): Use
+	process-class-pre-define-generic and
+	process-class-pre-define-accessor; Make sure not to create a new
+	local variable if the variable has been imported.
+	(define-generic): Use process-define-generic.
+	(define-accessor): Use process-define-accessor.
+
 2003-03-12  Mikael Djurfeldt  <djurfeldt@nada.kth.se>
 
 	* goops.scm (merge-generics): Make sure not to merge a gf with

oop/goops.scm

@@ -61,6 +61,10 @@
 	   make-generic ensure-generic
 	   make-extended-generic
 	   make-accessor ensure-accessor
+	   process-class-pre-define-generic
+	   process-class-pre-define-accessor
+	   process-define-generic
+	   process-define-accessor
 	   make-method add-method!
 	   object-eqv? object-equal?
 	   class-slot-ref class-slot-set! slot-unbound slot-missing 
@@ -180,15 +184,26 @@
 (define (define-class-pre-definition keyword exp env)
   (case keyword
     ((#:getter #:setter)
-     (if (defined? exp env)
+     `(process-class-pre-define-generic ',exp))
-	 `(define ,exp (ensure-generic ,exp ',exp))
-	 `(define ,exp (make-generic ',exp))))
     ((#:accessor)
-     (if (defined? exp env)
+     `(process-class-pre-define-accessor ',exp))
-	 `(define ,exp (ensure-accessor ,exp ',exp))
-	 `(define ,exp (make-accessor ',exp))))
     (else #f)))
 
+(define (process-class-pre-define-generic name)
+  (let ((var (module-variable (current-module) name)))
+    (if (not (and var
+		  (variable-bound? var)
+		  (is-a? (variable-ref var) <generic>)))
+	(process-define-generic name))))
+
+(define (process-class-pre-define-accessor name)
+  (let ((var (module-variable (current-module) name)))
+    (if (not (and var
+		  (variable-bound? var)
+		  (or (is-a? (variable-ref var) <accessor>)
+		      (is-a? (variable-ref var) <extended-generic-with-setter>))))
+	(process-define-accessor name))))
+
 ;;; This code should be implemented in C.
 ;;;
 (define define-class
@@ -365,15 +380,20 @@
 	(cond ((not (symbol? name))
 	       (goops-error "bad generic function name: ~S" name))
 	      ((top-level-env? env)
-	       `(let* ((var (module-ensure-local-variable!
+	       `(process-define-generic ',name))
-			     (current-module) ',name))
-		       (old (and (variable-bound? var) (variable-ref var))))
-		  (if (or (not old) (is-a? old <generic>))
-		      (variable-set! var (make <generic> #:name ',name))
-		      (variable-set! var (ensure-generic old ',name)))))
 	      (else
 	       `(define ,name (make <generic> #:name ',name))))))))
 
+(define (process-define-generic name)
+  (let ((var (module-ensure-local-variable! (current-module) name)))
+    (if (or (not var)
+	    (not (variable-bound? var))
+	    (is-a? (variable-ref var) <generic>))
+	;; redefine if NAME isn't defined previously, or is another generic
+	(variable-set! var (make <generic> #:name name))
+	;; otherwise try to upgrade the object to a generic
+	(variable-set! var (ensure-generic (variable-ref var) name)))))
+
 (define define-extended-generic
   (procedure->memoizing-macro
     (lambda (exp env)
@@ -462,17 +482,21 @@
 	(cond ((not (symbol? name))
 	       (goops-error "bad accessor name: ~S" name))
 	      ((top-level-env? env)
-	       `(let* ((var (module-ensure-local-variable!
+	       `(process-define-accessor ',name))
-			     (current-module) ',name))
-		       (old (and (variable-bound? var) (variable-ref var))))
-		  (if (or (not old)
-			  (and (is-a? old <accessor>)
-			       (is-a? (setter old) <generic>)))
-		      (variable-set! var (make-accessor ',name))
-		      (variable-set! var (ensure-accessor old ',name)))))
 	      (else
 	       `(define ,name (make-accessor ',name))))))))
 
+(define (process-define-accessor name)
+  (let ((var (module-ensure-local-variable! (current-module) name)))
+    (if (or (not var)
+	    (not (variable-bound? var))
+	    (is-a? (variable-ref var) <accessor>)
+	    (is-a? (variable-ref var) <extended-generic-with-setter>))
+	;; redefine if NAME isn't defined previously, or is another accessor
+	(variable-set! var (make-accessor name))
+	;; otherwise try to upgrade the object to an accessor
+	(variable-set! var (ensure-accessor (variable-ref var) name)))))
+
 (define (make-setter-name name)
   (string->symbol (string-append "setter:" (symbol->string name))))