Skip to content

Commit

Permalink
Add form printer interfaces
Browse files Browse the repository at this point in the history
  • Loading branch information
@yitzchak
yitzchak committed Oct 24, 2023
1 parent 58f4c8c commit 1235ab6
Show file tree
Hide file tree
Showing 3 changed files with 154 additions and 21 deletions.
27 changes: 27 additions & 0 deletions code/extrinsic/packages.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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))
121 changes: 100 additions & 21 deletions code/interface.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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))
Expand All @@ -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
Expand Down
27 changes: 27 additions & 0 deletions code/intrinsic/packages.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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))

0 comments on commit 1235ab6

Please sign in to comment.