suzanne.soy/compatibility
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Clean up first-order checking in object/c and object-contract.

Browse Source 
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
This commit is contained in:
Stevie Strickland 2010-11-16 19:12:22 -05:00
parent d0a35ce51a
commit 615c94f72f
1 changed files with 4 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
collects/mzlib/private/contract-object.rkt
View File

@ -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)))