Export contract' from the DMdA languages, making define-contract' obsolete.

svn: r15934
This commit is contained in:
Mike Sperber 2009-09-09 15:00:54 +00:00
parent 38d9c6d8af
commit 332fdb8602
11 changed files with 63 additions and 66 deletions

View File

@ -11,7 +11,7 @@
.. ... .... ..... ......
check-expect check-within check-error
check-property for-all ==> expect expect-within
: define-contract -> mixed one-of predicate combined property
contract : define-contract -> mixed one-of predicate combined property
number real rational integer natural boolean true false string symbol empty-list unspecific
chocolate-cookie)
(provide cons)

View File

@ -11,7 +11,7 @@
.. ... .... ..... ......
check-expect check-within check-error
check-property for-all ==> expect expect-within
: define-contract -> mixed one-of predicate combined property
contract : define-contract -> mixed one-of predicate combined property
number real rational integer natural boolean true false string empty-list unspecific
chocolate-cookie)
(provide cons)

View File

@ -7,7 +7,7 @@
.. ... .... ..... ......
check-expect check-within check-error
check-property for-all ==> expect expect-within
: define-contract -> mixed one-of predicate combined property
contract : define-contract -> mixed one-of predicate combined property
number real rational integer natural boolean true false string empty-list
chocolate-cookie)
(provide cons list)

View File

@ -7,7 +7,7 @@
.. ... .... ..... ......
check-expect check-within check-error
check-property for-all ==> expect expect-within
: define-contract -> mixed one-of predicate combined property
contract : define-contract -> mixed one-of predicate combined property
number real rational integer natural boolean true false string empty-list
chocolate-cookie)
(provide cons)

View File

@ -29,7 +29,7 @@
(provide (all-from-out deinprogramm/define-record-procedures))
(provide (all-from-out test-engine/scheme-tests))
(provide define-contract :
(provide contract define-contract :
-> mixed one-of predicate combined property)
(provide number real rational integer natural
@ -877,14 +877,14 @@
(define (false? x)
(eq? x #f))
(define-contract true (one-of #f))
(define-contract false (one-of #f))
(define true (contract (one-of #f)))
(define false (contract (one-of #f)))
(define string (contract/arbitrary arbitrary-string (predicate string?)))
(define symbol (contract/arbitrary arbitrary-symbol (predicate symbol?)))
(define-contract empty-list (one-of empty))
(define empty-list (contract (one-of empty)))
(define-contract unspecific (predicate (lambda (_) #t)))
(define unspecific (contract (predicate (lambda (_) #t))))
;; aus collects/lang/private/teach.ss

View File

@ -114,7 +114,9 @@
((_ ?contr)
#'(contract #f ?contr))
((_ ?name ?contr)
(parse-contract (syntax->datum #'?name) #'?contr)))))
(stepper-syntax-property
(parse-contract (syntax->datum #'?name) #'?contr)
'stepper-skip-completely #t)))))
(define-syntax contract/arbitrary
(lambda (stx)

View File

@ -857,12 +857,12 @@ converting from the computer's coordinates, we get:
(define empty-image
(make-simple-cache-image-snip 0 0 void void))
(define-contract octet (combined natural (predicate (lambda (n) (<= n 255)))))
(define-contract rgb-color (predicate color?))
(define-contract mode (one-of "solid" "outline"))
(define-contract image (predicate image?))
(define-contract image-color (predicate image-color?))
(define-contract h-place (mixed integer (one-of "left" "right" "center")))
(define-contract v-place (mixed integer (one-of "top" "bottom" "center")))
(define-contract h-mode (one-of "left" "right" "center"))
(define-contract v-mode (one-of "top" "bottom" "center"))
(define octet (contract (combined natural (predicate (lambda (n) (<= n 255))))))
(define rgb-color (contract (predicate color?)))
(define mode (contract (one-of "solid" "outline")))
(define image (contract (predicate image?)))
(define image-color (contract (predicate image-color?)))
(define h-place (contract (mixed integer (one-of "left" "right" "center"))))
(define v-place (contract (mixed integer (one-of "top" "bottom" "center"))))
(define h-mode (contract (one-of "left" "right" "center")))
(define v-mode (contract (one-of "top" "bottom" "center")))

View File

@ -192,22 +192,14 @@ Wert des @scheme[begin]-Ausdrucks.
@section{Verträge}
@subsection{@scheme[define-contract]}
@defform[(define-contract id contract)]
@defform/none[(define-contract (id p1 ...) contract)]{
Die erste Form führt einen neuen Vertrag ein:
sie bindet den Namen @scheme[id] an den Vertrag @scheme[contract].
Die zweite Form führt einen @deftech{parametrischen Vertrag} (wie
@scheme[list]) ein, der über die Parameter @scheme[p1]
... abstrahiert. Der parametrische Vertrag kann dann als @scheme['(id
a1 ...)] verwendet werden, wobei in @scheme[contract] für die
Parameter @scheme[p1] ... die @scheme[a1] ... eingesetzt werden.
@subsection{@scheme[contract]}
@defform[(contract contr)]{
Diese Form liefert den Vertrag mit der Notation @scheme[contr].
}
@subsection{Vertragserklärung}
@defform[(: id contract)]{
Diese Form erklärt @scheme[contract] zum gültigen Vertrag für @scheme[id].
@defform[(: id contr)]{
Diese Form erklärt @scheme[contr] zum gültigen Vertrag für @scheme[id].
}
@defidform[number]{
@ -266,14 +258,14 @@ der @scheme[expr] ist.
}
@subsection{@scheme[mixed]}
@defform[(mixed contract ...)]{
@defform[(mixed contr ...)]{
Dieser Vertrag ist für einen Wert gültig, wenn er für einen der Verträge
@scheme[contract] gültig ist.
@scheme[contr] gültig ist.
}
@subsection[#:tag "proc-contract"]{Prozedur-Vertrag}
@defidform[->]{
@defform/none[(contract ... -> contract)]{
@defform/none[(contr ... -> contr)]{
Dieser Vertrag ist dann für einen Wert gültig, wenn dieser eine
Prozedur ist. Er erklärt außerdem, daß die Verträge vor dem @scheme[->]
für die Argumente der Prozedur gelten und der Vertrag nach dem @scheme[->]
@ -282,9 +274,9 @@ für den Rückgabewert.
}
@subsection{@scheme[property]}
@defform[(property expr contract)]{
@defform[(property expr contr)]{
Dieser Vertrag ist für ein Objekt @scheme[obj] gültig, wenn der
Vertrag @scheme[contract] für @scheme[(expr obj)] gültig ist.
Vertrag @scheme[contr] für @scheme[(expr obj)] gültig ist.
(In der Regel ist @scheme[expr] ein Record-Selektor @scheme[s]. In
dem Fall ist der Vertrag @scheme[(property s c)] für alle Records
@ -293,9 +285,9 @@ Vertrag @scheme[c] erfüllt.)
}
@subsection{@scheme[list]}
@defform[(list contract)]{
@defform[(list contr)]{
Dieser Vertrag ist dann für einen Wert gültig, wenn dieser eine Liste ist,
für dessen Elemente @scheme[contract] gültig ist.
für dessen Elemente @scheme[contr] gültig ist.
}
@subsection[#:tag "contract-variable"]{Vertrags-Variablen}
@ -307,9 +299,9 @@ Dies ist eine Vertragsvariable: sie steht für einen Vertrag, der für jeden Wer
}
@subsection{@scheme[combined]}
@defform[(combined contract ...)]{
@defform[(combined contr ...)]{
Dieser Vertrag ist für einen Wert gültig, wenn er für alle der Verträge
@scheme[contract] gültig ist.
@scheme[contr] gültig ist.
}
@section{Testfälle}
@ -354,7 +346,7 @@ wurden. In diesen Fällen erzeugt @scheme[check-property] eine Fehlermeldung.
Die @scheme[define-record-procedures-parametric] ist wie
@scheme[define-record-procedures] mit dem Unterschied, daß @scheme[t]
an einen @tech{parametrischen Vertrag} gebunden wird: Es muß genauso viele
an einen parametrischen Vertrag gebunden wird: Es muß genauso viele
Parameter @scheme[p1] geben wie Selektoren @scheme[s1]; für diese
Parameter werden die Verträge für die Felder substituiert.
@ -427,10 +419,10 @@ gebunden und @deftech{quantifiziert} werden, d.h. es muß festgelegt
werden, welchen Vertrag die Werte der Variable erfüllen sollen.
Eigenschaften mit Variablen werden mit der @scheme[for-all]-Form erzeugt:
@defform[(for-all ((id contract) ...) expr)]{
@defform[(for-all ((id contr) ...) expr)]{
Dies bindet die Variablen @scheme[id] in der Eigenschaft
@scheme[expr]. Zu jeder Variable gehört ein Vertrag
@scheme[contract], der von den Werten der Variable erfüllt werden
@scheme[contr], der von den Werten der Variable erfüllt werden
muß.
Beispiel:

View File

@ -18,7 +18,7 @@
#:literals (define define-record-procedures lambda cond if and or let letrec let* begin
#;require lib planet
check-expect check-within check-error
define-contract :
contract :
predicate one-of mixed list %a %b %c
lit ...)
(... [program (code:line def-or-expr ...)])
@ -29,8 +29,8 @@
[definition @#,scheme[(define id expr)]
@#,scheme[(define-record-procedures id id id (id (... ...)))]
@#,scheme[(define-record-procedures-parametric (id id (... ...)) id id (id (... ...)))]
@#,scheme[(define-contract id contract)]
@#,scheme[(: id contract)]
@#,scheme[(contract id contr)]
@#,scheme[(: id contr)]
def-rule ...]
prod ...
[expr @#,scheme[(code:line (expr expr (... ...)) (code:comment @#,seclink["application"]{Prozedurapplikation}))]
@ -49,18 +49,18 @@
@#,scheme[(letrec ((id expr) (... ...)) expr)]
@#,scheme[(let* ((id expr) (... ...)) expr) ]
@#,scheme[(begin expr expr (... ...))]
@#,scheme[(for-all ((id contract) (... ...)) expr)]
@#,scheme[(for-all ((id contr) (... ...)) expr)]
@#,scheme[(==> expr expr)]
expr-rule ...]
[contract id
[contr id
@#,scheme[(predicate expr)]
@#,scheme[(one-of expr (... ...))]
@#,scheme[(mixed contract (... ...))]
@#,scheme[(code:line (contract (... ...) -> contract) (code:comment @#,seclink["proc-contract"]{Prozedur-Vertrag}))]
@#,scheme[(list contract)]
@#,scheme[(mixed contr (... ...))]
@#,scheme[(code:line (contr (... ...) -> contr) (code:comment @#,seclink["proc-contract"]{Prozedur-Vertrag}))]
@#,scheme[(list contr)]
@#,scheme[(code:line %a %b %c (code:comment @#,seclink["contract-variable"]{Vertrags-Variable}))]
@#,scheme[(combined contract (... ...))]
@#,scheme[(property expr contract)]
@#,scheme[(combined contr (... ...))]
@#,scheme[(property expr contr)]
]
[test-case @#,scheme[(check-expect expr expr)]
@#,scheme[(check-within expr expr expr)]

View File

@ -24,16 +24,17 @@
(lambda (grad)
(* pi/180 grad)))
(define-contract turtle (predicate (lambda (x)
(and (vector? x)
(= (vector-length x) 8)
(number? (vector-ref x 0))
(number? (vector-ref x 1))
(number? (vector-ref x 2))
(number? (vector-ref x 3))
(number? (vector-ref x 4))
(image? (vector-ref x 5))
(image-color? (vector-ref x 6))))))
(define turtle (contract
(predicate (lambda (x)
(and (vector? x)
(= (vector-length x) 8)
(number? (vector-ref x 0))
(number? (vector-ref x 1))
(number? (vector-ref x 2))
(number? (vector-ref x 3))
(number? (vector-ref x 4))
(image? (vector-ref x 5))
(image-color? (vector-ref x 6)))))))
; This function is only for internal use.
; (new-turtle-priv h w x y angle img color state)
@ -211,7 +212,7 @@
; functions into one new function, that do
; one action of the turtle, then later the rest.
; Define the type alias tip = turtle -> turtle.
(define-contract tip (turtle -> turtle))
(define tip (contract (turtle -> turtle)))
(: do (tip ... -> tip))
(define sequence (lambda l (comp_priv l)))

View File

@ -60,7 +60,9 @@
(provide mouse-event-kind)
(define-contract mouse-event-kind (one-of "enter" "leave" "motion" "left-down" "left-up" "middle-down" "middle-up" "right-down" "right-up"))
(define mouse-event-kind
(contract
(one-of "enter" "leave" "motion" "left-down" "left-up" "middle-down" "middle-up" "right-down" "right-up")))
;; ---------------------------------------------------------------------------