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

Revert "Do not actually use dependent contracts in provide/doc if there is no dependency"

Browse Source 
This reverts commit 334978a8e4.
This commit is contained in:
Jay McCarthy 2010-07-15 10:23:06 -06:00
parent 80b6ceeff1
commit 1dfb50460a
1 changed files with 11 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
collects/scribble/srcdoc.rkt
View File

@ -57,33 +57,18 @@
(lambda (stx) (lambda (stx)
(syntax-case stx () (syntax-case stx ()
[(_ id contract desc) [(_ id contract desc)
(with-syntax ([(header result (body-stuff ...) better-contract) (with-syntax ([(header result (body-stuff ...))
(syntax-case #'contract (->d -> values) (syntax-case #'contract (->d -> values)
[(->d ([arg-id arg/c] ...) () (values [name res] ...)) [(->d (req ...) () (values [name res] ...))
#'((id [arg-id arg/c] ...) #'((id req ...) (values res ...) ())]
(values res ...)
()
(-> arg/c ... (values res ...)))]
[(->d (req ...) () #:pre-cond condition (values [name res] ...)) [(->d (req ...) () #:pre-cond condition (values [name res] ...))
#'((id req ...) #'((id req ...) (values res ...) ((bold "Pre-condition: ") (scheme condition) "\n" "\n"))]
(values res ...) [(->d (req ...) () [name res])
((bold "Pre-condition: ") (scheme condition) "\n" "\n") #'((id req ...) res ())]
contract)]
[(->d ([arg-id arg/c] ...) () [name res])
#'((id [arg-id arg/c] ...)
res
()
(-> arg/c ... res))]
[(->d (req ...) () #:pre-cond condition [name res]) [(->d (req ...) () #:pre-cond condition [name res])
#'((id req ...) #'((id req ...) res ((bold "Pre-condition: ") (scheme condition) "\n" "\n" ))]
res [(->d (req ...) () #:rest rest rest-ctc [name res])
((bold "Pre-condition: ") (scheme condition) "\n" "\n" ) #'((id req ... [rest rest-ctc] (... ...)) res ())]
contract)]
[(->d ([arg-id arg/c] ...) () #:rest rest rest-ctc [name res])
#'((id [arg-id arg/c] ... [rest rest-ctc] (... ...))
res
()
(->* (arg/c ...) () #:rest rest-ctc res))]
[(->d (req ...) (one more ...) whatever) [(->d (req ...) (one more ...) whatever)
(raise-syntax-error (raise-syntax-error
#f #f
@ -98,7 +83,7 @@
stx stx
#'contract)] #'contract)]
[(-> result) [(-> result)
#'((id) result () contract)] #'((id) result ())]
[(-> whatever ...) [(-> whatever ...)
(raise-syntax-error (raise-syntax-error
#f #f
@ -113,7 +98,7 @@
stx stx
#'contract)])]) #'contract)])])
(values (values
#'[id better-contract] #'[id contract]
#'(defproc header result body-stuff ... . desc) #'(defproc header result body-stuff ... . desc)
#'(scribble/manual) #'(scribble/manual)
#'id))]))) #'id))])))