suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Adjust printing of -> and ->*

Browse Source 
Use prefix printing in all cases, and add indentation
rules for pretty printing
This commit is contained in:
Asumu Takikawa 2014-02-13 00:39:30 -05:00
parent 36524740c8
commit 72c9de99e0
4 changed files with 35 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/printer.rkt
View File

@ -87,7 +87,7 @@
;; Table for formatting pretty-printed types
(define type-style-table
(pretty-print-extend-style-table
#f '(U All) '(and lambda)))
#f '(U All -> ->*) '(and lambda and and)))
;; pretty-format-type : Type -> String
;; Formats the type using pretty printing
@ -214,6 +214,7 @@
(apply fp fmt ret rest)
(fp "-> ~a" ret)))
(append
(list '->)
(map type->sexp dom)
;; Format keyword types as strings because the square
;; brackets are significant for printing. Note that
@ -236,7 +237,6 @@
'...
(cdr drest)))
null)
(list '->)
(match rng
[(AnyValues:) '(AnyValues)]
[(Values: (list (Result: t (FilterSet: (Top:) (Top:)) (Empty:))))

7
pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/succeed/type-printer-single-level.rkt
View File

@ -26,9 +26,9 @@
(check-equal? (get-output-string out)
(string-append "(U Integer String)\n[can expand further: Integer]"
"(Foo -> Foo)\n[can expand further: Foo]"
"(Number -> Integer)\n[can expand further: Integer Number]"
"((U String\n"
"(-> Foo Foo)\n[can expand further: Foo]"
"(-> Number Integer)\n[can expand further: Integer Number]"
"(-> (U String\n"
" 0\n"
" 1\n"
" Byte-Larger-Than-One\n"
@ -37,7 +37,6 @@
" Negative-Fixnum\n"
" Positive-Integer-Not-Fixnum\n"
" Negative-Integer-Not-Fixnum)\n"
" ->\n"
" (U String\n"
" 0\n"
" 1\n"

4
pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/interactive-tests.rkt
View File

@ -104,7 +104,7 @@
(test-form-exn #rx"exactly one argument"
(:print-type 1 2))
(test-form (regexp-quote "(4 Zero -> Zero)")
(test-form (regexp-quote "(-> 4 Zero Zero)")
(:query-type/args * 4 0))
(test-form-exn #rx":query-type/args.*applied to arguments"
:query-type/args)
@ -113,7 +113,7 @@
(test-form-exn #rx"at least one argument"
(:query-type/args))
(test-form (regexp-quote "(case-> (One -> One) (-> One))")
(test-form (regexp-quote "(case-> (-> One One) (-> One))")
(:query-type/result * 1))
(test-form #rx"not in the given function's range.\n"
(:query-type/result + String))

22
pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/type-printer-tests.rkt
View File

@ -54,7 +54,7 @@
"(Vector Symbol String)")
(check-prints-as? (-box (-val 3)) "(Boxof 3)")
(check-prints-as? (make-Future -Void) "(Futureof Void)")
(check-prints-as? (-> -String -Void) "(String -> Void)")
(check-prints-as? (-> -String -Void) "(-> String Void)")
(check-prints-as? (Un -String -Void) "(U String Void)")
(check-prints-as? (-pair -String -Void) "(Pairof String Void)")
(check-prints-as? (make-ListDots -Boolean 'x) "(List Boolean ... x)")
@ -64,16 +64,16 @@
(check-prints-as? (make-ValuesDots (list -String -Symbol) (make-F 'x) 'x)
"(values String Symbol x ... x)")
(check-prints-as? (-polydots (a b) (->... (list a) (b b) a))
"(All (a b ...) (a b ... b -> a))")
"(All (a b ...) (-> a b ... b a))")
(check-prints-as? (-mu x (-lst x)) "(Rec x (Listof x))")
(check-prints-as? (-seq -String -Symbol) "(Sequenceof String Symbol)")
(check-prints-as? (-poly (a) (-> a -Void)) "(All (a) (a -> Void))")
(check-prints-as? (-poly (a) (-> a -Void)) "(All (a) (-> a Void))")
(check-prints-as? (-> -Input-Port (make-Values (list (-result -String (-FS -top -bot) -no-obj)
(-result -String (-FS -top -bot) -no-obj))))
"(Input-Port -> (values (String : (Top | Bot)) (String : (Top | Bot))))")
"(-> Input-Port (values (String : (Top | Bot)) (String : (Top | Bot))))")
;; this case tests that the Number union is printed with its name
;; rather than its expansion (a former bug)
(check-prints-as? (->* '() -Number -Void) "(Number * -> Void)")
(check-prints-as? (->* '() -Number -Void) "(-> Number * Void)")
(check-prints-as? (->key Univ -Pathlike
#:exists
(one-of/c 'error 'append 'update 'replace
@ -83,11 +83,11 @@
(one-of/c 'binary 'text)
#f
-Void)
(string-append "(Any Path-String [#:exists (U 'error"
(string-append "(-> Any Path-String [#:exists (U 'error"
" 'append 'update 'replace 'truncate"
" 'truncate/replace)] [#:mode (U"
" 'binary 'text)] -> Void)"))
(check-prints-as? (->opt Univ [] -Void) "(Any -> Void)")
" 'binary 'text)] Void)"))
(check-prints-as? (->opt Univ [] -Void) "(-> Any Void)")
(check-prints-as? (->opt [-String] -Void) "(->* () (String) Void)")
(check-prints-as? (->opt Univ [-String] -Void) "(->* (Any) (String) Void)")
(check-prints-as? (->opt Univ -Symbol [-String] -Void)
@ -122,11 +122,11 @@
((-lst b) b) . ->... .(-lst c))))
(string-append "(All (c a b ...)\n"
" (case->\n"
" ((a -> c) (Pairof a (Listof a)) -> (Pairof c (Listof c)))\n"
" ((a b ... b -> c) (Listof a) (Listof b) ... b -> (Listof c))))"))
" (-> (-> a c) (Pairof a (Listof a)) (Pairof c (Listof c)))\n"
" (-> (-> a b ... b c) (Listof a) (Listof b) ... b (Listof c))))"))
(check-pretty-prints-as?
(-poly (a) (cl->* (-> (-Syntax a) Univ Univ (-Syntax a))
(-> (-Syntax Univ) Univ Univ)))
(string-append "(All (a)\n"
" (case-> ((Syntaxof a) Any Any -> (Syntaxof a)) ((Syntaxof Any) Any -> Any)))")))))
" (case-> (-> (Syntaxof a) Any Any (Syntaxof a)) (-> (Syntaxof Any) Any Any)))")))))