- interface between write/display and custom struct writers is

changed in order to allow large structures (e.g., libraries,
  syntax objects, etc.) to print efficiently.  This is done by only
  traversing the parts of the structure that will actually be
  printed, rather than traversing the whole data structure (which is
  what write/display used to do).  Pretty-print should be fixed in a
  similar manner (TODO).
This commit is contained in:
Abdulaziz Ghuloum 2008-10-15 07:44:06 -04:00
parent fd567eb0c6
commit f570ea8c2a
6 changed files with 566 additions and 667 deletions

View File

@ -447,11 +447,11 @@
(car (vector-ref (rtd-fields rtd) k)))))
(set-rtd-printer! (type-descriptor rtd)
(lambda (x p)
(lambda (x p wr)
(display (format "#<record-type-descriptor ~s>" (rtd-name x)) p)))
(set-rtd-printer! (type-descriptor rcd)
(lambda (x p)
(lambda (x p wr)
(display (format "#<record-constructor-descriptor ~s>"
(rtd-name (rcd-rtd x))) p)))

View File

@ -279,7 +279,7 @@
(set-rtd-fields! (base-rtd) '(name fields length printer symbol))
(set-rtd-name! (base-rtd) "base-rtd")
($set-rtd-printer! (base-rtd)
(lambda (x p)
(lambda (x p wr)
(unless (rtd? x)
(die 'struct-type-printer "not an rtd"))
(display "#<" p)

File diff suppressed because it is too large Load Diff

View File

@ -1 +1 @@
1626
1627

View File

@ -261,7 +261,7 @@
;;; Now to syntax objects which are records defined like:
(define-record stx (expr mark* subst* ae*)
(lambda (x p)
(lambda (x p wr)
(display "#<syntax " p)
(write (stx->datum x) p)
(let ((expr (stx-expr x)))
@ -3581,11 +3581,11 @@
;;; An env record encapsulates a substitution and a set of
;;; libraries.
(define-record env (names labels itc)
(lambda (x p)
(lambda (x p wr)
(display "#<environment>" p)))
(define-record interaction-env (rib r locs)
(lambda (x p)
(lambda (x p wr)
(display "#<environment>" p)))
(define environment?

View File

@ -52,7 +52,7 @@
(id name version imp* vis* inv* subst env visit-state
invoke-state visit-code invoke-code visible?
source-file-name)
(lambda (x p)
(lambda (x p wr)
(unless (library? x)
(assertion-violation 'record-type-printer "not a library"))
(display