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

.

Browse Source 
original commit: 8d06d04682637a5e5103f9b2ab9ed86be7144e78
This commit is contained in:
Matthew Flatt 2001-03-16 03:27:18 +00:00
parent db6c8c90ef
commit b911d166be
1 changed files with 38 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

61
collects/mzlib/class.ss
View File

@ -57,29 +57,44 @@
super-make-object-id))
;; ----- Expand definitions -----
(let ([defn-and-exprs (map
(lambda (defn-or-expr)
(local-expand
defn-or-expr
(append
(kernel-form-identifier-list (quote-syntax here))
(list
(quote-syntax init)
(quote-syntax init-rest)
(quote-syntax field)
(quote-syntax init-field)
(quote-syntax inherit-field)
(quote-syntax private)
(quote-syntax public)
(quote-syntax override)
(quote-syntax public-final)
(quote-syntax override-final)
(quote-syntax rename)
(quote-syntax inherit)
this-id
super-instantiate-id
super-make-object-id))))
defn-and-exprs)]
(let ([defn-and-exprs (let ([expand
(lambda (defn-or-expr)
(local-expand
defn-or-expr
(append
(kernel-form-identifier-list (quote-syntax here))
(list
(quote-syntax init)
(quote-syntax init-rest)
(quote-syntax field)
(quote-syntax init-field)
(quote-syntax inherit-field)
(quote-syntax private)
(quote-syntax public)
(quote-syntax override)
(quote-syntax public-final)
(quote-syntax override-final)
(quote-syntax rename)
(quote-syntax inherit)
this-id
super-instantiate-id
super-make-object-id))))])
(let loop ([l defn-and-exprs])
(if (null? l)
null
(let ([e (expand (car l))])
(syntax-case e (begin)
[(begin expr ...)
(loop (append
(syntax->list (syntax (expr ...)))
(cdr l)))]
[(begin . _)
(raise-syntax-error
'class*
"ill-formed begin expression"
e
stx)]
[_else (cons e (loop (cdr l)))])))))]
[bad (lambda (msg expr)
(raise-syntax-error 'class* msg stx expr))]
[class-name (syntax-local-name)])