FFI reference mostly Scribbled

svn: r7942

original commit: 102249efc4c725e894e24b3c6b4a2382146d3b30
This commit is contained in:
Matthew Flatt 2007-12-10 22:39:38 +00:00
parent 302ea79cd5
commit 92e4cff791
2 changed files with 59 additions and 45 deletions

View File

@ -227,7 +227,7 @@
verbatim) verbatim)
(provide image onscreen menuitem defterm (provide image onscreen menuitem defterm
schemefont schemevalfont schemeresultfont schemeidfont schemefont schemevalfont schemeresultfont schemeidfont schemevarfont
schemeparenfont schemekeywordfont schememetafont schememodfont schemeparenfont schemekeywordfont schememetafont schememodfont
filepath exec envvar Flag DFlag filepath exec envvar Flag DFlag
indexed-file indexed-envvar indexed-file indexed-envvar
@ -259,6 +259,8 @@
(make-element "schemeresult" (decode-content str))) (make-element "schemeresult" (decode-content str)))
(define (schemeidfont . str) (define (schemeidfont . str)
(make-element "schemesymbol" (decode-content str))) (make-element "schemesymbol" (decode-content str)))
(define (schemevarfont . str)
(make-element "schemevariable" (decode-content str)))
(define (schemeparenfont . str) (define (schemeparenfont . str)
(make-element "schemeparen" (decode-content str))) (make-element "schemeparen" (decode-content str)))
(define (schememetafont . str) (define (schememetafont . str)
@ -436,7 +438,7 @@
;; ---------------------------------------- ;; ----------------------------------------
(provide declare-exporting (provide declare-exporting
defproc defproc* defstruct defthing defparam defboolparam defproc defproc* defstruct defthing defthing* defparam defboolparam
defform defform* defform/subs defform*/subs defform/none defform defform* defform/subs defform*/subs defform/none
defidform defidform
specform specform/subs specform specform/subs
@ -671,7 +673,13 @@
(define-syntax defthing (define-syntax defthing
(syntax-rules () (syntax-rules ()
[(_ id result desc ...) [(_ id result desc ...)
(*defthing (quote-syntax/loc id) 'id #f (schemeblock0 result) (lambda () (list desc ...)))])) (*defthing (list (quote-syntax/loc id)) (list 'id) #f (list (schemeblock0 result))
(lambda () (list desc ...)))]))
(define-syntax defthing*
(syntax-rules ()
[(_ ([id result] ...) desc ...)
(*defthing (list (quote-syntax/loc id) ...) (list 'id ...) #f (list (schemeblock0 result) ...)
(lambda () (list desc ...)))]))
(define-syntax defparam (define-syntax defparam
(syntax-rules () (syntax-rules ()
[(_ id arg contract desc ...) [(_ id arg contract desc ...)
@ -1285,42 +1293,43 @@
fields field-contracts))) fields field-contracts)))
(content-thunk)))) (content-thunk))))
(define (*defthing stx-id name form? result-contract content-thunk) (define (*defthing stx-ids names form? result-contracts content-thunk)
(define spacer (hspace 1)) (define spacer (hspace 1))
(make-splice (make-splice
(cons (cons
(make-table (make-table
'boxed 'boxed
(list (map (lambda (stx-id name result-contract)
(list (list
(make-flow (make-flow
(make-table-if-necessary (make-table-if-necessary
"argcontract" "argcontract"
(list (list
(list (make-flow (list (make-flow
(list (list
(make-paragraph (make-paragraph
(list (let ([tag ((if form? id-to-form-tag id-to-tag) stx-id)] (list (let ([tag ((if form? id-to-form-tag id-to-tag) stx-id)]
[content (list (definition-site name stx-id form?))]) [content (list (definition-site name stx-id form?))])
(if tag (if tag
(make-toc-target-element (make-toc-target-element
#f #f
(list (make-index-element #f (list (make-index-element #f
content content
tag tag
(list (symbol->string name)) (list (symbol->string name))
content content
(with-exporting-libraries (with-exporting-libraries
(lambda (libs) (lambda (libs)
(make-thing-index-desc name libs))))) (make-thing-index-desc name libs)))))
tag) tag)
(car content))) (car content)))
spacer ":" spacer)))) spacer ":" spacer))))
(make-flow (make-flow
(list (list
(if (flow-element? result-contract) (if (flow-element? result-contract)
result-contract result-contract
(make-paragraph (list result-contract)))))))))))) (make-paragraph (list result-contract)))))))))))
stx-ids names result-contracts))
(content-thunk)))) (content-thunk))))
(define (meta-symbol? s) (memq s '(... ...+ ?))) (define (meta-symbol? s) (memq s '(... ...+ ?)))
@ -2055,7 +2064,10 @@
(make-sig-desc l)) (make-sig-desc l))
(define (*defsignature stx-id supers body-thunk indent?) (define (*defsignature stx-id supers body-thunk indent?)
(*defthing stx-id (syntax-e stx-id) #t (make-element #f '("signature")) (*defthing (list stx-id)
(list (syntax-e stx-id))
#t
(list (make-element #f '("signature")))
(lambda () (lambda ()
(let ([in (parameterize ([current-signature (make-sig (let ([in (parameterize ([current-signature (make-sig
(id-to-form-tag stx-id))]) (id-to-form-tag stx-id))])

View File

@ -60,16 +60,18 @@
i))) i)))
(define (typeset-atom c out color? quote-depth) (define (typeset-atom c out color? quote-depth)
(let-values ([(s it? sub?) (let*-values ([(is-var?) (and (identifier? c)
(let ([c (syntax-e c)]) (memq (syntax-e c) (current-variable-list)))]
(let ([s (format "~s" c)]) [(s it? sub?)
(if (and (symbol? c) (let ([sc (syntax-e c)])
((string-length s) . > . 1) (let ([s (format "~s" sc)])
(char=? (string-ref s 0) #\_)) (if (and (symbol? sc)
(values (substring s 1) #t #f) ((string-length s) . > . 1)
(values s #f #f))))] (char=? (string-ref s 0) #\_)
[(is-var?) (and (identifier? c) (not (or (identifier-label-binding c)
(memq (syntax-e c) (current-variable-list)))]) is-var?)))
(values (substring s 1) #t #f)
(values s #f #f))))])
(if (or (element? (syntax-e c)) (if (or (element? (syntax-e c))
(delayed-element? (syntax-e c))) (delayed-element? (syntax-e c)))
(out (syntax-e c) #f) (out (syntax-e c) #f)