Remove top-arr.
original commit: f6588df2204a76b509678838a43b7be260d6d344
This commit is contained in:
Eric Dobson
parent
4f558bdda5
commit
79bf302620
|
|
@ -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*
|
||||
|
|
|
|||
|
|
@ -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)]))
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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))])
|
||||
|
|
|
|||
|
|
@ -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)]
|
||||
|
|
|
|||
|
|
@ -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))))
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 '()))
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user