Eliminate structure-type/unparser-method and its dependents.
authorChris Hanson <org/chris-hanson/cph>
Fri, 16 Nov 2018 05:36:02 +0000 (21:36 -0800)
committerChris Hanson <org/chris-hanson/cph>
Fri, 16 Nov 2018 05:36:02 +0000 (21:36 -0800)
src/runtime/printer.scm
src/runtime/record.scm
src/runtime/runtime.pkg

index 6c2416e4e80b3971ae1013498a30575b1d83cf79..1c4c5011f9db5e34bfcc91f8fba9c9a6c18af53f 100644 (file)
@@ -635,30 +635,27 @@ USA.
           (loop (fix:- index 1))))))
 \f
 (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))))
 
index 59410b483146e27c90844fa50728c7738c4710bb..e2e7bc8cb5c7f8660790d5493a4b3aa351503707 100644 (file)
@@ -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))))
index f6cd9e11ee17d2ac07aa47532fc626faf56dae97..5b29ff5e782141e437eeb89bee4bbf63d6f78696 100644 (file)
@@ -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)