suzanne.soy/compatibility
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

.

Browse Source 
original commit: b58dd97194b162bce69d7ae13d1b750e0e6f3615
This commit is contained in:
Matthew Flatt 2001-10-26 22:35:43 +00:00
parent d147d6c8e1
commit 3581bcf928
1 changed files with 30 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
collects/mzlib/class.ss
View File

@ -1660,7 +1660,9 @@
;; methods and fields ;; methods and fields
;;-------------------------------------------------------------------- ;;--------------------------------------------------------------------
(define-syntax send (define-syntaxes (send send/apply)
(let ([mk
(lambda (flatten?)
(lambda (stx) (lambda (stx)
(syntax-case stx () (syntax-case stx ()
[(_ obj name . args) [(_ obj name . args)
@ -1671,12 +1673,21 @@
"method name is not an identifier" "method name is not an identifier"
stx stx
(syntax name))) (syntax name)))
(if flatten?
(if (stx-list? (syntax args))
(syntax (let ([this obj])
(apply (find-method this 'name) this . args)))
(raise-syntax-error
#f
"bad syntax (illegal use of `.')"
stx))
(if (stx-list? (syntax args)) (if (stx-list? (syntax args))
(syntax (let ([this obj]) (syntax (let ([this obj])
((find-method this 'name) this . args))) ((find-method this 'name) this . args)))
(with-syntax ([args (flatten-args (syntax args))]) (with-syntax ([args (flatten-args (syntax args))])
(syntax (let ([this obj]) (syntax (let ([this obj])
(apply (find-method this 'name) this . args))))))]))) (apply (find-method this 'name) this . args)))))))])))])
(values (mk #f) (mk #t))))
(define-syntax send* (define-syntax send*
(lambda (stx) (lambda (stx)
@ -2004,7 +2015,7 @@
(rename :interface interface) interface? (rename :interface interface) interface?
object% object? object% object?
make-object instantiate make-object instantiate
send send* make-class-field-accessor make-class-field-mutator with-method send send/apply send* make-class-field-accessor make-class-field-mutator with-method
private* public* override* private* public* override*
define/private define/public define/override define/private define/public define/override
(rename make-generic/proc make-generic) send-generic (rename make-generic/proc make-generic) send-generic