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

This commit is contained in:
Jay McCarthy 2010-07-15 09:52:30 -06:00
parent d9e6eb1d8b
commit 334978a8e4

View File

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