* goops.scm (compute-getters-n-setters): Allow for primitive

procedure thunks.  (Thanks to Neil W. Van Dyke.)

oop/ChangeLog

@@ -1,3 +1,8 @@
+2003-04-20  Mikael Djurfeldt  <djurfeldt@nada.kth.se>
+
+	* goops.scm (compute-getters-n-setters): Allow for primitive
+	procedure thunks.  (Thanks to Neil W. Van Dyke.)
+
 2003-04-19  Mikael Djurfeldt  <djurfeldt@nada.kth.se>
 
 	* goops/dispatch.scm (cache-hashval): Corrected termination

oop/goops.scm

@@ -1190,17 +1190,20 @@
 (define standard-set (standard-accessor-method make-set standard-set-methods))
 
 ;;; compute-getters-n-setters
-;;; 
+;;;
+(define (make-thunk thunk)
+  (lambda () (thunk)))
+
 (define (compute-getters-n-setters class slots env)
 
   (define (compute-slot-init-function name s)
     (or (let ((thunk (slot-definition-init-thunk s)))
 	  (and thunk
-	       (if (not (and (closure? thunk)
-			     (thunk? thunk)))
-		   (goops-error "Bad init-thunk for slot `~S' in ~S: ~S"
-				name class thunk))
-	       thunk))
+	       (cond ((not (thunk? thunk))
+		      (goops-error "Bad init-thunk for slot `~S' in ~S: ~S"
+				   name class thunk))
+		     ((closure? thunk) thunk)
+		     (else (make-thunk thunk)))))
 	(let ((init (slot-definition-init-value s)))
 	  (and (not (unbound? init))
 	       (lambda () init)))))