From 72c9de99e0d4b59db897c034838426f6ef5892d3 Mon Sep 17 00:00:00 2001 From: Asumu Takikawa Date: Thu, 13 Feb 2014 00:39:30 -0500 Subject: [PATCH] Adjust printing of -> and ->* Use prefix printing in all cases, and add indentation rules for pretty printing --- .../typed-racket/types/printer.rkt | 4 +- .../succeed/type-printer-single-level.rkt | 41 +++++++++---------- .../unit-tests/interactive-tests.rkt | 4 +- .../unit-tests/type-printer-tests.rkt | 22 +++++----- 4 files changed, 35 insertions(+), 36 deletions(-) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/printer.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/printer.rkt index 7aee55a7a5..c6932e03ae 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/printer.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/printer.rkt @@ -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:)))) diff --git a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/succeed/type-printer-single-level.rkt b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/succeed/type-printer-single-level.rkt index 07c6d6481c..7794788c5c 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/succeed/type-printer-single-level.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/succeed/type-printer-single-level.rkt @@ -26,25 +26,24 @@ (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" - " 0\n" - " 1\n" - " Byte-Larger-Than-One\n" - " Positive-Index-Not-Byte\n" - " Positive-Fixnum-Not-Index\n" - " Negative-Fixnum\n" - " Positive-Integer-Not-Fixnum\n" - " Negative-Integer-Not-Fixnum)\n" - " ->\n" - " (U String\n" - " 0\n" - " 1\n" - " Byte-Larger-Than-One\n" - " Positive-Index-Not-Byte\n" - " Positive-Fixnum-Not-Index\n" - " Negative-Fixnum\n" - " Positive-Integer-Not-Fixnum\n" - " Negative-Integer-Not-Fixnum))\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" + " Positive-Index-Not-Byte\n" + " Positive-Fixnum-Not-Index\n" + " Negative-Fixnum\n" + " Positive-Integer-Not-Fixnum\n" + " Negative-Integer-Not-Fixnum)\n" + " (U String\n" + " 0\n" + " 1\n" + " Byte-Larger-Than-One\n" + " Positive-Index-Not-Byte\n" + " Positive-Fixnum-Not-Index\n" + " Negative-Fixnum\n" + " Positive-Integer-Not-Fixnum\n" + " Negative-Integer-Not-Fixnum))\n")) diff --git a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/interactive-tests.rkt b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/interactive-tests.rkt index 81cabaae5c..6dbb428653 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/interactive-tests.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/interactive-tests.rkt @@ -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)) diff --git a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/type-printer-tests.rkt b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/type-printer-tests.rkt index ac3afec929..6dbd4f45b3 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/type-printer-tests.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/type-printer-tests.rkt @@ -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)))")))))