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

Clean up printing of unions that involve numeric types.

Browse Source
This commit is contained in:
Vincent St-Amour 2011-07-22 11:11:47 -04:00
parent 96eee2b317
commit 10e79ba2ec
1 changed files with 22 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
collects/typed-scheme/types/printer.rkt
View File

@ -1,6 +1,6 @@
#lang scheme/base #lang scheme/base
(require unstable/sequence racket/require racket/match (require unstable/sequence racket/require racket/match racket/list
(path-up "rep/type-rep.rkt" "rep/filter-rep.rkt" "rep/object-rep.rkt" "rep/rep-utils.rkt" (path-up "rep/type-rep.rkt" "rep/filter-rep.rkt" "rep/object-rep.rkt" "rep/rep-utils.rkt"
"types/abbrev.rkt" "types/numeric-tower.rkt" "types/subtype.rkt" "types/abbrev.rkt" "types/numeric-tower.rkt" "types/subtype.rkt"
"utils/utils.rkt" "utils/tc-utils.rkt")) "utils/utils.rkt" "utils/tc-utils.rkt"))
@ -59,6 +59,23 @@
[(Path: pes i) (fp "~a" (append pes (list i)))] [(Path: pes i) (fp "~a" (append pes (list i)))]
[else (fp "(Unknown Object: ~a)" (struct->vector c))])) [else (fp "(Unknown Object: ~a)" (struct->vector c))]))
;; Unions are represented as a flat list of branches. In some cases, it would
;; be nicer to print them using higher-level descriptions instead.
;; Currently, this special-cases numbers, since they're the worst offenders as
;; far as large union types go, but a general solution would be to use min-set-
;; coverage with all the known type names as the sets, and elems being what to
;; cover.
(define (print-union elems)
;; isolate the numeric part of the union
(define-values (subs-of-number rest)
(partition (lambda (t) (subtype t -Number)) elems))
;; and see if it can be more succintly expressed
(define ancestor (and (not (null? subs-of-number))
(has-name? ((get-union-maker) subs-of-number))))
(if ancestor
(cons ancestor rest)
elems))
;; print out a type ;; print out a type
;; print-type : Type Port Boolean -> Void ;; print-type : Type Port Boolean -> Void
(define (print-type c port write?) (define (print-type c port write?)
@ -89,9 +106,9 @@
[(Values: (list (Result: t (FilterSet: (Top:) (Top:)) (Empty:)))) [(Values: (list (Result: t (FilterSet: (Top:) (Top:)) (Empty:))))
(fp "-> ~a" t)] (fp "-> ~a" t)]
[(Values: (list (Result: t [(Values: (list (Result: t
(FilterSet: (TypeFilter: ft pth id) (FilterSet: (TypeFilter: ft pth id)
(NotTypeFilter: ft pth id)) (NotTypeFilter: ft pth id))
(Empty:)))) (Empty:))))
(if (null? pth) (if (null? pth)
(fp "-> ~a : ~a" t ft) (fp "-> ~a : ~a" t ft)
(begin (fp "-> ~a : ~a @" t ft) (begin (fp "-> ~a : ~a @" t ft)
@ -176,7 +193,7 @@
[(Ephemeron: e) (fp "(Ephemeronof ~a)" e)] [(Ephemeron: e) (fp "(Ephemeronof ~a)" e)]
[(CustodianBox: e) (fp "(CustodianBoxof ~a)" e)] [(CustodianBox: e) (fp "(CustodianBoxof ~a)" e)]
[(Set: e) (fp "(Setof ~a)" e)] [(Set: e) (fp "(Setof ~a)" e)]
[(Union: elems) (fp "~a" (cons 'U elems))] [(Union: elems) (fp "~a" (cons 'U (print-union elems)))]
[(Pair: l r) (fp "(Pairof ~a ~a)" l r)] [(Pair: l r) (fp "(Pairof ~a ~a)" l r)]
[(ListDots: dty dbound) [(ListDots: dty dbound)
(fp "(List ~a ...~a~a)" dty (if (special-dots-printing?) "" " ") dbound)] (fp "(List ~a ...~a~a)" dty (if (special-dots-printing?) "" " ") dbound)]