Add `contract' contract to DeinProgramm / DMdA languages.

While we're at it, improve source-location reporting for application
contracts.

svn: r16769
This commit is contained in:
Mike Sperber 2009-11-14 14:17:06 +00:00
parent cef2d065df
commit 3c68ac4a0c
3 changed files with 20 additions and 3 deletions

View File

@ -19,7 +19,9 @@
#'?stx1)))
(define-for-syntax (parse-contract name stx)
(syntax-case* stx (mixed one-of predicate list -> combined property reference at) module-or-top-identifier=?
(syntax-case* stx
(mixed one-of predicate list -> combined property reference at contract)
module-or-top-identifier=?
((mixed ?contract ...)
(with-syntax ((?stx (phase-lift stx))
(?name name)
@ -76,6 +78,9 @@
((at ?loc ?ctr)
(with-syntax ((?ctr-expr (parse-contract #f #'?ctr)))
#'(contract-update-syntax ?ctr-expr #'?loc)))
(contract
(with-syntax ((?stx (phase-lift stx)))
#'(contract-update-syntax contract/contract #'?loc)))
(?id
(identifier? #'?id)
(with-syntax ((?stx (phase-lift stx)))
@ -112,18 +117,26 @@
?stx)))
((?contract-abstr ?contract ...)
(identifier? #'?contract-abstr)
(with-syntax (((?contract-expr ...) (map (lambda (ctr)
(with-syntax ((?stx (phase-lift stx))
((?contract-expr ...) (map (lambda (ctr)
(parse-contract #f ctr))
(syntax->list #'(?contract ...)))))
(with-syntax
((?call (syntax/loc stx (?contract-abstr ?contract-expr ...))))
#'(make-delayed-contract '?name
(delay ?call)
#'?stx))))
?stx))))
(else
(raise-syntax-error 'contract
"ungültiger Vertrag" stx))))
; regrettable
(define contract/contract
(make-predicate-contract 'contract
(delay contract?)
#f))
(define-syntax contract
(lambda (stx)
(syntax-case stx ()

View File

@ -242,6 +242,9 @@ Vertrag für Zeichenketten.
Vertrag für die leere Liste.
}
@defform/none[contract]{
Vertrag Verträge.}
@subsection{@scheme[predicate]}
@defform[(predicate expr)]{
Bei diesem Vertrag muß @scheme[expr] als Wert ein Prädikat haben, also

View File

@ -61,6 +61,7 @@
@#,scheme[(code:line %a %b %c (code:comment @#,seclink["contract-variable"]{Vertrags-Variable}))]
@#,scheme[(combined contr (... ...))]
@#,scheme[(property expr contr)]
@#,scheme[contract]
]
[test-case @#,scheme[(check-expect expr expr)]
@#,scheme[(check-within expr expr expr)]