From: Chris Hanson <org/chris-hanson/cph>
Date: Sun, 13 May 2018 06:18:05 +0000 (-0700)
Subject: Rename a bunch of places from "unparse" to "print".
X-Git-Tag: mit-scheme-pucked-x11-0.3.1~7^2~55
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=d686a3df18a6be0c8c3b1762be3bf21b4662de3c;p=mit-scheme.git

Rename a bunch of places from "unparse" to "print".
---

diff --git a/src/runtime/conpar.scm b/src/runtime/conpar.scm
index ec0457a48..73c4bc3fb 100644
--- a/src/runtime/conpar.scm
+++ b/src/runtime/conpar.scm
@@ -503,7 +503,7 @@ USA.
 (define-integrable (stack-marker-frame/repl-eval-boundary? stack-frame)
   (eq? with-repl-eval-boundary (stack-marker-frame/type stack-frame)))
 
-;;;; Unparser
+;;;; Printer
 
 (define (stack-frame->continuation stack-frame)
   (make-continuation (stack-frame->control-point stack-frame)
@@ -511,7 +511,7 @@ USA.
 		     #f))
 
 (define (stack-frame->control-point stack-frame)
-  (with-values (lambda () (unparse/stack-frame stack-frame))
+  (with-values (lambda () (print-stack-frame stack-frame))
     (lambda (element-stream next-control-point)
       (make-control-point
        (stack-frame/interrupt-mask stack-frame)
@@ -527,7 +527,7 @@ USA.
 	   element-stream)
        next-control-point))))
 
-(define (unparse/stack-frame stack-frame)
+(define (print-stack-frame stack-frame)
   (if (eq? (stack-frame/return-address stack-frame)
 	   return-address/join-stacklets)
       (values (stream) (vector-ref (stack-frame/elements stack-frame) 1))
@@ -535,7 +535,7 @@ USA.
 	  (lambda ()
 	    (let ((next (stack-frame/%next stack-frame)))
 	      (cond ((stack-frame? next)
-		     (unparse/stack-frame next))
+		     (print-stack-frame next))
 		    ((parser-state? next)
 		     (values (parser-state/element-stream next)
 			     (parser-state/next-control-point next)))
diff --git a/src/runtime/defstr.scm b/src/runtime/defstr.scm
index 339b4036b..d5a0305d0 100644
--- a/src/runtime/defstr.scm
+++ b/src/runtime/defstr.scm
@@ -54,8 +54,8 @@ differences:
   appropriate boolean constant had been specified instead.
 
 * The PRINT-FUNCTION option is named PRINT-PROCEDURE.  Its argument is
-  a procedure of two arguments (the unparser state and the structure
-  instance) rather than three as in Common Lisp.
+  a procedure of two arguments (the structure instance and a textual output
+  port) rather than three as in Common Lisp.
 
 * By default, named structures are tagged with a unique object of some
   kind.  In Common Lisp, the structures are tagged with symbols, but
@@ -160,7 +160,7 @@ differences:
 			    (if print-procedure-option
 				(option/argument print-procedure-option)
 				(and type-option
-				     (default-unparser-text context)))
+				     (default-print-method context)))
 			    (if type-option
 				(option/argument type-option)
 				'record)
@@ -290,7 +290,7 @@ differences:
 (define (default-predicate-name context)
   (symbol (parser-context/name context) '?))
 
-(define (default-unparser-text context)
+(define (default-print-method context)
   `(,(absolute 'standard-print-method context)
     ',(parser-context/name context)))
 
diff --git a/src/runtime/dos-pathname.scm b/src/runtime/dos-pathname.scm
index 236428262..7e8351466 100644
--- a/src/runtime/dos-pathname.scm
+++ b/src/runtime/dos-pathname.scm
@@ -192,20 +192,20 @@ USA.
       'wild
       (substring string start end)))
 
-;;;; Pathname Unparser
+;;;; Pathname printer
 
 (define (dos/pathname->namestring pathname)
-  (string-append (unparse-device (%pathname-device pathname))
-		 (unparse-directory (%pathname-directory pathname))
-		 (unparse-name (%pathname-name pathname)
+  (string-append (print-device (%pathname-device pathname))
+		 (print-directory (%pathname-directory pathname))
+		 (print-name (%pathname-name pathname)
 			       (%pathname-type pathname))))
 
-(define (unparse-device device)
+(define (print-device device)
   (if (or (not device) (eq? device 'unspecific))
       ""
       (string-append device ":")))
 
-(define (unparse-directory directory)
+(define (print-directory directory)
   (cond ((or (not directory) (eq? directory 'unspecific))
 	 "")
 	((pair? directory)
@@ -216,26 +216,26 @@ USA.
 	  (let loop ((directory (cdr directory)))
 	    (if (null? directory)
 		""
-		(string-append (unparse-directory-component (car directory))
+		(string-append (print-directory-component (car directory))
 			       sub-directory-delimiter-string
 			       (loop (cdr directory)))))))
 	(else
 	 (error:illegal-pathname-component directory "directory"))))
 
-(define (unparse-directory-component component)
+(define (print-directory-component component)
   (cond ((eq? component 'up) "..")
 	((string? component) component)
 	(else
 	 (error:illegal-pathname-component component "directory component"))))
 
-(define (unparse-name name type)
-  (let ((name (or (unparse-component name) ""))
-	(type (unparse-component type)))
+(define (print-name name type)
+  (let ((name (or (print-component name) ""))
+	(type (print-component type)))
     (if type
 	(string-append name "." type)
 	name)))
 
-(define (unparse-component component)
+(define (print-component component)
   (cond ((or (not component) (string? component)) component)
 	((eq? component 'wild) "*")
 	(else (error:illegal-pathname-component component "component"))))
@@ -325,7 +325,7 @@ USA.
 	 (simplify-directory
 	  (let ((directory (%pathname-directory pathname))
 		(component
-		 (parse-directory-component (unparse-name name type))))
+		 (parse-directory-component (print-name name type))))
 	    (cond ((not (pair? directory)) (list 'relative component))
 		  ((equal? component ".") directory)
 		  (else (append directory (list component))))))
@@ -347,7 +347,7 @@ USA.
 	(call-with-values
 	    (lambda ()
 	      (parse-name
-	       (unparse-directory-component (car (last-pair directory)))))
+	       (print-directory-component (car (last-pair directory)))))
 	  (lambda (name type)
 	    (%%make-pathname (%pathname-host pathname)
 			     (%pathname-device pathname)
diff --git a/src/runtime/global.scm b/src/runtime/global.scm
index 27e88e9ea..c9a01cb51 100644
--- a/src/runtime/global.scm
+++ b/src/runtime/global.scm
@@ -330,7 +330,7 @@ USA.
     (else #f)))
 
 (define (undefined-value? object)
-  ;; Note: the unparser takes advantage of the fact that objects
+  ;; Note: the printer takes advantage of the fact that objects
   ;; satisfying this predicate also satisfy:
   ;; (object-type? (ucode-type constant) object)
   (or (eq? object unspecific)
diff --git a/src/runtime/pp.scm b/src/runtime/pp.scm
index 51428a18d..8262b28c3 100644
--- a/src/runtime/pp.scm
+++ b/src/runtime/pp.scm
@@ -47,7 +47,7 @@ USA.
    ;; to describe an arity dispatched procedure:
    ;;  FULL:  full bodies of procedures
    ;;  NAMED: just name if the procedure is a named lambda, like FULL if unnamed
-   ;;  SHORT: procedures appear in #[...] unparser syntax
+   ;;  SHORT: procedures appear in #[...] syntax
    (set! param:pp-arity-dispatched-procedure-style
 	 (make-settable-parameter 'full))
    (set! param:pp-auto-highlighter (make-settable-parameter #f))
@@ -284,7 +284,7 @@ USA.
   (let ((print-string
 	 (lambda (s)
 	   (if (string? s)
-	       (*unparse-string s)
+	       (*print-string s)
 	       (s (output-port))))))
     (print-string (pph/start-string pph))
     (thunk)
@@ -320,7 +320,7 @@ USA.
 		  numerical-walk))
 	     (node (numerical-walk expression list-depth)))
 	(if (positive? indentation)
-	    (*unparse-string (make-string indentation #\space)))
+	    (*print-string (make-string indentation #\space)))
 	(if as-code?
 	    (print-node node indentation list-depth)
 	    (print-non-code-node node indentation list-depth))
@@ -329,23 +329,23 @@ USA.
 (define x-size)
 (define output-port)
 
-(define-integrable (*unparse-char char)
+(define-integrable (*print-char char)
   (output-port/write-char (output-port) char))
 
-(define-integrable (*unparse-string string)
+(define-integrable (*print-string string)
   (output-port/write-string (output-port) string))
 
-(define-integrable (*unparse-open)
-  (*unparse-char #\())
+(define-integrable (*print-open)
+  (*print-char #\())
 
-(define-integrable (*unparse-close)
-  (*unparse-char #\)))
+(define-integrable (*print-close)
+  (*print-char #\)))
 
-(define-integrable (*unparse-space)
-  (*unparse-char #\space))
+(define-integrable (*print-space)
+  (*print-char #\space))
 
-(define-integrable (*unparse-newline)
-  (*unparse-char #\newline))
+(define-integrable (*print-newline)
+  (*print-char #\newline))
 
 (define (print-non-code-node node column depth)
   (parameterize* (list (cons dispatch-list '())
@@ -363,22 +363,22 @@ USA.
       (print-node node column depth))))
 
 (define (print-data-column nodes column depth)
-  (*unparse-open)
+  (*print-open)
   (print-column nodes (+ column 1) (+ depth 1))
-  (*unparse-close))
+  (*print-close))
 
 (define (print-data-table nodes column depth)
-  (*unparse-open)
+  (*print-open)
   (maybe-print-table nodes (+ column 1) (+ depth 1))
-  (*unparse-close))
+  (*print-close))
 
 (define (print-node node column depth)
   (cond ((list-node? node)
 	 (print-list-node node column depth))
 	((symbol? node)
-	 (*unparse-symbol node))
+	 (*print-symbol node))
 	((prefix-node? node)
-	 (*unparse-string (prefix-node-prefix node))
+	 (*print-string (prefix-node-prefix node))
 	 (let ((new-column
 		(+ column (string-length (prefix-node-prefix node))))
 	       (subnode (prefix-node-subnode node)))
@@ -403,7 +403,7 @@ USA.
 			  (+ column (pph/start-string-length highlight))
 			  (+ depth (pph/end-string-length highlight))))))))
 	(else
-	 (*unparse-string node))))
+	 (*print-string node))))
 
 (define (print-list-node node column depth)
   (if (and (get-param:pp-save-vertical-space?)
@@ -431,26 +431,26 @@ USA.
   (cond ((list-node? node)
 	 (print-guaranteed-list-node node))
 	((symbol? node)
-	 (*unparse-symbol node))
+	 (*print-symbol node))
 	((highlighted-node? node)
 	 (with-highlight-strings-printed (highlighted-node/highlight node)
 	   (lambda ()
 	     (print-guaranteed-node (highlighted-node/subnode node)))))
 	((prefix-node? node)
-	 (*unparse-string (prefix-node-prefix node))
+	 (*print-string (prefix-node-prefix node))
 	 (print-guaranteed-node (prefix-node-subnode node)))
 	(else
-	 (*unparse-string node))))
+	 (*print-string node))))
 
 (define (print-guaranteed-list-node node)
-  (*unparse-open)
+  (*print-open)
   (let loop ((nodes (node-subnodes node)))
     (print-guaranteed-node (car nodes))
     (if (not (null? (cdr nodes)))
 	(begin
-	  (*unparse-space)
+	  (*print-space)
 	  (loop (cdr nodes)))))
-  (*unparse-close))
+  (*print-close))
 
 (define (print-column nodes column depth)
   (let loop ((nodes nodes))
@@ -568,34 +568,34 @@ USA.
 ;;;; Printers
 
 (define (print-combination nodes column depth)
-  (*unparse-open)
+  (*print-open)
   (let ((column (+ column 1))
 	(depth (+ depth 1)))
     (cond ((null? (cdr nodes))
 	   (print-node (car nodes) column depth))
 	  ((two-on-first-line? nodes column depth)
 	   (print-guaranteed-node (car nodes))
-	   (*unparse-space)
+	   (*print-space)
 	   (print-guaranteed-column (cdr nodes)
 				    (+ column 1 (node-size (car nodes)))))
 	  (else
 	   (print-column nodes column depth))))
-  (*unparse-close))
+  (*print-close))
 
 (define dispatch-list)
 (define dispatch-default)
 (define code-dispatch-list)
 
 (define ((special-printer procedure) nodes column depth)
-  (*unparse-open)
-  (print-guaranteed-node (car nodes))	;(*unparse-symbol (car nodes))
-  (*unparse-space)
+  (*print-open)
+  (print-guaranteed-node (car nodes))	;(*print-symbol (car nodes))
+  (*print-space)
   (if (not (null? (cdr nodes)))
       (procedure (cdr nodes)
 		 (+ column 2 (node-size (car nodes)))
 		 (+ column 2)
 		 (+ depth 1)))
-  (*unparse-close))
+  (*print-close))
 
 ;;; Force the indentation to be an optimistic column.
 
@@ -651,22 +651,22 @@ USA.
 	   (print-node (car nodes) optimistic depth))
 	  ((symbol? (car nodes))
 	   ;; named let
-	   (*unparse-symbol (car nodes))
+	   (*print-symbol (car nodes))
 	   (let ((new-optimistic
 		  (+ optimistic (+ 1 (symbol-length (car nodes))))))
 	     (cond ((fits-within? (cadr nodes) new-optimistic 0)
-		    (*unparse-space)
+		    (*print-space)
 		    (print-guaranteed-node (cadr nodes))
 		    (print-body (cddr nodes)))
 		   ((and (list-node? (cadr nodes))
 			 (fits-as-column? (node-subnodes (cadr nodes))
 					  (+ new-optimistic 2)
 					  0))
-		    (*unparse-space)
-		    (*unparse-open)
+		    (*print-space)
+		    (*print-open)
 		    (print-guaranteed-column (node-subnodes (cadr nodes))
 					     (+ new-optimistic 1))
-		    (*unparse-close)
+		    (*print-close)
 		    (print-body (cddr nodes)))
 		   (else
 		    (tab-to optimistic)
@@ -721,11 +721,11 @@ USA.
 ;;; Starts a new line with the specified indentation.
 
 (define (tab-to column)
-  (*unparse-newline)
+  (*print-newline)
   (pad-with-spaces column))
 
 (define-integrable (pad-with-spaces n-spaces)
-  (*unparse-string (make-string n-spaces #\space)))
+  (*print-string (make-string n-spaces #\space)))
 
 ;;;; Numerical Walk
 
@@ -1210,7 +1210,7 @@ USA.
      (lambda (port)
        (write symbol port)))))
 
-(define (*unparse-symbol symbol)
+(define (*print-symbol symbol)
   (write symbol (output-port)))
 
 (define-structure (prefix-node
diff --git a/src/runtime/unix-pathname.scm b/src/runtime/unix-pathname.scm
index 5dd8041d0..001a6ebc9 100644
--- a/src/runtime/unix-pathname.scm
+++ b/src/runtime/unix-pathname.scm
@@ -152,14 +152,14 @@ USA.
       'wild
       (substring string start end)))
 
-;;;; Pathname Unparser
+;;;; Pathname print
 
 (define (unix/pathname->namestring pathname)
-  (string-append (unparse-directory (%pathname-directory pathname))
-		 (unparse-name (%pathname-name pathname)
+  (string-append (print-directory (%pathname-directory pathname))
+		 (print-name (%pathname-name pathname)
 			       (%pathname-type pathname))))
 
-(define (unparse-directory directory)
+(define (print-directory directory)
   (cond ((not directory)
 	 "")
 	((pair? directory)
@@ -168,27 +168,27 @@ USA.
 	  (let loop ((directory (cdr directory)))
 	    (if (not (pair? directory))
 		""
-		(string-append (unparse-directory-component (car directory))
+		(string-append (print-directory-component (car directory))
 			       "/"
 			       (loop (cdr directory)))))))
 	(else
 	 (error:illegal-pathname-component directory "directory"))))
 
-(define (unparse-directory-component component)
+(define (print-directory-component component)
   (cond ((eq? component 'up) "..")
 	((eq? component 'here) ".")
 	((string? component) component)
 	(else
 	 (error:illegal-pathname-component component "directory component"))))
 
-(define (unparse-name name type)
-  (let ((name (or (unparse-component name) ""))
-	(type (unparse-component type)))
+(define (print-name name type)
+  (let ((name (or (print-component name) ""))
+	(type (print-component type)))
     (if type
 	(string-append name "." type)
 	name)))
 
-(define (unparse-component component)
+(define (print-component component)
   (cond ((or (not component) (string? component)) component)
 	((eq? component 'wild) "*")
 	(else (error:illegal-pathname-component component "component"))))
@@ -254,7 +254,7 @@ USA.
 	 'unspecific
 	 (let ((directory (%pathname-directory pathname))
 	       (component
-		(parse-directory-component (unparse-name name type))))
+		(parse-directory-component (print-name name type))))
 	   (cond ((not (pair? directory))
 		  (list 'relative component))
 		 ((equal? component ".")
@@ -281,7 +281,7 @@ USA.
 	;; the original pathname and leave it to the caller to deal
 	;; with any problems this might cause.
 	pathname
-	(parse-name (unparse-directory-component (car (last-pair directory)))
+	(parse-name (print-directory-component (car (last-pair directory)))
 	  (lambda (name type)
 	    (%make-pathname (%pathname-host pathname)
 			    'unspecific