From 79bf3026203cd72adcdc0f39585508f8919cfd72 Mon Sep 17 00:00:00 2001 From: Eric Dobson Date: Fri, 16 May 2014 19:47:34 -0700 Subject: [PATCH] Remove top-arr. original commit: f6588df2204a76b509678838a43b7be260d6d344 --- .../typed-racket/infer/infer-unit.rkt | 4 -- .../typed-racket/infer/promote-demote.rkt | 39 +++++++++++-------- .../typed-racket/private/type-contract.rkt | 8 +--- .../typed-racket/rep/type-rep.rkt | 7 +--- .../typecheck/check-class-unit.rkt | 5 +-- .../typed-racket/types/abbrev.rkt | 2 +- .../typed-racket/types/printer.rkt | 1 - .../typed-racket/types/structural.rkt | 3 +- .../typed-racket/types/subtype.rkt | 2 - 9 files changed, 28 insertions(+), 43 deletions(-) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/infer/infer-unit.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/infer/infer-unit.rkt index 00d3f80e..420054d0 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/infer/infer-unit.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/infer/infer-unit.rkt @@ -665,10 +665,6 @@ ;; parameters are just like one-arg functions [((Param: in1 out1) (Param: in2 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 t-arr ...))) (% cset-meet* diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/infer/promote-demote.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/infer/promote-demote.rkt index 326628ae..263b9dc8 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/infer/promote-demote.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/infer/promote-demote.rkt @@ -37,24 +37,29 @@ (define (contra t) (structural-recur t 'contra)) (match T - [(? structural?) (structural-map T structural-recur)] [(F: name) (if (memq name V) (if change Univ -Bottom) T)] - [(arr: dom rng rest drest kws) - (cond - [(apply V-in? V (get-filters rng)) - (make-top-arr)] - [(and drest (memq (cdr drest) V)) - (make-arr (map contra dom) - (co rng) - (contra (car drest)) - #f - (map contra kws))] - [else - (make-arr (map contra dom) - (co rng) - (and rest (contra rest)) - (and drest (cons (contra (car drest)) (cdr drest))) - (map contra kws))])] + [(Function: arrs) + (make-Function + (filter values + (for/list ([arr (in-list arrs)]) + (match arr + [(arr: dom rng rest drest kws) + (cond + [(apply V-in? V (get-filters rng)) + #f] + [(and drest (memq (cdr drest) V)) + (make-arr (map contra dom) + (co rng) + (contra (car drest)) + #f + (map contra kws))] + [else + (make-arr (map contra dom) + (co rng) + (and rest (contra rest)) + (and drest (cons (contra (car drest)) (cdr drest))) + (map contra kws))])]))))] + [(? structural?) (structural-map T structural-recur)] [(? Filter?) ((sub-f co) T)] [(? Object?) ((sub-o co) T)] [(? Type?) ((sub-t co) T)])) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/type-contract.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/type-contract.rkt index 398ec089..ff519b24 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/type-contract.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/type-contract.rkt @@ -475,7 +475,6 @@ (define (t->sc/neg t #:recursive-values (recursive-values recursive-values)) (loop t (flip-side typed-side) recursive-values)) (match f - [(Function: (list (top-arr:))) (case->/sc empty)] [(Function: arrs) ;; Try to generate a single `->*' contract if possible. ;; This allows contracts to be generated for functions with both optional and keyword args. @@ -545,16 +544,13 @@ (define arities (for/list ([t arrs]) (match t - [(arr: dom _ _ _ _) (length dom)] - ;; is there something more sensible here? - [(top-arr:) (int-err "got top-arr")]))) + [(arr: dom _ _ _ _) (length dom)]))) (define maybe-dup (check-duplicate arities)) (when maybe-dup (fail #:reason (~a "function type has two cases of arity " maybe-dup))) (if (= (length arrs) 1) ((f #f) (first arrs)) - (case->/sc (map (f #t) arrs)))])] - [_ (int-err "not a function" f)])) + (case->/sc (map (f #t) arrs)))])])) (module predicates racket/base (require racket/extflonum) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/rep/type-rep.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/rep/type-rep.rkt index 42720803..bfae170d 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/rep/type-rep.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/rep/type-rep.rkt @@ -347,13 +347,8 @@ (and drest (cons (type-rec-id (car drest)) (cdr drest))) (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] -(def-type Function ([arities (listof arr/c)]) +(def-type Function ([arities (listof arr?)]) [#:key 'procedure] [#:frees (λ (f) (combine-frees (map f arities)))] [#:fold-rhs (*Function (map type-rec-id arities))]) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/check-class-unit.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/check-class-unit.rkt index 0937e7ed..1a2ceeef 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/check-class-unit.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/check-class-unit.rkt @@ -1366,10 +1366,7 @@ (match type [(Function: (list arrs ...)) (define fixed-arrs - (for/list ([arr arrs] - ;; ignore top-arr, since the arity cannot - ;; be sensibly modified in that case - #:when (arr? arr)) + (for/list ([arr arrs]) (match-define (arr: doms rng rest drest kws) arr) (make-arr (cons self-type doms) rng rest drest kws))) (make-Function fixed-arrs)] diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/abbrev.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/abbrev.rkt index 338b01da..5762ea75 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/abbrev.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/abbrev.rkt @@ -233,7 +233,7 @@ (make-Struct name parent flds proc poly pred)) ;; 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) (make-Function (list (make-arr* (list dom) rng #:filters filter)))) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/printer.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/printer.rkt index f4e92163..8df5c43e 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/printer.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/printer.rkt @@ -207,7 +207,6 @@ ;; Convert an arr (see type-rep.rkt) to its printable form (define (arr->sexp arr) (match arr - [(top-arr:) 'Procedure] [(arr: dom rng rest drest kws) (define out (open-output-string)) (define (fp . args) (apply fprintf out args)) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/structural.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/structural.rkt index 7c7986b1..9c5550b7 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/structural.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/structural.rkt @@ -72,8 +72,7 @@ ;; Non Types [Result (#:co #:co #:co)] [Values ((#:listof #:co))] - [AnyValues ()] - [top-arr ()])) + [AnyValues ()])) (begin-for-syntax (define-syntax-class type-name diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/subtype.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/subtype.rkt index f34c5f32..d368a908 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/subtype.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/subtype.rkt @@ -98,8 +98,6 @@ ;; simple co/contra-variance for -> (define (arr-subtype*/no-fail A0 s t) (match* (s t) - ;; top for functions is above everything - [(_ (top-arr:)) A0] ;; the really simple case [((arr: s1 s2 #f #f '()) (arr: t1 t2 #f #f '()))