1192 |
;;; |
;;; |
1193 |
(define (compute-getters-n-setters class slots env) |
(define (compute-getters-n-setters class slots env) |
1194 |
|
|
1195 |
(define (compute-slot-init-function s) |
(define (compute-slot-init-function name s) |
1196 |
(or (slot-definition-init-thunk s) |
(or (let ((thunk (slot-definition-init-thunk s))) |
1197 |
|
(and thunk |
1198 |
|
(if (not (and (closure? thunk) |
1199 |
|
(thunk? thunk))) |
1200 |
|
(goops-error "Bad init-thunk for slot `~S' in ~S: ~S" |
1201 |
|
name class thunk)) |
1202 |
|
thunk)) |
1203 |
(let ((init (slot-definition-init-value s))) |
(let ((init (slot-definition-init-value s))) |
1204 |
(and (not (unbound? init)) |
(and (not (unbound? init)) |
1205 |
(lambda () init))))) |
(lambda () init))))) |
1239 |
;; '() for other slots |
;; '() for other slots |
1240 |
(verify-accessors name g-n-s) |
(verify-accessors name g-n-s) |
1241 |
(cons name |
(cons name |
1242 |
(cons (compute-slot-init-function s) |
(cons (compute-slot-init-function name s) |
1243 |
(if (or (integer? g-n-s) |
(if (or (integer? g-n-s) |
1244 |
(zero? size)) |
(zero? size)) |
1245 |
g-n-s |
g-n-s |