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

don't need d/c/p any more

Browse Source
This commit is contained in:
Sam Tobin-Hochstadt 2010-04-30 16:04:22 -04:00
parent b308a52240
commit 96da427659
3 changed files with 18 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -18,10 +18,10 @@
[((Bot:) _) (-FS -bot -top)] [((Bot:) _) (-FS -bot -top)]
[(_ _) (-FS l1 l2)])) [(_ _) (-FS l1 l2)]))
(provide combine) (provide combine abstract-results)
(d/c/p (abstract-results results arg-names) (d/c (abstract-results results arg-names)
(tc-results? (listof identifier?) . -> . (or/c Values? ValuesDots?)) (tc-results? (listof identifier?) . -> . (or/c Values? ValuesDots?))
(define keys (for/list ([(nm k) (in-indexed arg-names)]) k)) (define keys (for/list ([(nm k) (in-indexed arg-names)]) k))
(match results (match results

22
collects/typed-scheme/typecheck/tc-subst.rkt
View File

@ -10,20 +10,20 @@
(for-syntax scheme/base) (for-syntax scheme/base)
"tc-metafunctions.rkt") "tc-metafunctions.rkt")
;(provide (all-defined-out)) (provide (all-defined-out))
(d/c/p (open-Result r objs ts) (d/c (open-Result r objs [ts #f])
(-> Result? (listof Object?) (listof Type/c) (values Type/c FilterSet? Object?)) (->* (Result? (listof Object?)) ((listof Type/c)) (values Type/c FilterSet? Object?))
(match r (match r
[(Result: t fs old-obj) [(Result: t fs old-obj)
(for/fold ([t t] [fs fs] [old-obj old-obj]) (for/fold ([t t] [fs fs] [old-obj old-obj])
([(o k) (in-indexed (in-list objs))] ([(o k) (in-indexed (in-list objs))]
[arg-ty (in-list ts)]) [arg-ty (if ts (in-list ts) (in-cycle (in-value #f)))])
(values (subst-type t k o #t) (values (subst-type t k o #t)
(subst-filter-set fs k o #t arg-ty) (subst-filter-set fs k o #t arg-ty)
(subst-object old-obj k o #t)))])) (subst-object old-obj k o #t)))]))
(d/c/p (subst-filter-set fs k o polarity [t #f]) (d/c (subst-filter-set fs k o polarity [t #f])
(->* (FilterSet? name-ref/c Object? boolean?) ((or/c #f Type/c)) FilterSet?) (->* (FilterSet? name-ref/c Object? boolean?) ((or/c #f Type/c)) FilterSet?)
(define extra-filter (if t (make-TypeFilter t null k) -top)) (define extra-filter (if t (make-TypeFilter t null k) -top))
(match fs (match fs
@ -31,7 +31,7 @@
(combine (subst-filter (-and extra-filter f+) k o polarity) (combine (subst-filter (-and extra-filter f+) k o polarity)
(subst-filter (-and extra-filter f-) k o polarity))])) (subst-filter (-and extra-filter f-) k o polarity))]))
(d/c/p (subst-type t k o polarity) (d/c (subst-type t k o polarity)
(-> Type/c name-ref/c Object? boolean? Type/c) (-> Type/c name-ref/c Object? boolean? Type/c)
(define (st t) (subst-type t k o polarity)) (define (st t) (subst-type t k o polarity))
(d/c (sf fs) (FilterSet? . -> . FilterSet?) (subst-filter-set fs k o polarity)) (d/c (sf fs) (FilterSet? . -> . FilterSet?) (subst-filter-set fs k o polarity))
@ -51,7 +51,7 @@
(and drest (cons (st (car drest)) (cdr drest))) (and drest (cons (st (car drest)) (cdr drest)))
(map st kws)))])) (map st kws)))]))
(d/c/p (subst-object t k o polarity) (d/c (subst-object t k o polarity)
(-> Object? name-ref/c Object? boolean? Object?) (-> Object? name-ref/c Object? boolean? Object?)
(match t (match t
[(NoObject:) t] [(NoObject:) t]
@ -66,7 +66,7 @@
t)])) t)]))
;; this is the substitution metafunction ;; this is the substitution metafunction
(d/c/p (subst-filter f k o polarity) (d/c (subst-filter f k o polarity)
(-> Filter/c name-ref/c Object? boolean? Filter/c) (-> Filter/c name-ref/c Object? boolean? Filter/c)
(define (ap f) (subst-filter f k o polarity)) (define (ap f) (subst-filter f k o polarity))
(define (tf-matcher t p i k o polarity maker) (define (tf-matcher t p i k o polarity maker)
@ -136,11 +136,13 @@
#f)) #f))
;; (or/c Values? ValuesDots?) listof[identifier] -> tc-results? ;; (or/c Values? ValuesDots?) listof[identifier] -> tc-results?
(d/c/p (values->tc-results tc formals) (d/c (values->tc-results tc formals)
((or/c Values? ValuesDots?) (listof identifier?) . -> . tc-results?) ((or/c Values? ValuesDots?) (listof identifier?) . -> . tc-results?)
(match tc (match tc
[(ValuesDots: (list rs ...) dty dbound) [(ValuesDots: (list rs ...) dty dbound)
(let-values ([(ts fs os) (for/lists (ts fs os) ([r (in-list rs)]) (open-Result r (map (lambda (i) (make-Path null i)) formals)))]) (let-values ([(ts fs os)
(for/lists (ts fs os) ([r (in-list rs)])
(open-Result r (map (lambda (i) (make-Path null i)) formals)))])
(ret ts fs os (ret ts fs os
(for/fold ([dty dty]) ([(o k) (in-indexed (in-list formals))]) (for/fold ([dty dty]) ([(o k) (in-indexed (in-list formals))])
(subst-type dty k (make-Path null o) #t)) (subst-type dty k (make-Path null o) #t))

4
collects/typed-scheme/types/abbrev.rkt
View File

@ -14,7 +14,7 @@
(for-syntax scheme/base syntax/parse) (for-syntax scheme/base syntax/parse)
(for-template scheme/base scheme/contract scheme/promise scheme/tcp scheme/flonum)) (for-template scheme/base scheme/contract scheme/promise scheme/tcp scheme/flonum))
(provide (except-out (all-defined-out) -FS) (provide (all-defined-out)
(rename-out [make-Listof -lst])) (rename-out [make-Listof -lst]))
;; convenient constructors ;; convenient constructors
@ -120,7 +120,7 @@
(define -no-obj (make-Empty)) (define -no-obj (make-Empty))
(d/c/p (-FS + -) (d/c (-FS + -)
(c:-> Filter/c Filter/c FilterSet?) (c:-> Filter/c Filter/c FilterSet?)
(match* (+ -) (match* (+ -)
[((Bot:) _) (make-FilterSet -bot -top)] [((Bot:) _) (make-FilterSet -bot -top)]