360 |
(let ((name (cadr exp))) |
(let ((name (cadr exp))) |
361 |
(cond ((not (symbol? name)) |
(cond ((not (symbol? name)) |
362 |
(goops-error "bad generic function name: ~S" name)) |
(goops-error "bad generic function name: ~S" name)) |
363 |
((and (top-level-env? env) |
((top-level-env? env) |
364 |
(defined? name env)) |
`(let* ((var (module-ensure-local-variable! |
365 |
`(define ,name |
(current-module) ',name)) |
366 |
(if (is-a? ,name <generic>) |
(old (and (variable-bound? var) (variable-ref var)))) |
367 |
(make <generic> #:name ',name) |
(if (or (not old) (is-a? old <generic>)) |
368 |
(ensure-generic ,name ',name)))) |
(variable-set! var (make <generic> #:name ',name)) |
369 |
|
(variable-set! var (ensure-generic old ',name))))) |
370 |
(else |
(else |
371 |
`(define ,name (make <generic> #:name ',name)))))))) |
`(define ,name (make <generic> #:name ',name)))))))) |
372 |
|
|
392 |
(let ((name (cadr exp))) |
(let ((name (cadr exp))) |
393 |
(cond ((not (symbol? name)) |
(cond ((not (symbol? name)) |
394 |
(goops-error "bad accessor name: ~S" name)) |
(goops-error "bad accessor name: ~S" name)) |
395 |
((and (top-level-env? env) |
((top-level-env? env) |
396 |
(defined? name env)) |
`(let* ((var (module-ensure-local-variable! |
397 |
`(define ,name |
(current-module) ',name)) |
398 |
(if (and (is-a? ,name <generic-with-setter>) |
(old (and (variable-bound? var) (variable-ref var)))) |
399 |
(is-a? (setter ,name) <generic>)) |
(if (or (not old) |
400 |
(make-accessor ',name) |
(and (is-a? old <generic-with-setter>) |
401 |
(ensure-accessor ,name ',name)))) |
(is-a? (setter old) <generic>))) |
402 |
|
(variable-set! var (make-accessor ',name)) |
403 |
|
(variable-set! var (ensure-accessor old ',name))))) |
404 |
(else |
(else |
405 |
`(define ,name (make-accessor ',name)))))))) |
`(define ,name (make-accessor ',name)))))))) |
406 |
|
|