From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 16 Nov 2018 05:36:02 +0000 (-0800)
Subject: Eliminate structure-type/unparser-method and its dependents.
X-Git-Tag: mit-scheme-pucked-10.1.2~16^2~93
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=e7e4b96702ac5f5bdcc0481eaac1c1424e22bf9a;p=mit-scheme.git

Eliminate structure-type/unparser-method and its dependents.
---

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)