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 ;; Table for formatting pretty-printed types
(define type-style-table (define type-style-table
(pretty-print-extend-style-table (pretty-print-extend-style-table
#f '(U All) '(and lambda))) #f '(U All -> ->*) '(and lambda and and)))
;; pretty-format-type : Type -> String ;; pretty-format-type : Type -> String
;; Formats the type using pretty printing ;; Formats the type using pretty printing
@ -214,6 +214,7 @@
(apply fp fmt ret rest) (apply fp fmt ret rest)
(fp "-> ~a" ret))) (fp "-> ~a" ret)))
(append (append
(list '->)
(map type->sexp dom) (map type->sexp dom)
;; Format keyword types as strings because the square ;; Format keyword types as strings because the square
;; brackets are significant for printing. Note that ;; brackets are significant for printing. Note that
@ -236,7 +237,6 @@
'... '...
(cdr drest))) (cdr drest)))
null) null)
(list '->)
(match rng (match rng
[(AnyValues:) '(AnyValues)] [(AnyValues:) '(AnyValues)]
[(Values: (list (Result: t (FilterSet: (Top:) (Top:)) (Empty:)))) [(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) (check-equal? (get-output-string out)
(string-append "(U Integer String)\n[can expand further: Integer]" (string-append "(U Integer String)\n[can expand further: Integer]"
"(Foo -> Foo)\n[can expand further: Foo]" "(-> Foo Foo)\n[can expand further: Foo]"
"(Number -> Integer)\n[can expand further: Integer Number]" "(-> Number Integer)\n[can expand further: Integer Number]"
"((U String\n" "(-> (U String\n"
" 0\n" " 0\n"
" 1\n" " 1\n"
" Byte-Larger-Than-One\n" " Byte-Larger-Than-One\n"
@ -37,7 +37,6 @@
" Negative-Fixnum\n" " Negative-Fixnum\n"
" Positive-Integer-Not-Fixnum\n" " Positive-Integer-Not-Fixnum\n"
" Negative-Integer-Not-Fixnum)\n" " Negative-Integer-Not-Fixnum)\n"
" ->\n"
" (U String\n" " (U String\n"
" 0\n" " 0\n"
" 1\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" (test-form-exn #rx"exactly one argument"
(:print-type 1 2)) (:print-type 1 2))
(test-form (regexp-quote "(4 Zero -> Zero)") (test-form (regexp-quote "(-> 4 Zero Zero)")
(:query-type/args * 4 0)) (:query-type/args * 4 0))
(test-form-exn #rx":query-type/args.*applied to arguments" (test-form-exn #rx":query-type/args.*applied to arguments"
:query-type/args) :query-type/args)
@ -113,7 +113,7 @@
(test-form-exn #rx"at least one argument" (test-form-exn #rx"at least one argument"
(:query-type/args)) (:query-type/args))
(test-form (regexp-quote "(case-> (One -> One) (-> One))") (test-form (regexp-quote "(case-> (-> One One) (-> One))")
(:query-type/result * 1)) (:query-type/result * 1))
(test-form #rx"not in the given function's range.\n" (test-form #rx"not in the given function's range.\n"
(:query-type/result + String)) (: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)") "(Vector Symbol String)")
(check-prints-as? (-box (-val 3)) "(Boxof 3)") (check-prints-as? (-box (-val 3)) "(Boxof 3)")
(check-prints-as? (make-Future -Void) "(Futureof Void)") (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? (Un -String -Void) "(U String Void)")
(check-prints-as? (-pair -String -Void) "(Pairof String Void)") (check-prints-as? (-pair -String -Void) "(Pairof String Void)")
(check-prints-as? (make-ListDots -Boolean 'x) "(List Boolean ... x)") (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) (check-prints-as? (make-ValuesDots (list -String -Symbol) (make-F 'x) 'x)
"(values String Symbol x ... x)") "(values String Symbol x ... x)")
(check-prints-as? (-polydots (a b) (->... (list a) (b b) a)) (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? (-mu x (-lst x)) "(Rec x (Listof x))")
(check-prints-as? (-seq -String -Symbol) "(Sequenceof String Symbol)") (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) (check-prints-as? (-> -Input-Port (make-Values (list (-result -String (-FS -top -bot) -no-obj)
(-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 ;; this case tests that the Number union is printed with its name
;; rather than its expansion (a former bug) ;; 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 (check-prints-as? (->key Univ -Pathlike
#:exists #:exists
(one-of/c 'error 'append 'update 'replace (one-of/c 'error 'append 'update 'replace
@ -83,11 +83,11 @@
(one-of/c 'binary 'text) (one-of/c 'binary 'text)
#f #f
-Void) -Void)
(string-append "(Any Path-String [#:exists (U 'error" (string-append "(-> Any Path-String [#:exists (U 'error"
" 'append 'update 'replace 'truncate" " 'append 'update 'replace 'truncate"
" 'truncate/replace)] [#:mode (U" " 'truncate/replace)] [#:mode (U"
" 'binary 'text)] -> Void)")) " 'binary 'text)] Void)"))
(check-prints-as? (->opt Univ [] -Void) "(Any -> Void)") (check-prints-as? (->opt Univ [] -Void) "(-> Any Void)")
(check-prints-as? (->opt [-String] -Void) "(->* () (String) Void)") (check-prints-as? (->opt [-String] -Void) "(->* () (String) Void)")
(check-prints-as? (->opt Univ [-String] -Void) "(->* (Any) (String) Void)") (check-prints-as? (->opt Univ [-String] -Void) "(->* (Any) (String) Void)")
(check-prints-as? (->opt Univ -Symbol [-String] -Void) (check-prints-as? (->opt Univ -Symbol [-String] -Void)
@ -122,11 +122,11 @@
((-lst b) b) . ->... .(-lst c)))) ((-lst b) b) . ->... .(-lst c))))
(string-append "(All (c a b ...)\n" (string-append "(All (c a b ...)\n"
" (case->\n" " (case->\n"
" ((a -> c) (Pairof a (Listof a)) -> (Pairof c (Listof c)))\n" " (-> (-> a c) (Pairof a (Listof a)) (Pairof c (Listof c)))\n"
" ((a b ... b -> c) (Listof a) (Listof b) ... b -> (Listof c))))")) " (-> (-> a b ... b c) (Listof a) (Listof b) ... b (Listof c))))"))
(check-pretty-prints-as? (check-pretty-prints-as?
(-poly (a) (cl->* (-> (-Syntax a) Univ Univ (-Syntax a)) (-poly (a) (cl->* (-> (-Syntax a) Univ Univ (-Syntax a))
(-> (-Syntax Univ) Univ Univ))) (-> (-Syntax Univ) Univ Univ)))
(string-append "(All (a)\n" (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)))")))))