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

start removing names

Browse Source
This commit is contained in:
Sam Tobin-Hochstadt 2010-04-19 17:52:10 -04:00
parent fca1044972
commit df1572231e
2 changed files with 13 additions and 65 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

62
collects/typed-scheme/rep/filter-rep.ss
View File

@ -14,26 +14,22 @@
'FilterSet 'FilterSet
(λ (e) (or (FilterSet? e) (NoFilter? e))))) (λ (e) (or (FilterSet? e) (NoFilter? e)))))
(provide Filter/c FilterSet/c)
#;(define LatentFilter/c (define name-ref/c (or/c identifier? integer?))
(flat-named-contract (define (hash-name v) (if (identifier? v) (hash-id v) v))
'LatentFilter
(λ (e)
(and (LatentFilter? e) (not (LFilterSet? e))))))
(provide Filter/c FilterSet/c); LatentFilter/c LatentFilterSet/c index/c)
(df Bot () [#:fold-rhs #:base]) (df Bot () [#:fold-rhs #:base])
(df Top () [#:fold-rhs #:base]) (df Top () [#:fold-rhs #:base])
(df TypeFilter ([t Type?] [p (listof PathElem?)] [v identifier?]) (df TypeFilter ([t Type?] [p (listof PathElem?)] [v name-ref/c])
[#:intern (list t p (hash-id v))] [#:intern (list t p (hash-name v))]
[#:frees (combine-frees (map free-vars* (cons t p))) [#:frees (combine-frees (map free-vars* (cons t p)))
(combine-frees (map free-idxs* (cons t p)))] (combine-frees (map free-idxs* (cons t p)))]
[#:fold-rhs (*TypeFilter (type-rec-id t) (map pathelem-rec-id p) v)]) [#:fold-rhs (*TypeFilter (type-rec-id t) (map pathelem-rec-id p) v)])
(df NotTypeFilter ([t Type?] [p (listof PathElem?)] [v identifier?]) (df NotTypeFilter ([t Type?] [p (listof PathElem?)] [v name-ref/c])
[#:intern (list t p (hash-id v))] [#:intern (list t p (hash-name v))]
[#:frees (combine-frees (map free-vars* (cons t p))) [#:frees (combine-frees (map free-vars* (cons t p)))
(combine-frees (map free-idxs* (cons t p)))] (combine-frees (map free-idxs* (cons t p)))]
[#:fold-rhs (*NotTypeFilter (type-rec-id t) (map pathelem-rec-id p) v)]) [#:fold-rhs (*NotTypeFilter (type-rec-id t) (map pathelem-rec-id p) v)])
@ -69,49 +65,5 @@
;; should only be used for parsing type annotations and expected types ;; should only be used for parsing type annotations and expected types
(df NoFilter () [#:fold-rhs #:base]) (df NoFilter () [#:fold-rhs #:base])
#|
(define index/c (or/c natural-number/c keyword?))
(dlf LBot () [#:fold-rhs #:base])
(dlf LTypeFilter ([t Type?] [p (listof PathElem?)] [idx index/c])
[#:frees (lambda (frees*) (combine-frees (map (compose make-invariant frees*) (cons t p))))]
[#:fold-rhs (*LTypeFilter (type-rec-id t) (map pathelem-rec-id p) idx)])
(dlf LNotTypeFilter ([t Type?] [p (listof PathElem?)] [idx index/c])
[#:frees (lambda (frees*) (combine-frees (map (compose make-invariant frees*) (cons t p))))]
[#:fold-rhs (*LNotTypeFilter (type-rec-id t) (map pathelem-rec-id p) idx)])
;; implication
(dlf LImpFilter ([a (non-empty-listof LatentFilter/c)] [c (non-empty-listof LatentFilter/c)])
[#:frees (combine-frees (map free-vars* (append a c)))
(combine-frees (map free-idxs* (append a c)))])
(dlf LFilterSet (thn els)
[#:frees (combine-frees (map free-vars* (append thn els)))
(combine-frees (map free-idxs* (append thn els)))]
[#:fold-rhs (*LFilterSet (map latentfilter-rec-id thn) (map latentfilter-rec-id els))]
[#:contract (->d ([t (cond [(ormap LBot? t)
(list/c LBot?)]
[(ormap LBot? e)
(flat-named-contract "e was LBot" (list/c))]
[else (listof LatentFilter/c)])]
[e (cond [(ormap LBot? e)
(list/c LBot?)]
[(ormap LBot? t)
(flat-named-contract "t was LBot" (list/c))]
[else (listof LatentFilter/c)])])
(#:syntax [stx #f])
[result LFilterSet?])])
(define LatentFilterSet/c
(flat-named-contract
'LatentFilterSet
(λ (e) (or (LFilterSet? e)))))
|#
(define (filter-equal? a b) (= (Rep-seq a) (Rep-seq b))) (define (filter-equal? a b) (= (Rep-seq a) (Rep-seq b)))
(provide filter-equal?) (provide filter-equal?)

16
collects/typed-scheme/rep/type-rep.ss
View File

@ -150,11 +150,9 @@
[rng (or/c Values? ValuesDots?)] [rng (or/c Values? ValuesDots?)]
[rest (or/c #f Type/c)] [rest (or/c #f Type/c)]
[drest (or/c #f (cons/c Type/c (or/c natural-number/c symbol?)))] [drest (or/c #f (cons/c Type/c (or/c natural-number/c symbol?)))]
[kws (listof Keyword?)] [kws (listof Keyword?)])
;; order is: fixed, rest/drest, keywords
[names (listof identifier?)])
#:no-provide #:no-provide
[#:intern (list dom rng rest drest kws (map hash-id names))] [#:intern (list dom rng rest drest kws)]
[#:frees (combine-frees [#:frees (combine-frees
(append (map (compose flip-variances free-vars*) (append (map (compose flip-variances free-vars*)
(append (if rest (list rest) null) (append (if rest (list rest) null)
@ -183,8 +181,7 @@
(type-rec-id rng) (type-rec-id rng)
(and rest (type-rec-id rest)) (and rest (type-rec-id rest))
(and drest (cons (type-rec-id (car drest)) (cdr drest))) (and drest (cons (type-rec-id (car drest)) (cdr drest)))
(map type-rec-id kws) (map type-rec-id kws))])
names)])
;; top-arr is the supertype of all function types ;; top-arr is the supertype of all function types
(dt top-arr () [#:fold-rhs #:base]) (dt top-arr () [#:fold-rhs #:base])
@ -413,7 +410,7 @@
;; necessary to avoid infinite loops ;; necessary to avoid infinite loops
[#:Union elems (*Union (remove-dups (sort (map sb elems) type<?)))] [#:Union elems (*Union (remove-dups (sort (map sb elems) type<?)))]
;; functions ;; functions
[#:arr dom rng rest drest kws names [#:arr dom rng rest drest kws
(*arr (map sb dom) (*arr (map sb dom)
(sb rng) (sb rng)
(if rest (sb rest) #f) (if rest (sb rest) #f)
@ -459,7 +456,7 @@
;; necessary to avoid infinite loops ;; necessary to avoid infinite loops
[#:Union elems (*Union (remove-dups (sort (map sb elems) type<?)))] [#:Union elems (*Union (remove-dups (sort (map sb elems) type<?)))]
;; functions ;; functions
[#:arr dom rng rest drest kws names [#:arr dom rng rest drest kws
(*arr (map sb dom) (*arr (map sb dom)
(sb rng) (sb rng)
(if rest (sb rest) #f) (if rest (sb rest) #f)
@ -467,8 +464,7 @@
(cons (sb (car drest)) (cons (sb (car drest))
(if (eqv? (cdr drest) (+ count outer)) (F-n image) (cdr drest))) (if (eqv? (cdr drest) (+ count outer)) (F-n image) (cdr drest)))
#f) #f)
(map sb kws) (map sb kws))]
names)]
[#:ValuesDots rs dty dbound [#:ValuesDots rs dty dbound
(*ValuesDots (map sb rs) (*ValuesDots (map sb rs)
(sb dty) (sb dty)