Fixed evaluation order.

svn: r17685
This commit is contained in:
Carl Eastlund 2010-01-17 03:36:17 +00:00
parent ff00fefb2d
commit 05c4296eca

View File

@ -30,9 +30,6 @@
(define-struct contract-property [ name first-order projection stronger ]
#:omit-define-syntaxes)
(define build-contract-property
(build-property make-contract-property 'anonymous-contract))
(define (contract-property-guard prop info)
(unless (contract-property? prop)
(raise
@ -78,10 +75,6 @@
(define-struct flat-contract-property [implementation]
#:omit-define-syntaxes)
(define build-flat-contract-property
(build-property (compose make-flat-contract-property make-contract-property)
'anonymous-flat-contract))
(define (flat-contract-property-guard prop info)
(unless (flat-contract-property? prop)
(raise
@ -130,6 +123,13 @@
(mk get-name get-first-order get-projection stronger)))
(define build-contract-property
(build-property make-contract-property 'anonymous-contract))
(define build-flat-contract-property
(build-property (compose make-flat-contract-property make-contract-property)
'anonymous-flat-contract))
(define (get-any? c) any?)
(define (any? x) #t)
@ -158,9 +158,6 @@
(lambda (c) (simple-contract-projection c))
(lambda (a b) ((simple-contract-stronger a) a b))))
(define simple-contract
(build-contract make-simple-contract 'simple-contract))
(define-struct simple-flat-contract [ name first-order projection stronger ]
#:omit-define-syntaxes
#:property prop:flat-contract
@ -171,9 +168,6 @@
(lambda (c) (simple-flat-contract-projection c))
(lambda (a b) ((simple-flat-contract-stronger a) a b)))))
(define simple-flat-contract
(build-contract make-simple-flat-contract 'simple-flat-contract))
(define ((build-contract mk default-name)
#:name [name #f]
#:first-order [first-order #f]
@ -186,3 +180,9 @@
[stronger (or stronger weakest)])
(mk name first-order projection stronger)))
(define simple-contract
(build-contract make-simple-contract 'simple-contract))
(define simple-flat-contract
(build-contract make-simple-flat-contract 'simple-flat-contract))