From 615c94f72f70ac4346f3f1cb5f67089943fb0b48 Mon Sep 17 00:00:00 2001 From: Stevie Strickland Date: Tue, 16 Nov 2010 19:12:22 -0500 Subject: [PATCH] Clean up first-order checking in object/c and object-contract. Use let/ec only when needed (i.e. when raise-blame-error is not used). Also remove some of the old checking functions from mzlib's object-contract code that are no longer needed now that we have unified the first-order checking. original commit: 96db670d8c5453173b9bf92375512fc57cafbfcd --- collects/mzlib/private/contract-object.rkt | 17 ++++------------- 1 file changed, 4 insertions(+), 13 deletions(-) diff --git a/collects/mzlib/private/contract-object.rkt b/collects/mzlib/private/contract-object.rkt index 8daded9..0188cb4 100644 --- a/collects/mzlib/private/contract-object.rkt +++ b/collects/mzlib/private/contract-object.rkt @@ -295,21 +295,12 @@ (list 'field-name ...) (list field-ctc-var ...)))) #:first-order (lambda (val) - (check-object-contract val #f (list 'method-name ...) (list 'field-name ...)))) - ctc)))))])))) + (let/ec ret + (check-object-contract val (list 'method-name ...) (list 'field-name ...) + (λ args (ret #f))))))) + ctc))))])))) -(define (check-object val blame) - (unless (object? val) - (raise-blame-error blame val "expected an object, got ~e" val))) - -(define (check-method val method-name val-mtd-names blame) - (unless (memq method-name val-mtd-names) - (raise-blame-error blame val "expected an object with method ~s" method-name))) - -(define (field-error val field-name blame) - (raise-blame-error blame val "expected an object with field ~s" field-name)) - (define (make-mixin-contract . %/<%>s) ((and/c (flat-contract class?) (apply and/c (map sub/impl?/c %/<%>s)))