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

Minor cleanup in subtype.rkt

Browse Source 
(cherry picked from commit b9c4582746)
This commit is contained in:
Eric Dobson 2013-02-05 09:13:03 -08:00 committed by Ryan Culpepper
parent bc34a73cd6
commit 8483d0cd6f
1 changed files with 12 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
collects/typed-racket/types/subtype.rkt
View File

@ -53,7 +53,7 @@
;; are all the s's subtypes of all the t's? ;; are all the s's subtypes of all the t's?
;; [type] [type] -> boolean ;; [type] [type] -> boolean
(define (subtypes s t) (handle-failure (subtypes* (current-seen) s t))) (define (subtypes s t) (handle-failure (and (subtypes* (current-seen) s t) #t)))
;; subtyping under constraint set, but produces boolean result instead of raising exn ;; subtyping under constraint set, but produces boolean result instead of raising exn
;; List[(cons Number Number)] type type -> maybe[List[(cons Number Number)]] ;; List[(cons Number Number)] type type -> maybe[List[(cons Number Number)]]
@ -77,11 +77,11 @@
(define-syntax-class sub* (define-syntax-class sub*
(pattern e:expr)) (pattern e:expr))
(syntax-parse stx (syntax-parse stx
[(_ init (s1:sub* . args1) (s:sub* . args) ...) [(_ init (s:sub* . args) ...+)
(with-syntax ([(A* ... A-last) (generate-temporaries #'(s1 s ...))]) (with-syntax ([(A* ... A-last) (generate-temporaries #'(s ...))])
(with-syntax ([(clauses ...) (with-syntax ([(clauses ...)
(for/list ([s (syntax->list #'(s1 s ...))] (for/list ([s (syntax->list #'(s ...))]
[args (syntax->list #'(args1 args ...))] [args (syntax->list #'(args ...))]
[A (syntax->list #'(init A* ...))] [A (syntax->list #'(init A* ...))]
[A-next (syntax->list #'(A* ... A-last))]) [A-next (syntax->list #'(A* ... A-last))])
#`[#,A-next (#,s #,A . #,args)])]) #`[#,A-next (#,s #,A . #,args)])])
@ -163,9 +163,7 @@
[(_ _) (fail! s t)])) [(_ _) (fail! s t)]))
(define (subtypes/varargs args dom rst) (define (subtypes/varargs args dom rst)
(with-handlers (handle-failure (and (subtypes*/varargs null args dom rst) #t)))
([exn:subtype? (lambda _ #f)])
(subtypes*/varargs null args dom rst)))
(define (subtypes*/varargs A0 argtys dom rst) (define (subtypes*/varargs A0 argtys dom rst)
(let loop-varargs ([dom dom] [argtys argtys] [A A0]) (let loop-varargs ([dom dom] [argtys argtys] [A A0])
@ -560,9 +558,12 @@
(provide/cond-contract (provide/cond-contract
[subtype (c:-> (c:or/c Type/c SomeValues/c) (c:or/c Type/c SomeValues/c) boolean?)]) [subtype (c:-> (c:or/c Type/c SomeValues/c) (c:or/c Type/c SomeValues/c) boolean?)]
(provide [type-compare? (c:-> (c:or/c Type/c SomeValues/c) (c:or/c Type/c SomeValues/c) boolean?)]
type-compare? subtypes/varargs subtypes) [subtypes (c:-> (c:listof (c:or/c Type/c SomeValues/c))
(c:listof (c:or/c Type/c SomeValues/c))
boolean?)]
[subtypes/varargs (c:-> (c:listof Type/c) (c:listof Type/c) (c:or/c Type/c #f) boolean?)])
;(require racket/trace) ;(require racket/trace)
;(trace subtype*) ;(trace subtype*)