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

doc work, especially I/O reference

Browse Source 
svn: r6803

original commit: 987982cd8da01fabe0253d983491a79d8b8befbc
This commit is contained in:
Matthew Flatt 2007-07-03 03:32:13 +00:00
parent d7fc3681f5
commit ca77096693
1 changed files with 151 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

193
collects/scribble/manual.ss
View File

@ -180,7 +180,7 @@
;; ---------------------------------------- ;; ----------------------------------------
(provide defproc defproc* defstruct defthing defparam (provide defproc defproc* defstruct defthing defparam defboolparam
defform defform* defform/subs defform*/subs defform/none defform defform* defform/subs defform*/subs defform/none
specform specform/subs specform specform/subs
specsubform specsubform/subs specspecsubform specspecsubform/subs specsubform/inline specsubform specsubform/subs specspecsubform specspecsubform/subs specsubform/inline
@ -242,11 +242,19 @@
(define-syntax defstruct (define-syntax defstruct
(syntax-rules () (syntax-rules ()
[(_ name fields #:immutable #:inspector #f desc ...) [(_ name fields #:immutable #:inspector #f desc ...)
(*defstruct (quote-syntax name) 'name 'fields #t #t (lambda () (list desc ...)))] (**defstruct name fields #t #t desc ...)]
[(_ name fields #:immutable desc ...) [(_ name fields #:immutable desc ...)
(*defstruct (quote-syntax name) 'name 'fields #t #f (lambda () (list desc ...)))] (**defstruct name fields #t #f desc ...)]
[(_ name fields #:inspector #f desc ...)
(**defstruct name fields #f #t desc ...)]
[(_ name fields desc ...) [(_ name fields desc ...)
(*defstruct (quote-syntax name) 'name 'fields #f #f (lambda () (list desc ...)))])) (**defstruct name fields #f #f desc ...)]))
(define-syntax **defstruct
(syntax-rules ()
[(_ name ([field field-contract] ...) immutable? transparent? desc ...)
(*defstruct (quote-syntax name) 'name
'([field field-contract] ...) (list (lambda () (schemeblock0 field-contract)) ...)
#t #t (lambda () (list desc ...)))]))
(define-syntax (defform*/subs stx) (define-syntax (defform*/subs stx)
(syntax-case stx () (syntax-case stx ()
[(_ #:literals (lit ...) [spec spec1 ...] ([non-term-id non-term-form ...] ...) desc ...) [(_ #:literals (lit ...) [spec spec1 ...] ([non-term-id non-term-form ...] ...) desc ...)
@ -351,6 +359,10 @@
(syntax-rules () (syntax-rules ()
[(_ id arg contract desc ...) [(_ id arg contract desc ...)
(defproc* ([(id) contract] [(id [arg contract]) void?]) desc ...)])) (defproc* ([(id) contract] [(id [arg contract]) void?]) desc ...)]))
(define-syntax defboolparam
(syntax-rules ()
[(_ id arg desc ...)
(defproc* ([(id) boolean?] [(id [arg any/c]) void?]) desc ...)]))
(define-syntax schemegrammar (define-syntax schemegrammar
(syntax-rules () (syntax-rules ()
[(_ #:literals (lit ...) id clause ...) (*schemegrammar '(lit ...) [(_ #:literals (lit ...) id clause ...) (*schemegrammar '(lit ...)
@ -640,8 +652,9 @@
(map symbol->string (car wrappers))))))) (map symbol->string (car wrappers)))))))
(cdr wrappers)))) (cdr wrappers))))
(define (*defstruct stx-id name fields immutable? transparent? content-thunk) (define (*defstruct stx-id name fields field-contracts immutable? transparent? content-thunk)
(define spacer (hspace 1)) (define spacer (hspace 1))
(define to-flow (lambda (e) (make-flow (list (make-paragraph (list e))))))
(make-splice (make-splice
(cons (cons
(make-table (make-table
@ -649,48 +662,144 @@
(cons (cons
(list (make-flow (list (make-flow
(list (list
(make-paragraph (let* ([the-name
(list (make-target-element*
(to-element stx-id
`(,(schemeparenfont "struct") (to-element (if (pair? name)
,(make-target-element* (map (lambda (x)
stx-id (make-just-context x stx-id))
(to-element name) name)
(let ([name (if (pair? name) stx-id))
(car name) (let ([name (if (pair? name)
name)]) (car name)
(list* (list name) name)])
(list name '?) (list* (list name)
(list 'make- name) (list name '?)
(append (list 'make- name)
(map (lambda (f) (append
(list name '- (car f))) (map (lambda (f)
fields) (list name '- (car f)))
(if immutable? fields)
null (if immutable?
(map (lambda (f) null
(list 'set- name '- (car f) '!)) (map (lambda (f)
fields)))))) (list 'set- name '- (car f) '!))
,(map car fields) fields))))))]
,@(if immutable? '(#:immutable) null) [short-width (apply +
,@(if transparent? '(#:inspector #f) null)))))))) (length fields)
(map (lambda (v) 8
(map (lambda (s)
(string-length (symbol->string s)))
(append (if (pair? name)
name
(list name))
(map car fields))))])
(if (and (short-width . < . max-proto-width)
(not immutable?)
(not transparent?))
(make-paragraph
(list
(to-element
`(,(schemeparenfont "struct")
,the-name
,(map car fields)))))
(make-table
#f
(append
(list
(list (to-flow (schemeparenfont "(struct"))
(to-flow spacer)
(to-flow the-name)
(if (or (null? fields)
(short-width . < . max-proto-width))
(to-flow spacer)
(to-flow (make-element #f
(list spacer
(schemeparenfont "(")))))
(to-flow (if (or (null? fields)
(short-width . < . max-proto-width))
(to-element (map car fields))
(to-element (caar fields))))))
(if (short-width . < . max-proto-width)
null
(let loop ([fields fields])
(if (null? fields)
null
(cons (let ([fld (car fields)])
(list (to-flow spacer)
(to-flow spacer)
(to-flow spacer)
(to-flow spacer)
(to-flow
(let ([e (to-element (car fld))])
(if (null? (cdr fields))
(make-element
#f
(list e
(schemeparenfont
(if (and (not immutable?)
(not transparent?))
"))"
")"))))
e)))))
(loop (cdr fields))))))
(cond
[(and immutable? transparent?)
(list
(list (to-flow spacer)
(to-flow spacer)
(to-flow (to-element '#:immutable))
'cont
'cont)
(list (to-flow spacer)
(to-flow spacer)
(to-flow (make-element
#f
(list (to-element '#:inspector)
spacer
(to-element #f)
(schemeparenfont ")"))))
'cont
'cont))]
[immutable?
(list
(list (to-flow spacer)
(to-flow spacer)
(to-flow (make-element
#f
(list (to-element '#:immutable)
(schemeparenfont ")"))))
'cont
'cont))]
[transparent?
(list
(list (to-flow spacer)
(to-flow spacer)
(to-flow (make-element
#f
(list (to-element '#:inspector)
spacer
(to-element #f)
(schemeparenfont ")"))))
'cont
'cont))]
[else null]))))))))
(map (lambda (v field-contract)
(cond (cond
[(pair? v) [(pair? v)
(list (list
(make-flow (make-flow
(list (make-table-if-necessary
(make-paragraph (append #f
(list (list
(hspace 2) (list (to-flow (hspace 2))
(to-element (car v))) (to-flow (to-element (car v)))
(list (to-flow spacer)
spacer (to-flow ":")
":" (to-flow spacer)
spacer (make-flow (list (field-contract))))))))]
(to-element (cadr v))))))))]
[else null])) [else null]))
fields))) fields field-contracts)))
(content-thunk)))) (content-thunk))))
(define (*defthing stx-id name result-contract content-thunk) (define (*defthing stx-id name result-contract content-thunk)