From e7e4b96702ac5f5bdcc0481eaac1c1424e22bf9a Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Thu, 15 Nov 2018 21:36:02 -0800 Subject: [PATCH] Eliminate structure-type/unparser-method and its dependents. --- src/runtime/printer.scm | 47 ++++++++++++++++++----------------------- src/runtime/record.scm | 18 ---------------- src/runtime/runtime.pkg | 3 --- 3 files changed, 21 insertions(+), 47 deletions(-) diff --git a/src/runtime/printer.scm b/src/runtime/printer.scm index 6c2416e4e..1c4c5011f 100644 --- a/src/runtime/printer.scm +++ b/src/runtime/printer.scm @@ -635,30 +635,27 @@ USA. (loop (fix:- index 1)))))) (define (print-vector vector context) - (let ((printer (named-vector-with-unparser? vector))) - (if printer - (call-print-method printer vector context) - (limit-print-depth context - (lambda (context*) - (let ((end (vector-length vector))) - (if (fix:> end 0) - (begin - (*print-string "#(" context*) - (print-object (safe-vector-ref vector 0) context*) - (let loop ((index 1)) - (if (fix:< index end) - (if (let ((limit - (context-list-breadth-limit context*))) - (and limit - (>= index limit))) - (*print-string " ...)" context*) - (begin - (*print-char #\space context*) - (print-object (safe-vector-ref vector index) - context*) - (loop (fix:+ index 1)))))) - (*print-char #\) context*)) - (*print-string "#()" context*)))))))) + (limit-print-depth context + (lambda (context*) + (let ((end (vector-length vector))) + (if (fix:> end 0) + (begin + (*print-string "#(" context*) + (print-object (safe-vector-ref vector 0) context*) + (let loop ((index 1)) + (if (fix:< index end) + (if (let ((limit + (context-list-breadth-limit context*))) + (and limit + (>= index limit))) + (*print-string " ...)" context*) + (begin + (*print-char #\space context*) + (print-object (safe-vector-ref vector index) + context*) + (loop (fix:+ index 1)))))) + (*print-char #\) context*)) + (*print-string "#()" context*)))))) (define (safe-vector-ref vector index) (if (with-absolutely-no-interrupts @@ -708,8 +705,6 @@ USA. => (lambda (prefix) (print-prefix-pair prefix pair context))) ((and (get-param:print-streams?) (stream-pair? pair)) (print-stream-pair pair context)) - ((named-list-with-unparser? pair) - => (lambda (printer) (call-print-method printer pair context))) (else (print-list pair context)))) diff --git a/src/runtime/record.scm b/src/runtime/record.scm index 59410b483..e2e7bc8cb 100644 --- a/src/runtime/record.scm +++ b/src/runtime/record.scm @@ -571,7 +571,6 @@ USA. (define structure-type/field-names) (define structure-type/field-indexes) (define structure-type/default-inits) -(define structure-type/unparser-method) (define structure-type/tag) (define structure-type/length) (add-boot-init! @@ -596,8 +595,6 @@ USA. (record-accessor rtd:structure-type 'field-indexes)) (set! structure-type/default-inits (record-accessor rtd:structure-type 'default-inits)) - (set! structure-type/unparser-method - (record-accessor rtd:structure-type 'unparser-method)) (set! structure-type/tag (record-accessor rtd:structure-type 'tag)) (set! structure-type/length @@ -653,21 +650,6 @@ USA. (and (structure-type? type) type)))) -;;; Starting here can be removed after 9.3 release... - -(define (named-list-with-unparser? object) - (and (named-list? object) - (tag->unparser-method (car object)))) - -(define (named-vector-with-unparser? object) - (and (named-vector? object) - (tag->unparser-method (vector-ref object 0)))) - -(define (tag->unparser-method tag) - (structure-type/unparser-method (tag->structure-type tag))) - -;;; ...and ending here. - (define-pp-describer named-list? (lambda (pair) (let ((type (tag->structure-type (car pair)))) diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg index f6cd9e11e..5b29ff5e7 100644 --- a/src/runtime/runtime.pkg +++ b/src/runtime/runtime.pkg @@ -3850,9 +3850,6 @@ USA. (export (runtime pathname) record-type-proxy:host record-type-proxy:pathname) - (export (runtime printer) - named-list-with-unparser? - named-vector-with-unparser?) (initialization (initialize-package!))) (define-package (runtime reference-trap) -- 2.25.1