original commit: ee747d66f9dbc953373d45432ba5e835098a81c2
This commit is contained in:
Matthew Flatt 2001-07-14 21:04:03 +00:00
parent 8189189a90
commit 8c12f9baeb
2 changed files with 37 additions and 2 deletions

View File

@ -838,6 +838,40 @@
defn-or-expr
...)))])))
(define-syntaxes (define-private define-public define-override)
(let ([mk
(lambda (who decl-form)
(lambda (stx)
(syntax-case stx ()
[(_ binding ...)
(let ([bindings (syntax->list (syntax (binding ...)))])
(let ([name-exprs
(map (lambda (binding)
(syntax-case binding ()
[(name expr)
(identifier? (syntax name))
(cons (syntax name) (syntax expr))]
[_else
(identifier? (syntax name))
(raise-syntax-error
who
"expected an identifer and expression"
stx
binding)]))
bindings)])
(with-syntax ([(name ...) (map car name-exprs)]
[(expr ...) (map cdr name-exprs)]
[decl-form decl-form])
(syntax
(begin
(decl-form name ...)
(define name expr)
...)))))])))])
(values
(mk 'define-private (syntax private))
(mk 'define-public (syntax public))
(mk 'define-overrde (syntax override)))))
;;--------------------------------------------------------------------
;; class implementation
;;--------------------------------------------------------------------
@ -1869,10 +1903,11 @@
(provide class class* class*/names class?
interface interface?
interface interface?
object% object?
make-object instantiate
send send* make-class-field-accessor make-class-field-mutator with-method
define-private define-public define-override
(rename make-generic/proc make-generic) send-generic
is-a? subclass? implementation? interface-extension?
object-interface

View File

@ -31,7 +31,7 @@
(error 'build-absolute-path "base path ~s is relative" p)
(apply build-path p args))))
; Note that normalize-path does not normalize the case
;; Note that normalize-path does not normalize the case
(define normalize-path
(letrec ([resolve-all
(lambda (path wrt)