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

fix fail! to use the correct arguments

Browse Source 
original commit: 692dc025c0db0aa64ee358ae5a36cbd6165455a3
This commit is contained in:
Sam Tobin-Hochstadt 2010-06-17 15:01:09 -04:00
parent 16617152c5
commit 9f8b2e4e2b
1 changed files with 11 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
collects/typed-scheme/infer/infer-unit.rkt
View File

@ -157,16 +157,16 @@
[(and s-rest (not t-rest) (<= (length ss) (length ts)))
(cgen/list V X Y ts (extend ts ss s-rest))]
;; no rest arg on the left, or wrong number = fail
[else (fail! S T)])]
[else (fail! s-arr t-arr)])]
[ret-mapping (cg s t)])
(cset-meet* (list arg-mapping ret-mapping)))]
;; dotted on the left, nothing on the right
[((arr: ss s #f (cons dty dbound) '())
(arr: ts t #f #f '()))
(unless (memq dbound Y)
(fail! S T))
(fail! s-arr t-arr))
(unless (<= (length ss) (length ts))
(fail! S T))
(fail! ss ts))
(let* ([vars (for/list ([n (in-range (- (length ts) (length ss)))])
(gensym dbound))]
[new-tys (for/list ([var vars])
@ -178,9 +178,9 @@
[((arr: ss s #f #f '())
(arr: ts t #f (cons dty dbound) '()))
(unless (memq dbound Y)
(fail! S T))
(fail! s-arr t-arr))
(unless (<= (length ts) (length ss))
(fail! S T))
(fail! ss ts))
(let* ([vars (for/list ([n (in-range (- (length ss) (length ts)))])
(gensym dbound))]
[new-tys (for/list ([var vars])
@ -192,10 +192,10 @@
[((arr: ss s #f (cons s-dty dbound) '())
(arr: ts t #f (cons t-dty dbound) '()))
(unless (= (length ss) (length ts))
(fail! S T))
(fail! ss ts))
;; If we want to infer the dotted bound, then why is it in both types?
(when (memq dbound Y)
(fail! S T))
(fail! s-arr t-arr))
(let* ([arg-mapping (cgen/list V X Y ts ss)]
[darg-mapping (cgen V X Y t-dty s-dty)]
[ret-mapping (cg s t)])
@ -205,7 +205,7 @@
[((arr: ss s #f (cons s-dty dbound) '())
(arr: ts t #f (cons t-dty dbound*) '()))
(unless (= (length ss) (length ts))
(fail! S T))
(fail! ss ts))
(let* ([arg-mapping (cgen/list V X Y ts ss)]
;; just add dbound as something that can be constrained
[darg-mapping (cgen V (cons dbound X) Y t-dty s-dty)]
@ -216,7 +216,7 @@
[((arr: ss s s-rest #f '())
(arr: ts t #f (cons t-dty dbound) '()))
(unless (memq dbound Y)
(fail! S T))
(fail! s-arr t-arr))
(if (<= (length ss) (length ts))
;; the simple case
(let* ([arg-mapping (cgen/list V X Y ts (extend ts ss s-rest))]
@ -235,7 +235,7 @@
[((arr: ss s #f (cons s-dty dbound) '())
(arr: ts t t-rest #f '()))
(unless (memq dbound Y)
(fail! S T))
(fail! s-arr t-arr))
(cond [(< (length ss) (length ts))
;; the hard case
(let* ([vars (for/list ([n (in-range (- (length ts) (length ss)))])
@ -251,7 +251,7 @@
[darg-mapping (move-rest-to-dmap (cgen V (cons dbound X) Y t-rest s-dty) dbound #:exact #t)]
[ret-mapping (cg s t)])
(cset-meet* (list arg-mapping darg-mapping ret-mapping)))])]
[(_ _) (fail! S T)]))
[(_ _) (fail! s-arr t-arr)]))
;; V : a set of variables not to mention in the constraints
;; X : the set of type variables to be constrained