From 6e0495d778d695186d7d94035e3fe24500faf4b9 Mon Sep 17 00:00:00 2001 From: Carl Eastlund Date: Tue, 19 Jan 2010 01:01:28 +0000 Subject: [PATCH] Ported more code to use new contract bindings. svn: r17727 original commit: 2bad47fd0fff59cde30406af4db42e6e65ffa899 --- collects/mzlib/private/contract-object.ss | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/collects/mzlib/private/contract-object.ss b/collects/mzlib/private/contract-object.ss index c5018cb..76d22c7 100644 --- a/collects/mzlib/private/contract-object.ss +++ b/collects/mzlib/private/contract-object.ss @@ -340,10 +340,12 @@ (list methods ...) '(field-name ...) #t)]) - (make-proj-contract + (simple-contract + #:name `(object-contract ,(build-compound-type-name 'method-name method-ctc-var) ... ,(build-compound-type-name 'field 'field-name field-ctc-var) ...) + #:projection (lambda (blame) (let ([method/app-var (method-var blame)] ... @@ -369,8 +371,7 @@ val (method/app-var (vector-ref vtable (hash-ref method-ht 'method-name))) ... (field/app-var (get-field field-name val)) ... - )))))) - #f)))))))])))) + )))))))))))))])))) (define (check-object val blame)