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

Cleanup TR printer to use lazy-require.

Browse Source
This commit is contained in:
Eric Dobson 2012-08-11 21:40:07 -07:00 committed by Sam Tobin-Hochstadt
parent 700846a8b9
commit c9afe15f56
3 changed files with 23 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
collects/typed-racket/rep/rep-utils.rkt
View File

@ -1,9 +1,10 @@
#lang racket/base #lang racket/base
(require "../utils/utils.rkt" (require "../utils/utils.rkt"
racket/match racket/match
(contract-req) (contract-req)
"free-variance.rkt" "free-variance.rkt"
"interning.rkt" unstable/struct "interning.rkt" unstable/struct
unstable/lazy-require
racket/stxparam racket/stxparam
(for-syntax (for-syntax
racket/match racket/match
@ -16,6 +17,11 @@
[id* id] [id* id]
[keyword* keyword]))) [keyword* keyword])))
(lazy-require
("../types/printer.rkt" (print-type print-filter print-object print-pathelem)))
(provide == defintern hash-id (for-syntax fold-target)) (provide == defintern hash-id (for-syntax fold-target))
;; seq: interning-generated count that is used to compare types (type<). ;; seq: interning-generated count that is used to compare types (type<).
@ -297,7 +303,7 @@
define-id:id ;; e.g. def-type define-id:id ;; e.g. def-type
kw:keyword ;; e.g. #:Type kw:keyword ;; e.g. #:Type
case:id ;; e.g. type-case case:id ;; e.g. type-case
printer:id ;; e.g. print-type* printer:id ;; e.g. print-type
hashtable:id ;; e.g. type-name-ht hashtable:id ;; e.g. type-name-ht
rec-id:id ;; e.g. type-rec-id rec-id:id ;; e.g. type-rec-id
(~optional (~and #:key ;; only given for Type. (~optional (~and #:key ;; only given for Type.
@ -311,7 +317,6 @@
[(_ i:type-name ...) [(_ i:type-name ...)
#'(begin #'(begin
(provide i.define-id ... (provide i.define-id ...
i.printer ...
i.name ... i.name ...
i.pred? ... i.pred? ...
i.rec-id ... i.rec-id ...
@ -323,8 +328,7 @@
(define-syntax i.define-id (define-syntax i.define-id
(mk #'i.name #'i.hashtable i.key? #'i.rec-id)) ... (mk #'i.name #'i.hashtable i.key? #'i.rec-id)) ...
(define-for-syntax i.hashtable (make-hasheq)) ... (define-for-syntax i.hashtable (make-hasheq)) ...
(define-struct/printer (i.name Rep) (i.field-names ...) (define-struct/printer (i.name Rep) (i.field-names ...) i.printer) ...
(lambda (a b c) ((unbox i.printer) a b c))) ...
(define-syntax-parameter i.rec-id (define-syntax-parameter i.rec-id
(λ (stx) (λ (stx)
(raise-syntax-error #f (raise-syntax-error #f
@ -343,10 +347,10 @@
'(i.kw ...))) '(i.kw ...)))
(list i.hashtable ...))))))])) (list i.hashtable ...))))))]))
(make-prim-type [Type def-type #:Type type-case print-type* type-name-ht type-rec-id #:key] (make-prim-type [Type def-type #:Type type-case print-type type-name-ht type-rec-id #:key]
[Filter def-filter #:Filter filter-case print-filter* filter-name-ht filter-rec-id] [Filter def-filter #:Filter filter-case print-filter filter-name-ht filter-rec-id]
[Object def-object #:Object object-case print-object* object-name-ht object-rec-id] [Object def-object #:Object object-case print-object object-name-ht object-rec-id]
[PathElem def-pathelem #:PathElem pathelem-case print-pathelem* pathelem-name-ht pathelem-rec-id]) [PathElem def-pathelem #:PathElem pathelem-case print-pathelem pathelem-name-ht pathelem-rec-id])
(provide PathElem? (rename-out [Rep-seq Type-seq] (provide PathElem? (rename-out [Rep-seq Type-seq]
[Rep-free-vars free-vars*] [Rep-free-vars free-vars*]

8
collects/typed-racket/types/printer.rkt
View File

@ -7,6 +7,8 @@
"utils/utils.rkt" "utils/utils.rkt"
"utils/tc-utils.rkt")) "utils/tc-utils.rkt"))
(provide print-type print-filter print-object print-pathelem)
;;TODO try to remove requirement on abbrev once promise is fixed ;;TODO try to remove requirement on abbrev once promise is fixed
;; do we attempt to find instantiations of polymorphic types to print? ;; do we attempt to find instantiations of polymorphic types to print?
@ -307,9 +309,3 @@
[else (fp "(Unknown Type: ~a)" (struct->vector c))] [else (fp "(Unknown Type: ~a)" (struct->vector c))]
)) ))
(set-box! print-type* print-type)
(set-box! print-filter* print-filter)
;(set-box! print-latentfilter* print-latentfilter)
(set-box! print-object* print-object)
;(set-box! print-latentobject* print-latentobject)
(set-box! print-pathelem* print-pathelem)

28
collects/typed-racket/utils/utils.rkt
View File

@ -109,19 +109,6 @@ at least theoretically.
#'(void))) #'(void)))
;; custom printing ;; custom printing
;; this requires lots of work for two reasons:
;; - 1 printers have to be defined at the same time as the structs
;; - 2 we want to support things printing corectly even when the custom printer is off
(define-syntax-rule (defprinter t ...)
(begin
(define t (box (lambda _ (error (format "~a not yet defined" 't))))) ...
(provide t ...)))
(defprinter
print-type* print-filter* print-latentfilter* print-object* print-latentobject*
print-pathelem*)
(define custom-printer (make-parameter #t)) (define custom-printer (make-parameter #t))
(define print-multi-line-case-> (make-parameter #f)) (define print-multi-line-case-> (make-parameter #f))
@ -131,13 +118,14 @@ at least theoretically.
#`(define-struct name (flds ...) #`(define-struct name (flds ...)
#:property prop:custom-print-quotable 'never #:property prop:custom-print-quotable 'never
#:property prop:custom-write #:property prop:custom-write
(lambda (a b c) (if (custom-printer) (lambda (v port write?)
(printer a b c) (if (custom-printer)
;; ok to make this case slow, it never runs in real code (printer v port write?)
((if c ;; ok to make this case slow, it never runs in real code
(dynamic-require 'racket/pretty 'pretty-write) ((if write?
(dynamic-require 'racket/pretty 'pretty-print)) (dynamic-require 'racket/pretty 'pretty-write)
a b))) (dynamic-require 'racket/pretty 'pretty-print))
v port)))
#:transparent)])) #:transparent)]))