Simpler has-name? implementation.

This commit is contained in:
Sam Tobin-Hochstadt 2010-05-27 10:50:15 -04:00
parent 63dbde1e9e
commit bd0bcda85e

View File

@ -1,9 +1,8 @@
#lang scheme/base #lang scheme/base
(require "../utils/utils.rkt") (require unstable/sequence racket/require racket/match
(require (rep type-rep filter-rep object-rep rep-utils) (path-up "rep/type-rep.rkt" "rep/filter-rep.rkt" "rep/object-rep.rkt"
(utils tc-utils) "rep/rep-utils.rkt" "utils/utils.rkt" "utils/tc-utils.rkt"))
scheme/match)
;; do we attempt to find instantiations of polymorphic types to print? ;; do we attempt to find instantiations of polymorphic types to print?
;; FIXME - currently broken ;; FIXME - currently broken
@ -18,16 +17,10 @@
;; does t have a type name associated with it currently? ;; does t have a type name associated with it currently?
;; has-name : Type -> Maybe[Symbol] ;; has-name : Type -> Maybe[Symbol]
(define (has-name? t) (define (has-name? t)
(define ns ((current-type-names))) (and print-aliases
(let/ec return (for/first ([(n t*) (in-pairs (in-list ((current-type-names))))]
(unless print-aliases #:when (type-equal? t t*))
(return #f)) n)))
(for-each
(lambda (pair)
(cond [(eq? t (cdr pair))
(return (car pair))]))
ns)
#f))
(define (print-filter c port write?) (define (print-filter c port write?)
(define (fp . args) (apply fprintf port args)) (define (fp . args) (apply fprintf port args))
@ -126,9 +119,8 @@
[(Univ:) (fp "Any")] [(Univ:) (fp "Any")]
;; special case number until something better happens ;; special case number until something better happens
;;[(Base: 'Number _) (fp "Number")] ;;[(Base: 'Number _) (fp "Number")]
[(? has-name?) [(app has-name? (? values name))
#;(printf "has a name\n") (fp "~a" name)]
(fp "~a" (has-name? c))]
[(StructTop: st) (fp "~a" st)] [(StructTop: st) (fp "~a" st)]
[(BoxTop:) (fp "Box")] [(BoxTop:) (fp "Box")]
[(VectorTop:) (fp "Vector")] [(VectorTop:) (fp "Vector")]