Expend printing fuel in all branches
This makes (:type (Number -> Integer)) produce (Number -> Integer) instead of expanding at the first name. Combined with expansion cues, this makes it easier for users to expand the relevant parts of types.
This commit is contained in:
parent
19c5d3eaad
commit
34aeaee672
|
@ -19,6 +19,7 @@
|
||||||
|
|
||||||
(tr-eval '(:type Foo))
|
(tr-eval '(:type Foo))
|
||||||
(tr-eval '(:type Bar))
|
(tr-eval '(:type Bar))
|
||||||
|
(tr-eval '(:type (Number -> Integer)))
|
||||||
|
|
||||||
;; if #:verbose, make sure it's the full type
|
;; if #:verbose, make sure it's the full type
|
||||||
(tr-eval '(:type #:verbose Bar))
|
(tr-eval '(:type #:verbose Bar))
|
||||||
|
@ -26,6 +27,7 @@
|
||||||
(check-equal? (get-output-string out)
|
(check-equal? (get-output-string out)
|
||||||
(string-append "(U Integer String)\n[can expand further: String Integer]"
|
(string-append "(U Integer String)\n[can expand further: String Integer]"
|
||||||
"(Foo -> Foo)\n[can expand further: Foo]"
|
"(Foo -> Foo)\n[can expand further: Foo]"
|
||||||
|
"(Number -> Integer)\n[can expand further: Integer Number]"
|
||||||
"((U 0 1 Byte-Larger-Than-One Positive-Index-Not-Byte "
|
"((U 0 1 Byte-Larger-Than-One Positive-Index-Not-Byte "
|
||||||
"Positive-Fixnum-Not-Index Negative-Fixnum "
|
"Positive-Fixnum-Not-Index Negative-Fixnum "
|
||||||
"Positive-Integer-Not-Fixnum Negative-Integer-Not-Fixnum String) "
|
"Positive-Integer-Not-Fixnum Negative-Integer-Not-Fixnum String) "
|
||||||
|
|
|
@ -235,7 +235,10 @@
|
||||||
;; print out a type
|
;; print out a type
|
||||||
;; print-type : Type Port Boolean -> Void
|
;; print-type : Type Port Boolean -> Void
|
||||||
(define (print-type type port write? [ignored-names '()])
|
(define (print-type type port write? [ignored-names '()])
|
||||||
(define (fp . args) (apply fprintf port args))
|
(define (fp . args)
|
||||||
|
(parameterize ([current-print-type-fuel
|
||||||
|
(sub1 (current-print-type-fuel))])
|
||||||
|
(apply fprintf port args)))
|
||||||
(define (tuple? t)
|
(define (tuple? t)
|
||||||
(match t
|
(match t
|
||||||
[(Pair: a (? tuple?)) #t]
|
[(Pair: a (? tuple?)) #t]
|
||||||
|
@ -302,7 +305,12 @@
|
||||||
(when proc
|
(when proc
|
||||||
(fp " ~a" proc))
|
(fp " ~a" proc))
|
||||||
(fp ")")]
|
(fp ")")]
|
||||||
[(Function: arities) (fp "~a" (print-case-lambda type))]
|
[(Function: arities)
|
||||||
|
(define fun-type
|
||||||
|
(parameterize ([current-print-type-fuel
|
||||||
|
(sub1 (current-print-type-fuel))])
|
||||||
|
(print-case-lambda type)))
|
||||||
|
(fp "~a" fun-type)]
|
||||||
[(arr: _ _ _ _ _) (fp "(arr ~a)" (format-arr type))]
|
[(arr: _ _ _ _ _) (fp "(arr ~a)" (format-arr type))]
|
||||||
[(Vector: e) (fp "(Vectorof ~a)" e)]
|
[(Vector: e) (fp "(Vectorof ~a)" e)]
|
||||||
[(HeterogeneousVector: e) (fp "(Vector")
|
[(HeterogeneousVector: e) (fp "(Vector")
|
||||||
|
|
Loading…
Reference in New Issue
Block a user