diff --git a/code/extrinsic/packages.lisp b/code/extrinsic/packages.lisp index e8ca1d5..b36dc21 100644 --- a/code/extrinsic/packages.lisp +++ b/code/extrinsic/packages.lisp @@ -20,19 +20,46 @@ #:*standard-pprint-dispatch* #:copy-pprint-dispatch #:intrinsic-client + #:pprint-apply + #:pprint-argument-list + #:pprint-array #:pprint-bindings + #:pprint-call + #:pprint-case + #:pprint-cond + #:pprint-defclass + #:pprint-defmethod + #:pprint-defpackage #:pprint-defun + #:pprint-destructuring-bind #:pprint-dispatch + #:pprint-do + #:pprint-dolist #:pprint-exit-if-list-exhausted #:pprint-fill + #:pprint-flet + #:pprint-function-call #:pprint-indent + #:pprint-lambda + #:pprint-lambda-list + #:pprint-let #:pprint-linear #:pprint-logical-block + #:pprint-loop #:pprint-macro-char + #:pprint-multiple-value-bind #:pprint-newline #:pprint-pop + #:pprint-prog + #:pprint-prog1 + #:pprint-prog2 + #:pprint-progn + #:pprint-progv + #:pprint-symbol-macrolet #:pprint-tab #:pprint-tabular + #:pprint-tagbody + #:pprint-with #:pretty-stream-p #:set-pprint-dispatch #:with-standard-io-syntax)) diff --git a/code/interface.lisp b/code/interface.lisp index 87baa57..97884a3 100644 --- a/code/interface.lisp +++ b/code/interface.lisp @@ -230,39 +230,118 @@ (set-pprint-dispatch ,client-var table type-specifier function priority)) (defun ,(intern "PPRINT-FILL" intrinsic-pkg) (stream object &optional (colon-p t) at-sign-p) (pprint-fill ,client-var (coerce-output-stream-designator stream) - object colon-p at-sign-p) + object colon-p at-sign-p) nil) (defun ,(intern "PPRINT-LINEAR" intrinsic-pkg) (stream object &optional (colon-p t) at-sign-p) (pprint-linear ,client-var (coerce-output-stream-designator stream) - object colon-p at-sign-p) + object colon-p at-sign-p) nil) (defun ,(intern "PPRINT-TABULAR" intrinsic-pkg) (stream object &optional (colon-p t) at-sign-p (tabsize 16)) (pprint-tabular ,client-var (coerce-output-stream-designator stream) - object colon-p at-sign-p tabsize) - nil) - (defun ,(intern "PPRINT-BINDINGS") (stream object &optional (colon-p t) at-sign-p) - (pprint-bindings ,client-var (coerce-output-stream-designator stream) - object colon-p at-sign-p) - nil) - (defun ,(intern "PPRINT-DEFUN") (stream object &optional colon-p at-sign-p) - (pprint-defun ,client-var (coerce-output-stream-designator stream) - object colon-p at-sign-p) + object colon-p at-sign-p tabsize) nil) (defun ,(intern "PPRINT-INDENT" intrinsic-pkg) (relative-to n &optional stream) (check-type relative-to (member :block :current)) (pprint-indent ,client-var (coerce-output-stream-designator stream) - relative-to n) + relative-to n) nil) (defun ,(intern "PPRINT-NEWLINE" intrinsic-pkg) (kind &optional stream) (check-type kind (member :linear :fill :miser :mandatory)) (pprint-newline ,client-var (coerce-output-stream-designator stream) - kind) + kind) nil) (defun ,(intern "PPRINT-TAB" intrinsic-pkg) (kind colnum colinc &optional stream) (check-type kind (member :line :section :line-relative :section-relative)) (pprint-tab ,client-var (coerce-output-stream-designator stream) - kind colnum colinc) + kind colnum colinc) nil) + (defun ,(intern "PPRINT-ARRAY") (stream object &optional colon-p at-sign-p) + (pprint-array ,client-var (coerce-output-stream-designator stream) + object colon-p at-sign-p)) + (defun ,(intern "PPRINT-APPLY") (stream object &optional colon-p at-sign-p) + (pprint-apply ,client-var (coerce-output-stream-designator stream) + object colon-p at-sign-p)) + (defun ,(intern "PPRINT-BINDINGS") (stream object &optional colon-p at-sign-p) + (pprint-bindings ,client-var (coerce-output-stream-designator stream) + object colon-p at-sign-p)) + (defun ,(intern "PPRINT-CALL") (stream object &optional colon-p at-sign-p) + (pprint-call ,client-var (coerce-output-stream-designator stream) + object colon-p at-sign-p)) + (defun ,(intern "PPRINT-CASE") (stream object &optional colon-p at-sign-p) + (pprint-case ,client-var (coerce-output-stream-designator stream) + object colon-p at-sign-p)) + (defun ,(intern "PPRINT-COND") (stream object &optional colon-p at-sign-p) + (pprint-cond ,client-var (coerce-output-stream-designator stream) + object colon-p at-sign-p)) + (defun ,(intern "PPRINT-DEFCLASS") (stream object &optional colon-p at-sign-p) + (pprint-defclass ,client-var (coerce-output-stream-designator stream) + object colon-p at-sign-p)) + (defun ,(intern "PPRINT-DEFUN") (stream object &optional colon-p at-sign-p) + (pprint-defun ,client-var (coerce-output-stream-designator stream) + object colon-p at-sign-p)) + (defun ,(intern "PPRINT-DEFMETHOD") (stream object &optional colon-p at-sign-p) + (pprint-defmethod ,client-var (coerce-output-stream-designator stream) + object colon-p at-sign-p)) + (defun ,(intern "PPRINT-DEFPACKAGE") (stream object &optional colon-p at-sign-p) + (pprint-defpackage ,client-var (coerce-output-stream-designator stream) + object colon-p at-sign-p)) + (defun ,(intern "PPRINT-DO") (stream object &optional colon-p at-sign-p) + (pprint-do ,client-var (coerce-output-stream-designator stream) + object colon-p at-sign-p)) + (defun ,(intern "PPRINT-DOLIST") (stream object &optional colon-p at-sign-p) + (pprint-dolist ,client-var (coerce-output-stream-designator stream) + object colon-p at-sign-p)) + (defun ,(intern "PPRINT-FLET") (stream object &optional colon-p at-sign-p) + (pprint-flet ,client-var (coerce-output-stream-designator stream) + object colon-p at-sign-p)) + (defun ,(intern "PPRINT-LAMBDA") (stream object &optional colon-p at-sign-p) + (pprint-lambda ,client-var (coerce-output-stream-designator stream) + object colon-p at-sign-p)) + (defun ,(intern "PPRINT-LET") (stream object &optional colon-p at-sign-p) + (pprint-let ,client-var (coerce-output-stream-designator stream) + object colon-p at-sign-p)) + (defun ,(intern "PPRINT-LOOP") (stream object &optional colon-p at-sign-p) + (pprint-loop ,client-var (coerce-output-stream-designator stream) + object colon-p at-sign-p)) + (defun ,(intern "PPRINT-MULTIPLE-VALUE-BIND") (stream object &optional colon-p at-sign-p) + (pprint-multiple-value-bind ,client-var (coerce-output-stream-designator stream) + object colon-p at-sign-p)) + (defun ,(intern "PPRINT-PROG") (stream object &optional colon-p at-sign-p) + (pprint-prog ,client-var (coerce-output-stream-designator stream) + object colon-p at-sign-p)) + (defun ,(intern "PPRINT-PROG1") (stream object &optional colon-p at-sign-p) + (pprint-prog1 ,client-var (coerce-output-stream-designator stream) + object colon-p at-sign-p)) + (defun ,(intern "PPRINT-PROG2") (stream object &optional colon-p at-sign-p) + (pprint-prog2 ,client-var (coerce-output-stream-designator stream) + object colon-p at-sign-p)) + (defun ,(intern "PPRINT-PROGN") (stream object &optional colon-p at-sign-p) + (pprint-progn ,client-var (coerce-output-stream-designator stream) + object colon-p at-sign-p)) + (defun ,(intern "PPRINT-PROGV") (stream object &optional colon-p at-sign-p) + (pprint-progv ,client-var (coerce-output-stream-designator stream) + object colon-p at-sign-p)) + (defun ,(intern "PPRINT-SYMBOL-MACROLET") (stream object &optional colon-p at-sign-p) + (pprint-symbol-macrolet ,client-var (coerce-output-stream-designator stream) + object colon-p at-sign-p)) + (defun ,(intern "PPRINT-TAGBODY") (stream object &optional colon-p at-sign-p) + (pprint-tagbody ,client-var (coerce-output-stream-designator stream) + object colon-p at-sign-p)) + (defun ,(intern "PPRINT-FUNCTION-CALL") (stream object &optional colon-p at-sign-p argument-count) + (pprint-function-call ,client-var (coerce-output-stream-designator stream) + object colon-p at-sign-p argument-count)) + (defun ,(intern "PPRINT-ARGUMENT-LIST") (stream object &optional colon-p at-sign-p argument-count) + (pprint-argument-list ,client-var (coerce-output-stream-designator stream) + object colon-p at-sign-p argument-count)) + (defun ,(intern "PPRINT-WITH") (stream object &optional colon-p at-sign-p argument-count) + (pprint-with ,client-var (coerce-output-stream-designator stream) + object colon-p at-sign-p argument-count)) + (defun ,(intern "PPRINT-LAMBDA-LIST") (stream object &optional colon-p at-sign-p) + (pprint-lambda-list ,client-var (coerce-output-stream-designator stream) + object colon-p at-sign-p)) + (defun ,(intern "PPRINT-DESTRUCTURING-BIND") (stream object &optional colon-p at-sign-p) + (pprint-destructuring-bind ,client-var (coerce-output-stream-designator stream) + object colon-p at-sign-p)) (defun ,(intern "PPRINT-MACRO-CHAR") (stream object &optional colon-p at-sign-p disp-char sub-char) (pprint-macro-char ,client-var (coerce-output-stream-designator stream) object colon-p at-sign-p disp-char sub-char)) @@ -271,14 +350,14 @@ (check-type table (or null dispatch-table)) (pprint-dispatch ,client-var (or table ,initial-pprint-dispatch-var) object)) (defmacro ,(intern "PPRINT-LOGICAL-BLOCK" intrinsic-pkg) ((stream-symbol object - &key (prefix "" prefix-p) - (per-line-prefix "" per-line-prefix-p) - (suffix "" suffix-p)) - &body body) + &key (prefix "" prefix-p) + (per-line-prefix "" per-line-prefix-p) + (suffix "" suffix-p)) + &body body) (expand-logical-block ',client-var stream-symbol object - prefix prefix-p per-line-prefix per-line-prefix-p suffix suffix-p - ',pprint-exit-if-list-exhausted-func ',pprint-pop-func - body)) + prefix prefix-p per-line-prefix per-line-prefix-p suffix suffix-p + ',pprint-exit-if-list-exhausted-func ',pprint-pop-func + body)) (defmacro ,pprint-exit-if-list-exhausted-func () "Tests whether or not the list passed to the lexically current logical block has been exhausted. If this list has been reduced to nil, pprint-exit-if-list-exhausted diff --git a/code/intrinsic/packages.lisp b/code/intrinsic/packages.lisp index 1dae7b1..86d3be0 100644 --- a/code/intrinsic/packages.lisp +++ b/code/intrinsic/packages.lisp @@ -4,7 +4,34 @@ #:*standard-pprint-dispatch* #:initialize #:intrinsic-client + #:pprint-apply + #:pprint-argument-list + #:pprint-array #:pprint-bindings + #:pprint-call + #:pprint-case + #:pprint-cond + #:pprint-defclass + #:pprint-defmethod + #:pprint-defpackage #:pprint-defun + #:pprint-destructuring-bind + #:pprint-do + #:pprint-dolist + #:pprint-flet + #:pprint-function-call + #:pprint-lambda + #:pprint-lambda-list + #:pprint-let + #:pprint-loop #:pprint-macro-char + #:pprint-multiple-value-bind + #:pprint-prog + #:pprint-prog1 + #:pprint-prog2 + #:pprint-progn + #:pprint-progv + #:pprint-symbol-macrolet + #:pprint-tagbody + #:pprint-with #:pretty-stream-p))