Remove top-arr.

This commit is contained in:
Eric Dobson 2014-05-16 19:47:34 -07:00
parent 01b2b8376e
commit f6588df220
9 changed files with 28 additions and 43 deletions

View File

@ -665,10 +665,6 @@
;; parameters are just like one-arg functions ;; parameters are just like one-arg functions
[((Param: in1 out1) (Param: in2 out2)) [((Param: in1 out1) (Param: in2 out2))
(% cset-meet (cg in2 in1) (cg out1 out2))] (% cset-meet (cg in2 in1) (cg out1 out2))]
;; every function is trivially below top-arr
[((Function: _)
(Function: (list (top-arr:))))
empty]
[((Function: (list s-arr ...)) [((Function: (list s-arr ...))
(Function: (list t-arr ...))) (Function: (list t-arr ...)))
(% cset-meet* (% cset-meet*

View File

@ -37,12 +37,16 @@
(define (contra t) (structural-recur t 'contra)) (define (contra t) (structural-recur t 'contra))
(match T (match T
[(? structural?) (structural-map T structural-recur)]
[(F: name) (if (memq name V) (if change Univ -Bottom) T)] [(F: name) (if (memq name V) (if change Univ -Bottom) T)]
[(Function: arrs)
(make-Function
(filter values
(for/list ([arr (in-list arrs)])
(match arr
[(arr: dom rng rest drest kws) [(arr: dom rng rest drest kws)
(cond (cond
[(apply V-in? V (get-filters rng)) [(apply V-in? V (get-filters rng))
(make-top-arr)] #f]
[(and drest (memq (cdr drest) V)) [(and drest (memq (cdr drest) V))
(make-arr (map contra dom) (make-arr (map contra dom)
(co rng) (co rng)
@ -54,7 +58,8 @@
(co rng) (co rng)
(and rest (contra rest)) (and rest (contra rest))
(and drest (cons (contra (car drest)) (cdr drest))) (and drest (cons (contra (car drest)) (cdr drest)))
(map contra kws))])] (map contra kws))])]))))]
[(? structural?) (structural-map T structural-recur)]
[(? Filter?) ((sub-f co) T)] [(? Filter?) ((sub-f co) T)]
[(? Object?) ((sub-o co) T)] [(? Object?) ((sub-o co) T)]
[(? Type?) ((sub-t co) T)])) [(? Type?) ((sub-t co) T)]))

View File

@ -475,7 +475,6 @@
(define (t->sc/neg t #:recursive-values (recursive-values recursive-values)) (define (t->sc/neg t #:recursive-values (recursive-values recursive-values))
(loop t (flip-side typed-side) recursive-values)) (loop t (flip-side typed-side) recursive-values))
(match f (match f
[(Function: (list (top-arr:))) (case->/sc empty)]
[(Function: arrs) [(Function: arrs)
;; Try to generate a single `->*' contract if possible. ;; Try to generate a single `->*' contract if possible.
;; This allows contracts to be generated for functions with both optional and keyword args. ;; This allows contracts to be generated for functions with both optional and keyword args.
@ -545,16 +544,13 @@
(define arities (define arities
(for/list ([t arrs]) (for/list ([t arrs])
(match t (match t
[(arr: dom _ _ _ _) (length dom)] [(arr: dom _ _ _ _) (length dom)])))
;; is there something more sensible here?
[(top-arr:) (int-err "got top-arr")])))
(define maybe-dup (check-duplicate arities)) (define maybe-dup (check-duplicate arities))
(when maybe-dup (when maybe-dup
(fail #:reason (~a "function type has two cases of arity " maybe-dup))) (fail #:reason (~a "function type has two cases of arity " maybe-dup)))
(if (= (length arrs) 1) (if (= (length arrs) 1)
((f #f) (first arrs)) ((f #f) (first arrs))
(case->/sc (map (f #t) arrs)))])] (case->/sc (map (f #t) arrs)))])]))
[_ (int-err "not a function" f)]))
(module predicates racket/base (module predicates racket/base
(require racket/extflonum) (require racket/extflonum)

View File

@ -347,13 +347,8 @@
(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))])
;; top-arr is the supertype of all function types
(def-type top-arr () [#:fold-rhs #:base])
(define arr/c (or/c top-arr? arr?))
;; arities : Listof[arr] ;; arities : Listof[arr]
(def-type Function ([arities (listof arr/c)]) (def-type Function ([arities (listof arr?)])
[#:key 'procedure] [#:key 'procedure]
[#:frees (λ (f) (combine-frees (map f arities)))] [#:frees (λ (f) (combine-frees (map f arities)))]
[#:fold-rhs (*Function (map type-rec-id arities))]) [#:fold-rhs (*Function (map type-rec-id arities))])

View File

@ -1366,10 +1366,7 @@
(match type (match type
[(Function: (list arrs ...)) [(Function: (list arrs ...))
(define fixed-arrs (define fixed-arrs
(for/list ([arr arrs] (for/list ([arr arrs])
;; ignore top-arr, since the arity cannot
;; be sensibly modified in that case
#:when (arr? arr))
(match-define (arr: doms rng rest drest kws) arr) (match-define (arr: doms rng rest drest kws) arr)
(make-arr (cons self-type doms) rng rest drest kws))) (make-arr (cons self-type doms) rng rest drest kws)))
(make-Function fixed-arrs)] (make-Function fixed-arrs)]

View File

@ -233,7 +233,7 @@
(make-Struct name parent flds proc poly pred)) (make-Struct name parent flds proc poly pred))
;; Function type constructors ;; Function type constructors
(define/decl top-func (make-Function (list (make-top-arr)))) (define/decl top-func (make-Function (list)))
(define (asym-pred dom rng filter) (define (asym-pred dom rng filter)
(make-Function (list (make-arr* (list dom) rng #:filters filter)))) (make-Function (list (make-arr* (list dom) rng #:filters filter))))

View File

@ -207,7 +207,6 @@
;; Convert an arr (see type-rep.rkt) to its printable form ;; Convert an arr (see type-rep.rkt) to its printable form
(define (arr->sexp arr) (define (arr->sexp arr)
(match arr (match arr
[(top-arr:) 'Procedure]
[(arr: dom rng rest drest kws) [(arr: dom rng rest drest kws)
(define out (open-output-string)) (define out (open-output-string))
(define (fp . args) (apply fprintf out args)) (define (fp . args) (apply fprintf out args))

View File

@ -72,8 +72,7 @@
;; Non Types ;; Non Types
[Result (#:co #:co #:co)] [Result (#:co #:co #:co)]
[Values ((#:listof #:co))] [Values ((#:listof #:co))]
[AnyValues ()] [AnyValues ()]))
[top-arr ()]))
(begin-for-syntax (begin-for-syntax
(define-syntax-class type-name (define-syntax-class type-name

View File

@ -98,8 +98,6 @@
;; simple co/contra-variance for -> ;; simple co/contra-variance for ->
(define (arr-subtype*/no-fail A0 s t) (define (arr-subtype*/no-fail A0 s t)
(match* (s t) (match* (s t)
;; top for functions is above everything
[(_ (top-arr:)) A0]
;; the really simple case ;; the really simple case
[((arr: s1 s2 #f #f '()) [((arr: s1 s2 #f #f '())
(arr: t1 t2 #f #f '())) (arr: t1 t2 #f #f '()))