From 2f3add11ff278084d4ccb80257a535d4d2c42a39 Mon Sep 17 00:00:00 2001 From: Eric Dobson Date: Sat, 11 Aug 2012 21:40:07 -0700 Subject: [PATCH] Cleanup TR printer to use lazy-require. original commit: c9afe15f56bc7c3a6e2347f370e7d2e075ade594 --- collects/typed-racket/rep/rep-utils.rkt | 22 +++++++++++-------- collects/typed-racket/types/printer.rkt | 8 ++----- collects/typed-racket/utils/utils.rkt | 28 +++++++------------------ 3 files changed, 23 insertions(+), 35 deletions(-) diff --git a/collects/typed-racket/rep/rep-utils.rkt b/collects/typed-racket/rep/rep-utils.rkt index ebe2982e..35cb1263 100644 --- a/collects/typed-racket/rep/rep-utils.rkt +++ b/collects/typed-racket/rep/rep-utils.rkt @@ -1,9 +1,10 @@ #lang racket/base -(require "../utils/utils.rkt" +(require "../utils/utils.rkt" racket/match (contract-req) "free-variance.rkt" "interning.rkt" unstable/struct + unstable/lazy-require racket/stxparam (for-syntax racket/match @@ -16,6 +17,11 @@ [id* id] [keyword* keyword]))) + +(lazy-require + ("../types/printer.rkt" (print-type print-filter print-object print-pathelem))) + + (provide == defintern hash-id (for-syntax fold-target)) ;; seq: interning-generated count that is used to compare types (type<). @@ -297,7 +303,7 @@ define-id:id ;; e.g. def-type kw:keyword ;; e.g. #:Type 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 rec-id:id ;; e.g. type-rec-id (~optional (~and #:key ;; only given for Type. @@ -311,7 +317,6 @@ [(_ i:type-name ...) #'(begin (provide i.define-id ... - i.printer ... i.name ... i.pred? ... i.rec-id ... @@ -323,8 +328,7 @@ (define-syntax i.define-id (mk #'i.name #'i.hashtable i.key? #'i.rec-id)) ... (define-for-syntax i.hashtable (make-hasheq)) ... - (define-struct/printer (i.name Rep) (i.field-names ...) - (lambda (a b c) ((unbox i.printer) a b c))) ... + (define-struct/printer (i.name Rep) (i.field-names ...) i.printer) ... (define-syntax-parameter i.rec-id (λ (stx) (raise-syntax-error #f @@ -343,10 +347,10 @@ '(i.kw ...))) (list i.hashtable ...))))))])) -(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] - [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]) +(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] + [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]) (provide PathElem? (rename-out [Rep-seq Type-seq] [Rep-free-vars free-vars*] diff --git a/collects/typed-racket/types/printer.rkt b/collects/typed-racket/types/printer.rkt index 32a09b83..0a648956 100644 --- a/collects/typed-racket/types/printer.rkt +++ b/collects/typed-racket/types/printer.rkt @@ -7,6 +7,8 @@ "utils/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 ;; do we attempt to find instantiations of polymorphic types to print? @@ -307,9 +309,3 @@ [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) diff --git a/collects/typed-racket/utils/utils.rkt b/collects/typed-racket/utils/utils.rkt index 92fd2256..d5c2a289 100644 --- a/collects/typed-racket/utils/utils.rkt +++ b/collects/typed-racket/utils/utils.rkt @@ -109,19 +109,6 @@ at least theoretically. #'(void))) ;; 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 print-multi-line-case-> (make-parameter #f)) @@ -131,13 +118,14 @@ at least theoretically. #`(define-struct name (flds ...) #:property prop:custom-print-quotable 'never #:property prop:custom-write - (lambda (a b c) (if (custom-printer) - (printer a b c) - ;; ok to make this case slow, it never runs in real code - ((if c - (dynamic-require 'racket/pretty 'pretty-write) - (dynamic-require 'racket/pretty 'pretty-print)) - a b))) + (lambda (v port write?) + (if (custom-printer) + (printer v port write?) + ;; ok to make this case slow, it never runs in real code + ((if write? + (dynamic-require 'racket/pretty 'pretty-write) + (dynamic-require 'racket/pretty 'pretty-print)) + v port))) #:transparent)]))