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

..

Browse Source 
original commit: e8c83ca1402ffa9dfec6a551e18d27d51994379c
This commit is contained in:
Robby Findler 2003-06-03 03:44:44 +00:00
parent 0e290d0104
commit 416f93cc1a
1 changed files with 15 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
collects/mzlib/surrogate.ss
View File

@ -24,10 +24,10 @@
(define (make-empty-lambda-case spec)
(syntax-case spec ()
[(id ...) (syntax [(ths id ...) (void)])]
[(id ...) (syntax [(ths super-call id ...) (super-call id ...)])]
[id
(identifier? (syntax id))
(syntax [(ths . name) (void)])]))
(syntax [(ths super-call . name) (apply super-call name)])]))
(define (make-overriding-method method-spec)
(syntax-case method-spec ()
@ -61,16 +61,22 @@
[name name])
(lambda (spec)
(syntax-case spec ()
[(id ...) (syntax [(id ...)
(when surrogate
(send surrogate name this id ...))
(super-name id ...)])]
[(id ...) (syntax [(id ...)
(let ([super-call
(lambda (id ...)
(super-name id ...))])
(if surrogate
(send surrogate name this super-call id ...)
(super-call id ...)))])]
[id
(identifier? (syntax id))
(syntax [name
(when surrogate
(send surrogate name this . id))
(super-name . id)])]))))
(let ([super-call
(lambda id
(super-name . id))])
(if surrogate
(send surrogate name this super-call . id)
(apply super-call id)))])]))))
(syntax-case stx ()
[(_ method-spec ...)