From d686a3df18a6be0c8c3b1762be3bf21b4662de3c Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Sat, 12 May 2018 23:18:05 -0700 Subject: [PATCH] Rename a bunch of places from "unparse" to "print". --- src/runtime/conpar.scm | 8 ++-- src/runtime/defstr.scm | 8 ++-- src/runtime/dos-pathname.scm | 28 ++++++------ src/runtime/global.scm | 2 +- src/runtime/pp.scm | 82 +++++++++++++++++------------------ src/runtime/unix-pathname.scm | 24 +++++----- 6 files changed, 76 insertions(+), 76 deletions(-) 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 -- 2.25.1