Export contract' from the DMdA languages, making
define-contract' obsolete.
svn: r15934
This commit is contained in:
parent
38d9c6d8af
commit
332fdb8602
|
@ -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)
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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")))
|
||||
|
|
|
@ -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:
|
||||
|
|
|
@ -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)]
|
||||
|
|
|
@ -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)))
|
||||
|
||||
|
|
|
@ -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")))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
|
|
Loading…
Reference in New Issue
Block a user