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

fix bad call to raise-argument-error and use ->i instead of ->d

Browse Source 
for the mixin contracts
This commit is contained in:
Robby Findler 2013-04-06 17:40:13 -05:00
parent 4632899b81
commit a72046285d
1 changed files with 6 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
collects/racket/contract/private/object.rkt
View File

@ -1,5 +1,6 @@
#lang racket/base #lang racket/base
(require "arrow.rkt" (require "arrow.rkt"
"arr-i.rkt"
"guts.rkt" "guts.rkt"
"prop.rkt" "prop.rkt"
"misc.rkt" "misc.rkt"
@ -80,15 +81,14 @@
(define (make-mixin-contract . %/<%>s) (define (make-mixin-contract . %/<%>s)
(->d ([c% (and/c (flat-contract class?) (->i ([c% (and/c (flat-contract class?)
(apply and/c (map sub/impl?/c %/<%>s)))]) (apply and/c (map sub/impl?/c %/<%>s)))])
() [res (c%) (subclass?/c c%)]))
[res (subclass?/c c%)]))
(define (subclass?/c %) (define (subclass?/c %)
(unless (class? %) (unless (class? %)
(raise-argument-error 'subclass?/c (raise-argument-error 'subclass?/c
'class? "class?"
%)) %))
(define name (object-name %)) (define name (object-name %))
(flat-named-contract (flat-named-contract
@ -98,7 +98,7 @@
(define (implementation?/c <%>) (define (implementation?/c <%>)
(unless (interface? <%>) (unless (interface? <%>)
(raise-argument-error 'implementation?/c (raise-argument-error 'implementation?/c
'interface? "interface?"
<%>)) <%>))
(define name (object-name <%>)) (define name (object-name <%>))
(flat-named-contract (flat-named-contract
@ -131,4 +131,4 @@
[else `(is-a?/c unknown<%>)]) [else `(is-a?/c unknown<%>)])
(lambda (x) (is-a? x <%>)))) (lambda (x) (is-a? x <%>))))
(define mixin-contract (->d ([c% class?]) () [res (subclass?/c c%)])) (define mixin-contract (->i ([c% class?]) [res (c%) (subclass?/c c%)]))