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

Fix class static contracts and add tests.

Browse Source 
original commit: 608eb9df8fed1d0fac8dd528051d5308526efa2c
This commit is contained in:
Eric Dobson 2014-01-11 12:01:20 -08:00
parent 3439faef99
commit e2d6458f3e
2 changed files with 17 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/combinators/object.rkt
View File

@ -45,6 +45,11 @@
(match v
[(class-combinator args opaque absent-fields absent-methods)
(class-combinator (member-seq-sc-map f args) opaque absent-fields absent-methods)]))
(define (sc-traverse v f)
(match v
[(class-combinator args opaque absent-fields absent-methods)
(member-seq-sc-map f args)
(void)]))
(define (sc->contract v f)
(class/sc->contract v f))
(define (sc->constraints v f)
@ -57,6 +62,7 @@
(filter-map member-spec-sc vals)]))
(struct member-seq (vals)
#:transparent
#:property prop:sequence member-seq->list)
(define (member-seq-sc-map f seq)

11
pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/static-contract-optimizer-tests.rkt
View File

@ -237,4 +237,15 @@
#:pos (case->/sc (list (arr/sc (list list?/sc) (listof/sc set?/sc) #f)))
#:neg (case->/sc (list (arr/sc (list any/sc) any/sc (list list?/sc)))))
(check-optimize
(object/sc (list (member-spec 'field 'x (listof/sc any/sc))))
#:pos (object/sc (list (member-spec 'field 'x list?/sc)))
#:neg (object/sc (list (member-spec 'field 'x list?/sc))))
(check-optimize
(class/sc (list (member-spec 'field 'x (listof/sc any/sc))) #f empty empty)
#:pos (class/sc (list (member-spec 'field 'x list?/sc)) #f empty empty)
#:neg (class/sc (list (member-spec 'field 'x list?/sc)) #f empty empty))
))