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

FFI reference mostly Scribbled

Browse Source 
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

82
collects/scribble/manual.ss
View File

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

22
collects/scribble/scheme.ss
View File

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