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

Use abbreviations for filters.

Browse Source
This commit is contained in:
Eric Dobson 2013-05-25 12:06:20 -07:00
parent 09ff5cafd4
commit a76d57fa88
9 changed files with 42 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
collects/typed-racket/base-env/base-env-numeric.rkt
View File

@ -491,12 +491,12 @@
(-> -FlonumZero -Flonum B : (-FS (-filter -PosFlonum 1) -top))
(-> -Flonum -FlonumZero B : (-FS (-filter -NegFlonum 0) -top))
(-> -PosFlonum -Flonum B : (-FS (-filter -PosFlonum 1) -top))
(-> -Flonum -PosFlonum B : (-FS -top -top))
(-> -Flonum -PosFlonum B)
(-> -NonNegFlonum -Flonum B : (-FS (-filter -PosFlonum 1) -top))
(-> -Flonum -NonNegFlonum B : (-FS -top -top))
(-> -NegFlonum -Flonum B : (-FS -top -top))
(-> -Flonum -NonNegFlonum B)
(-> -NegFlonum -Flonum B)
(-> -Flonum -NegFlonum B : (-FS (-filter -NegFlonum 0) -top))
(-> -NonPosFlonum -Flonum B : (-FS -top -top))
(-> -NonPosFlonum -Flonum B)
(-> -Flonum -NonPosFlonum B : (-FS (-filter -NegFlonum 0) -top))
(comp -Flonum))))
(define fl>-type
@ -504,14 +504,14 @@
(from-cases
(-> -FlonumZero -Flonum B : (-FS (-filter -NegFlonum 1) -top))
(-> -Flonum -FlonumZero B : (-FS (-filter -PosFlonum 0) -top))
(-> -PosFlonum -Flonum B : (-FS -top -top))
(-> -PosFlonum -Flonum B)
(-> -Flonum -PosFlonum B : (-FS (-filter -PosFlonum 0) -top))
(-> -NonNegFlonum -Flonum B : (-FS -top -top))
(-> -NonNegFlonum -Flonum B)
(-> -Flonum -NonNegFlonum B : (-FS (-filter -PosFlonum 0) -top))
(-> -NegFlonum -Flonum B : (-FS (-filter -NegFlonum 1) -top))
(-> -Flonum -NegFlonum B : (-FS -top -top))
(-> -Flonum -NegFlonum B)
(-> -NonPosFlonum -Flonum B : (-FS (-filter -NegFlonum 1) -top))
(-> -Flonum -NonPosFlonum B : (-FS -top -top))
(-> -Flonum -NonPosFlonum B)
(comp -Flonum))))
(define fl<=-type
(lambda ()
@ -519,12 +519,12 @@
(-> -FlonumZero -Flonum B : (-FS (-filter -NonNegFlonum 1) -top))
(-> -Flonum -FlonumZero B : (-FS (-filter -NonPosFlonum 0) -top))
(-> -PosFlonum -Flonum B : (-FS (-filter -PosFlonum 1) -top))
(-> -Flonum -PosFlonum B : (-FS -top -top))
(-> -Flonum -PosFlonum B)
(-> -NonNegFlonum -Flonum B : (-FS (-filter -NonNegFlonum 1) -top))
(-> -Flonum -NonNegFlonum B : (-FS -top -top))
(-> -NegFlonum -Flonum B : (-FS -top -top))
(-> -Flonum -NonNegFlonum B)
(-> -NegFlonum -Flonum B)
(-> -Flonum -NegFlonum B : (-FS (-filter -NegFlonum 0) -top))
(-> -NonPosFlonum -Flonum B : (-FS -top -top))
(-> -NonPosFlonum -Flonum B)
(-> -Flonum -NonPosFlonum B : (-FS (-filter -NonPosFlonum 0) -top))
(comp -Flonum))))
(define fl>=-type
@ -532,13 +532,13 @@
(from-cases
(-> -FlonumZero -Flonum B : (-FS (-filter -NonPosFlonum 1) -top))
(-> -Flonum -FlonumZero B : (-FS (-filter -NonNegFlonum 0) -top))
(-> -PosFlonum -Flonum B : (-FS -top -top))
(-> -PosFlonum -Flonum B)
(-> -Flonum -PosFlonum B : (-FS (-filter -PosFlonum 0) -top))
(-> -NonNegFlonum -Flonum B : (-FS -top -top))
(-> -NonNegFlonum -Flonum B)
(-> -Flonum -NonNegFlonum B : (-FS (-filter -NonNegFlonum 0) -top))
(-> -NegFlonum -Flonum B : (-FS (-filter -NegFlonum 1) -top))
(-> -Flonum -NegFlonum B : (-FS -top -top))
(-> -NonPosFlonum -Flonum B : (-FS -top -top))
(-> -Flonum -NegFlonum B)
(-> -NonPosFlonum -Flonum B)
(-> -Flonum -NonPosFlonum B : (-FS (-filter -NonPosFlonum 0) -top))
(comp -Flonum))))
(define flmin-type

6
collects/typed-racket/typecheck/tc-app-helper.rkt
View File

@ -41,9 +41,9 @@
(let-values
([(o-a t-a) (for/lists (os ts)
([nm (in-range arg-count)]
[oa (in-sequence-forever (in-list o-a) (make-Empty))]
[ta (in-sequence-forever (in-list t-a) (Un))])
(values (if (>= nm dom-count) (make-Empty) oa)
[oa (in-sequence-forever (in-list o-a) -no-obj)]
[ta (in-sequence-forever (in-list t-a) -Bottom)])
(values (if (>= nm dom-count) -no-obj oa)
ta))])
(match rng
((AnyValues:) tc-any-results)

2
collects/typed-racket/typecheck/tc-apply.rkt
View File

@ -21,7 +21,7 @@
[(ValuesDots: (list (Result: ts _ _) ...) dty dbound)
(ret ts
(for/list ([t (in-list ts)]) (make-NoFilter))
(for/list ([t (in-list ts)]) (make-Empty))
(for/list ([t (in-list ts)]) -no-obj)
dty dbound)]
[_ (int-err "do-ret fails: ~a" t)]))

6
collects/typed-racket/typecheck/tc-if.rkt
View File

@ -89,15 +89,15 @@
(let ([filter
(match* (f2 f3)
[((NoFilter:) _)
(-FS -top -top)]
-no-filter]
[(_ (NoFilter:))
(-FS -top -top)]
-no-filter]
[((FilterSet: f2+ f2-) (FilterSet: f3+ f3-))
;(printf "f2- ~a f+ ~a\n" f2- fs+)
(-FS (-or (apply -and fs+ f2+ new-thn-props) (apply -and fs- f3+ new-els-props))
(-or (apply -and fs+ f2- new-thn-props) (apply -and fs- f3- new-els-props)))])]
[type (Un t2 t3)]
[object (if (object-equal? o2 o3) o2 (make-Empty))])
[object (if (object-equal? o2 o3) o2 -no-obj)])
;(printf "result filter is: ~a\n" filter)
(ret type filter object))))]
;; special case if one of the branches is unreachable

2
collects/typed-racket/typecheck/tc-let-unit.rkt
View File

@ -71,7 +71,7 @@
(for/list ([i (in-list lst)])
(for/fold ([s i])
([nm (in-list (apply append abstract namess))])
(proc s nm (make-Empty) #t))))])
(proc s nm -no-obj #t))))])
(define (run res)
(match res
[(tc-any-results:) res]

4
collects/typed-racket/typecheck/tc-metafunctions.rkt
View File

@ -35,7 +35,7 @@
[(_ i) (app lookup (? values i))]))
(match o
[(Path: p (lookup: idx)) (make-Path p idx)]
[_ (make-Empty)]))
[_ -no-obj]))
(define/cond-contract (abstract-filter ids keys fs)
@ -43,7 +43,7 @@
(match fs
[(FilterSet: f+ f-)
(-FS (abo ids keys f+) (abo ids keys f-))]
[(NoFilter:) (-FS -top -top)]))
[(NoFilter:) -no-filter]))
(define/cond-contract (abo xs idxs f)
((listof identifier?) (listof name-ref/c) Filter/c . -> . Filter/c)

6
collects/typed-racket/typecheck/tc-subst.rkt
View File

@ -34,7 +34,7 @@
[(FilterSet: f+ f-)
(-FS (subst-filter (add-extra-filter f+) k o polarity)
(subst-filter (add-extra-filter f-) k o polarity))]
[_ (-FS -top -top)]))
[_ -no-filter]))
(define/cond-contract (subst-type t k o polarity)
(-> Type/c name-ref/c Object? boolean? Type/c)
@ -64,9 +64,9 @@
[(Path: p i)
(if (name-ref=? i k)
(match o
[(Empty:) (make-Empty)]
[(Empty:) -no-obj]
;; the result is not from an annotation, so it isn't a NoObject
[(NoObject:) (make-Empty)]
[(NoObject:) -no-obj]
[(Path: p* i*) (make-Path (append p p*) i*)])
t)]))

6
collects/typed-racket/types/substitute.rkt
View File

@ -4,7 +4,7 @@
racket/match racket/set racket/function unstable/function
racket/lazy-require
(contract-req)
(only-in (types base-abbrev) -lst* -result)
(only-in (types base-abbrev) -lst* -result -no-filter -no-obj)
(rep type-rep filter-rep object-rep rep-utils)
(utils tc-utils)
(rep free-variance)
@ -111,8 +111,8 @@
(for/list ([img (in-list images)])
(make-Result
(substitute img name expanded)
(make-FilterSet (make-Top) (make-Top))
(make-Empty))))))
-no-filter
-no-obj)))))
(make-ValuesDots (map sb types) (sb dty) dbound))]
[#:arr dom rng rest drest kws
(if (and (pair? drest)

20
collects/typed-racket/types/tc-result.rkt
View File

@ -3,6 +3,7 @@
(require "../utils/utils.rkt"
(rep free-variance type-rep filter-rep object-rep rep-utils)
(utils tc-utils)
(types base-abbrev)
racket/match
(contract-req))
@ -67,20 +68,19 @@
;; convenience function for returning the result of typechecking an expression
(define ret
(case-lambda [(t)
(let ([mk (lambda (t) (make-FilterSet (make-Top) (make-Top)))])
(make-tc-results
(cond [(Type/c? t)
(list (make-tc-result t (mk t) (make-Empty)))]
[else
(for/list ([i (in-list t)])
(make-tc-result i (mk t) (make-Empty)))])
#f))]
(make-tc-results
(cond [(Type/c? t)
(list (make-tc-result t -no-filter -no-obj))]
[else
(for/list ([i (in-list t)])
(make-tc-result i -no-filter -no-obj))])
#f)]
[(t f)
(make-tc-results
(if (Type/c? t)
(list (make-tc-result t f (make-Empty)))
(list (make-tc-result t f -no-obj))
(for/list ([i (in-list t)] [f (in-list f)])
(make-tc-result i f (make-Empty))))
(make-tc-result i f -no-obj)))
#f)]
[(t f o)
(make-tc-results