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

Add `contract' contract to DeinProgramm / DMdA languages.

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

19
collects/deinprogramm/contract/contract-syntax.ss
View File

@ -19,7 +19,9 @@
#'?stx1))) #'?stx1)))
(define-for-syntax (parse-contract name stx) (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 ...) ((mixed ?contract ...)
(with-syntax ((?stx (phase-lift stx)) (with-syntax ((?stx (phase-lift stx))
(?name name) (?name name)
@ -76,6 +78,9 @@
((at ?loc ?ctr) ((at ?loc ?ctr)
(with-syntax ((?ctr-expr (parse-contract #f #'?ctr))) (with-syntax ((?ctr-expr (parse-contract #f #'?ctr)))
#'(contract-update-syntax ?ctr-expr #'?loc))) #'(contract-update-syntax ?ctr-expr #'?loc)))
(contract
(with-syntax ((?stx (phase-lift stx)))
#'(contract-update-syntax contract/contract #'?loc)))
(?id (?id
(identifier? #'?id) (identifier? #'?id)
(with-syntax ((?stx (phase-lift stx))) (with-syntax ((?stx (phase-lift stx)))
@ -112,18 +117,26 @@
?stx))) ?stx)))
((?contract-abstr ?contract ...) ((?contract-abstr ?contract ...)
(identifier? #'?contract-abstr) (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)) (parse-contract #f ctr))
(syntax->list #'(?contract ...))))) (syntax->list #'(?contract ...)))))
(with-syntax (with-syntax
((?call (syntax/loc stx (?contract-abstr ?contract-expr ...)))) ((?call (syntax/loc stx (?contract-abstr ?contract-expr ...))))
#'(make-delayed-contract '?name #'(make-delayed-contract '?name
(delay ?call) (delay ?call)
#'?stx)))) ?stx))))
(else (else
(raise-syntax-error 'contract (raise-syntax-error 'contract
"ungültiger Vertrag" stx)))) "ungültiger Vertrag" stx))))
; regrettable
(define contract/contract
(make-predicate-contract 'contract
(delay contract?)
#f))
(define-syntax contract (define-syntax contract
(lambda (stx) (lambda (stx)
(syntax-case stx () (syntax-case stx ()

3
collects/deinprogramm/scribblings/DMdA-beginner.scrbl
View File

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

1
collects/deinprogramm/scribblings/std-grammar.ss
View File

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