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

Fix prefix-of.

Browse Source 
Closes PR 13448.
This commit is contained in:
Eric Dobson 2013-04-03 23:32:45 -07:00
parent 5ec7401f1f
commit 17b9ed0a75
2 changed files with 17 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
collects/tests/typed-racket/fail/pr13448.rkt Normal file
View File

@ -0,0 +1,7 @@
#lang typed/racket
(: foo
(case->
(Number -> Number)
(Number String -> Number)
(Number String String * -> Number)))
(define (foo x (s1 "") . s) x)

13
collects/typed-racket/types/kw-types.rkt
View File

@ -56,9 +56,16 @@
(make-Function (list (make-arr* ts rng #:rest rest #:drest drest))))) (make-Function (list (make-arr* ts rng #:rest rest #:drest drest)))))
(define (prefix-of a b) (define (prefix-of a b)
(define (rest-equal? a b)
(match* (a b)
[(#f #f) #t]
[(#f _) #f]
[(_ #f) #f]
[(a b) (type-equal? a b)]))
(define (drest-equal? a b) (define (drest-equal? a b)
(match* (a b) (match* (a b)
[((list t b) (list t* b*)) (and (type-equal? t t*) (equal? b b*))] [((list t b) (list t* b*)) (and (type-equal? t t*) (equal? b b*))]
[(#f #f) #t]
[(_ _) #f])) [(_ _) #f]))
(define (kw-equal? a b) (define (kw-equal? a b)
(and (equal? (length a) (length b)) (and (equal? (length a) (length b))
@ -68,10 +75,10 @@
[((arr: args result rest drest kws) [((arr: args result rest drest kws)
(arr: args* result* rest* drest* kws*)) (arr: args* result* rest* drest* kws*))
(and (< (length args) (length args*)) (and (< (length args) (length args*))
(or (equal? rest rest*) (type-equal? rest rest*)) (rest-equal? rest rest*)
(or (equal? drest drest*) (drest-equal? drest drest*)) (drest-equal? drest drest*)
(type-equal? result result*) (type-equal? result result*)
(or (equal? kws kws*) (kw-equal? kws kws*)) (kw-equal? kws kws*)
(for/and ([p args] [p* args*]) (for/and ([p args] [p* args*])
(type-equal? p p*)))])) (type-equal? p p*)))]))