* module/ice-9/pretty-print.scm (pretty-print): Add #:macro-expr-alist. To accept other quoted-like expressions. * module/ice-9/pretty-print.scm (default-macro-expr-alist): New variable. Used by ‘pretty-print’ to write quote, syntax and g-expressions. * doc/ref/misc-modules.texi (Pretty Printing): Add #:macro-expr-alist. * doc/ref/misc-modules.texi (Pretty Printing): Add ‘default-macro-expr-alist’. --- doc/ref/misc-modules.texi | 21 +++++++++++++++ module/ice-9/pretty-print.scm | 48 +++++++++++++++++++++++------------ 2 files changed, 53 insertions(+), 16 deletions(-)
diff --git a/doc/ref/misc-modules.texi b/doc/ref/misc-modules.texi index a6999466c..1b8ff844c 100644 --- a/doc/ref/misc-modules.texi +++ b/doc/ref/misc-modules.texi @@ -58,9 +58,30 @@ Print within the given @var{columns}. The default is 79. @item @nicode{#:max-expr-width} @var{columns} The maximum width of an expression. The default is 50. + +@item @nicode{#:macro-expr-alist} @var{macro-expr-alist} +The alist of “quoted macros”, whose keys are symbols (@code{quote}, +@code{unquote}, @code{unsyntax}, etc), and their values are the string +representation of the symbol (@code{"'"}, @code{","}, @code{#,}, +etc). The default values is @code{default-macro-expr-alist}. @end table @end deffn +@defvr {Scheme Variable} default-macro-expr-alist +@lisp +'((quote . "'") + (quasiquote . "`") + (unquote . ",") + (unquote-splicing . ",@@") + (syntax . "#'") + (quasisyntax . "#`") + (unsyntax . "#,") + (unsyntax-splicing . "#,@@") + (gexp . "#~") + (ungexp . "#$") + (ungexp-splicing . "#$@@")) +@end lisp +@end defvr @cindex truncated printing Also exported by the @code{(ice-9 pretty-print)} module is diff --git a/module/ice-9/pretty-print.scm b/module/ice-9/pretty-print.scm index 4bc951ebf..aa2e5c541 100644 --- a/module/ice-9/pretty-print.scm +++ b/module/ice-9/pretty-print.scm @@ -53,6 +53,22 @@ (failure (string-concatenate-reverse strs))))) + + +(define default-macro-expr-alist + '((quote . "'") + (quasiquote . "`") + (unquote . ",") + (unquote-splicing . ",@") + (syntax . "#'") + (quasisyntax . "#`") + (unsyntax . "#,") + (unsyntax-splicing . "#,@") + (gexp . "#~") + (ungexp . "#$") + (ungexp-splicing . "#$@"))) + + ;; Parts of pretty-print derived from "genwrite.scm", from SLIB. @@ -66,25 +82,31 @@ (width 79) (max-expr-width 50) (display? #f) - (per-line-prefix "")) + (per-line-prefix "") + (macro-expr-alist default-macro-expr-alist)) "Pretty-print OBJ on PORT, which is a keyword argument defaulting to the current output port. Formatting can be controlled by a number of keyword arguments: Each line in the output is preceded by the string PER-LINE-PREFIX, which is empty by default. The output lines will be at most WIDTH characters wide; the default is 79. If DISPLAY? is true, display rather than write representation will be used. +MACRO-EXPR-ALIST must be an alist whose key is the symbol associated +with the macro and the value is their string representation, the +default value is DEFAULT-MACRO-EXPR-ALIST. Instead of with a keyword argument, you can also specify the output port directly after OBJ, like (pretty-print OBJ PORT)." + (define macro-element? + (let ((macro-lst (map car macro-expr-alist))) + (lambda (x) + (any (lambda (elem) (equal? x elem)) macro-lst)))) (define (wr obj port) (define (wr-read-macro prefix x) (put-string port prefix) (wr x port)) (match obj - (('quote x) (wr-read-macro "'" x)) - (('quasiquote x) (wr-read-macro "`" x)) - (('unquote x) (wr-read-macro "," x)) - (('unquote-splicing x) (wr-read-macro ",@" x)) + (((? macro-element? macro) x) + (wr-read-macro (assq-ref macro-expr-alist macro) x)) ((head . (rest ...)) ;; A proper list: do our own list printing so as to catch read ;; macros that appear in the middle of the list. @@ -125,10 +147,9 @@ port directly after OBJ, like (pretty-print OBJ PORT)." (pr (vector->list obj) pp-pair)) ((not (? pair?)) (wr obj port)) - (('quote x) (put-string port "'") (pr x pp-pair)) - (('quasiquote x) (put-string port "`") (pr x pp-pair)) - (('unquote x) (put-string port ",") (pr x pp-pair)) - (('unquote-splicing x) (put-string port ",@") (pr x pp-pair)) + (((? macro-element? macro) x) + (put-string port (assq-ref macro-expr-alist macro)) + (pr x pp-pair)) (_ ;; A pair (and possibly a list). May have to split on multiple ;; lines. @@ -142,7 +163,7 @@ port directly after OBJ, like (pretty-print OBJ PORT)." (define (pp-expr expr) (match expr - (((or 'quote 'quasiquote 'unquote 'unquote-splicing) _) + (((? macro-element?) _) (pp-quote expr)) (('lambda _ _ . _) (pp-lambda expr)) (('lambda* _ _ . _) (pp-lambda expr)) @@ -197,12 +218,7 @@ port directly after OBJ, like (pretty-print OBJ PORT)." (define (pp-quote expr) (match obj ((head x) - (put-string port - (match x - ('quote "'") - ('quasiquote "`") - ('unquote ",") - ('unquote-splicing ",@"))) + (put-string port (assq-ref macro-expr-alist x)) (pr x pp-expr)))) (define (pp-lambda expr) -- Carlos Durán Domínguez GPG key: https://wurtshell.com/wurt.gpg