diff options
author | Mikael Djurfeldt <djurfeldt@nada.kth.se> | 2003-04-20 17:35:41 +0000 |
---|---|---|
committer | Mikael Djurfeldt <djurfeldt@nada.kth.se> | 2003-04-20 17:35:41 +0000 |
commit | 05a6b2d3cce4d0f70f760b41c3838489e82be667 (patch) | |
tree | 2b2d7065cb8ca78fb514deb2e47f8ff3da3f9b1b | |
parent | 624b0da1ca1334ede115b80aa37700e3b7431024 (diff) | |
download | guile-05a6b2d3cce4d0f70f760b41c3838489e82be667.tar.gz |
* goops.scm (compute-getters-n-setters): Allow for primitive
procedure thunks. (Thanks to Neil W. Van Dyke.)
-rw-r--r-- | oop/ChangeLog | 5 | ||||
-rw-r--r-- | oop/goops.scm | 15 |
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))))) |