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:
Asumu Takikawa 2013-05-21 10:53:50 -04:00
parent 19c5d3eaad
commit 34aeaee672
2 changed files with 12 additions and 2 deletions

View File

@ -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) "

View File

@ -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")