summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMikael Djurfeldt <djurfeldt@nada.kth.se>2003-04-20 17:35:41 +0000
committerMikael Djurfeldt <djurfeldt@nada.kth.se>2003-04-20 17:35:41 +0000
commit05a6b2d3cce4d0f70f760b41c3838489e82be667 (patch)
tree2b2d7065cb8ca78fb514deb2e47f8ff3da3f9b1b
parent624b0da1ca1334ede115b80aa37700e3b7431024 (diff)
downloadguile-05a6b2d3cce4d0f70f760b41c3838489e82be667.tar.gz
* goops.scm (compute-getters-n-setters): Allow for primitive
procedure thunks. (Thanks to Neil W. Van Dyke.)
-rw-r--r--oop/ChangeLog5
-rw-r--r--oop/goops.scm15
2 files changed, 14 insertions, 6 deletions
diff --git a/oop/ChangeLog b/oop/ChangeLog
index 3e1f19c8a..a8d6a7a0d 100644
--- a/oop/ChangeLog
+++ b/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
diff --git a/oop/goops.scm b/oop/goops.scm
index 2d53cb94a..ebeac4c6f 100644
--- a/oop/goops.scm
+++ b/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)))))