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

Add missing %s and corresponding unit tests.

Browse Source
This commit is contained in:
Eric Dobson 2014-05-09 21:29:36 -07:00
parent 7d88b7a6cb
commit eaa41a2a8a
2 changed files with 10 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/infer/infer-unit.rkt
View File

@ -426,7 +426,7 @@
[new-tys (for/list ([var (in-list vars)]) [new-tys (for/list ([var (in-list vars)])
(-result (substitute (make-F var) dbound t-dty)))] (-result (substitute (make-F var) dbound t-dty)))]
[new-cset (cgen/list V (append vars X) Y ss (append ts new-tys))]) [new-cset (cgen/list V (append vars X) Y ss (append ts new-tys))])
(move-vars-to-dmap new-cset dbound vars))] (% move-vars-to-dmap new-cset dbound vars))]
;; identical bounds - just unify pairwise ;; identical bounds - just unify pairwise
[((ValuesDots: ss s-dty dbound) (ValuesDots: ts t-dty dbound)) [((ValuesDots: ss s-dty dbound) (ValuesDots: ts t-dty dbound))
@ -585,10 +585,10 @@
[((ListDots: s-dty (? (λ (db) (memq db Y)) s-dbound)) (ListDots: t-dty t-dbound)) [((ListDots: s-dty (? (λ (db) (memq db Y)) s-dbound)) (ListDots: t-dty t-dbound))
;; What should we do if both are in Y? ;; What should we do if both are in Y?
#:return-when (memq t-dbound Y) #f #:return-when (memq t-dbound Y) #f
(move-dotted-rest-to-dmap (cgen V (cons s-dbound X) Y s-dty t-dty) s-dbound t-dbound)] (% move-dotted-rest-to-dmap (cgen V (cons s-dbound X) Y s-dty t-dty) s-dbound t-dbound)]
[((ListDots: s-dty s-dbound) (ListDots: t-dty (? (λ (db) (memq db Y)) t-dbound))) [((ListDots: s-dty s-dbound) (ListDots: t-dty (? (λ (db) (memq db Y)) t-dbound)))
;; s-dbound can't be in Y, due to previous rule ;; s-dbound can't be in Y, due to previous rule
(move-dotted-rest-to-dmap (cgen V (cons t-dbound X) Y s-dty t-dty) t-dbound s-dbound)] (% move-dotted-rest-to-dmap (cgen V (cons t-dbound X) Y s-dty t-dty) t-dbound s-dbound)]
;; this constrains `dbound' to be |ts| - |ss| ;; this constrains `dbound' to be |ts| - |ss|
[((ListDots: s-dty dbound) (List: ts)) [((ListDots: s-dty dbound) (List: ts))
@ -612,7 +612,7 @@
[new-tys (for/list ([var (in-list vars)]) [new-tys (for/list ([var (in-list vars)])
(substitute (make-F var) dbound t-dty))] (substitute (make-F var) dbound t-dty))]
[new-cset (cgen/list V (append vars X) Y ss new-tys)]) [new-cset (cgen/list V (append vars X) Y ss new-tys)])
(move-vars-to-dmap new-cset dbound vars))] (% move-vars-to-dmap new-cset dbound vars))]
;; if we have two mu's, we rename them to have the same variable ;; if we have two mu's, we rename them to have the same variable
;; and then compare the bodies ;; and then compare the bodies

6
pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/infer-tests.rkt
View File

@ -121,6 +121,12 @@
(list (-> -Symbol -Symbol -String) (-lst* -Symbol -Symbol)) (list (-> -Symbol -Symbol -String) (-lst* -Symbol -Symbol))
#:vars '(b) #:vars '(b)
#:indices '(a)] #:indices '(a)]
[infer-t (-values (list -String)) (-values-dots (list) -Symbol 'b) #:indices '(b) #:fail]
[infer-t (make-ListDots -String 'a) (make-ListDots -Symbol 'b) #:indices '(b) #:fail]
[infer-t (make-ListDots -String 'a) (make-ListDots -Symbol 'b) #:indices '(a) #:fail]
[infer-t (-lst* -String) (make-ListDots -Symbol 'b) #:indices '(b) #:fail]
;; Currently Broken ;; Currently Broken
;(infer-t (make-ListDots (-v b) 'b) (-lst -Symbol) #:indices '(b)) ;(infer-t (make-ListDots (-v b) 'b) (-lst -Symbol) #:indices '(b))
;(infer-t (-lst -Symbol) (make-ListDots -Symbol 'b) #:indices '(b)) ;(infer-t (-lst -Symbol) (make-ListDots -Symbol 'b) #:indices '(b))