suzanne.soy/hyper-literate
1
0
Fork 0
Code Issues 4 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

fix defclass and some scheme/gui argument schemevarfont binding

Browse Source 
svn: r14042

original commit: d8d25debcd12d27588f31015d128b4b874ca3b8d
This commit is contained in:
Matthew Flatt 2009-03-10 23:14:53 +00:00
parent 1653b798cd
commit 9eb42b71ee
1 changed files with 8 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
collects/scribble/private/manual-class.ss
View File

@ -44,7 +44,7 @@
(define-struct decl (name super app-mixins intfs ranges mk-head body)) (define-struct decl (name super app-mixins intfs ranges mk-head body))
(define-struct constructor (def)) (define-struct constructor (def))
(define-struct meth (names mode desc def)) (define-struct meth (names mode def))
(define-struct spec (def)) (define-struct spec (def))
(define-struct impl (def)) (define-struct impl (def))
@ -155,7 +155,7 @@
(define (build-body decl body) (define (build-body decl body)
`(,@(map (lambda (i) `(,@(map (lambda (i)
(cond [(constructor? i) ((constructor-def i))] (cond [(constructor? i) ((constructor-def i))]
[(meth? i) ((meth-def i) (meth-desc i))] [(meth? i) ((meth-def i))]
[else i])) [else i]))
body) body)
,(make-delayed-block (lambda (r d ri) (make-inherited-table r d ri decl))))) ,(make-delayed-block (lambda (r d ri) (make-inherited-table r d ri decl)))))
@ -426,16 +426,14 @@
#'(make-meth '(name ...) #'(make-meth '(name ...)
'mode 'mode
(lambda () (lambda ()
(defproc* #:mode send #:within cname
([(name arg ...) result-type] ...)
(make-splice (make-splice
(append-map (lambda (f) (append-map (lambda (f)
(cond [(impl? f) ((impl-def f))] (cond [(impl? f) ((impl-def f))]
[(spec? f) ((spec-def f))] [(spec? f) ((spec-def f))]
[else (list f)])) [else (list f)]))
(list extra ... desc ...)))) (list extra ... desc ...))))))))]
(lambda (desc-splice)
(defproc* #:mode send #:within cname
([(name arg ...) result-type] ...)
(desc-splice))))))]
[(_ ([(name arg ...) result-type] ...) desc ...) [(_ ([(name arg ...) result-type] ...) desc ...)
#'(defmethod* #:mode public ([(name arg ...) result-type] ...) desc ...)])) #'(defmethod* #:mode public ([(name arg ...) result-type] ...) desc ...)]))