src/c-types-impl.lisp: Refactor pretty-printing of function types.

This will pay off later.  Even now, it's a bit easier to read.

If you pay attention, you'll notice that there's an extra logical block
around the argument list which doesn't seem to do anything very useful.
That too will pay off later.  Nothing else has actually changed yet.

diff --git a/doc/SYMBOLS b/doc/SYMBOLS
index f580864b02b546729493c91625a1820abdeb76cd..68ece0c05753795c68ddd884cd3d5ca4b7fdf36c 100644 (file)
--- a/doc/SYMBOLS
+++ b/doc/SYMBOLS
@@ -91,6 +91,8 @@ c-types-impl.lisp
   make-union-type                               function
   cl:nil                                        constant c-type parser
   pointer                                       c-type
+  pprint-argument-list                          function
+  pprint-c-function-type                        function
   ptr                                           c-type
   ptrdiff-t                                     c-type
   cl:schar                                      function setf c-type

diff --git a/doc/clang.tex b/doc/clang.tex
index 0a89a904b4503bd14e6d5b1bcee35161ba0afeb8..38e4b208ec24b076cd61f83d53cd08b87723b56f 100644 (file)
--- a/doc/clang.tex
+++ b/doc/clang.tex
@@ -756,6 +756,36 @@ function type is the type of the function's return value.
   @|commentify-argument-names| to the argument list of the given type.
 \end{describe}
 
+\begin{describe}{fun}
+    {pprint-c-function-type @<return-type> @<stream>
+                            @<print-args> @<print-kernel>}
+  Provides the top-level structure for printing C function types.
+
+  Output is written to @<stream> to describe a function type returning
+  @<return-type>, whose declarator kernel (containing the name, and any
+  further type operands) will be printed by @<print-kernel>, and whose
+  arguments, if any, will be printed by @<print-args>.
+
+  The @<print-kernel> function is a standard kernel-printing function
+  following the \descref{pprint-c-type}[protocol]{gf}.
+
+  The @<print-args> function is given a single argument, which is the
+  @<stream> to print on.  It should not print the surrounding parentheses.
+
+  The output written to @<stream> looks approximately like
+  \begin{prog}
+    @<return-type> @<kernel>(@<args>)
+  \end{prog}
+\end{describe}
+
+\begin{describe}{fun}{pprint-argument-list @<args> @<stream> @> @<flag>}
+  Print an argument list to @<stream>.
+
+  The @<args> is a list of \descref{argument}[objects]{cls}, optionally
+  containing an @|:ellipsis| marker.  The function returns true if any
+  arguments were actually printed.
+\end{describe}
+
 
 \subsection{Parsing C types} \label{sec:clang.c-types.parsing}
 

diff --git a/src/c-types-impl.lisp b/src/c-types-impl.lisp
index 9257bf232c8de6da37a6cb4968f3c24e155dd767..89a7c279c936be507b81a25e9ff89eee411c839c 100644 (file)
--- a/src/c-types-impl.lisp
+++ b/src/c-types-impl.lisp
@@ -456,27 +456,56 @@ (defmethod c-type-equal-p and
 
 ;; C syntax output protocol.
 
+(export 'pprint-c-function-type)
+(defun pprint-c-function-type (return-type stream print-args print-kernel)
+  "Common top-level printing for function types.
+
+   Prints RETURN-TYPE (KERNEL(ARGS)), where RETURN-TYPE is the actual return
+   type, and ARGS and KERNEL are whatever is printed by the PRINT-ARGS and
+   PRINT-KERNEL functions.
+
+   The PRINT-KERNEL function is the standard such thing for the
+   `pprint-c-type' protocol; PRINT-ARGS accepts just an output stream."
+  (pprint-c-type return-type stream
+                (lambda (stream prio spacep)
+                  (maybe-in-parens (stream (> prio 2))
+                    (when spacep (c-type-space stream))
+                    (funcall print-kernel stream 2 nil)
+                    (pprint-indent :block 4 stream)
+                    (pprint-logical-block
+                        (stream nil :prefix "(" :suffix ")")
+                      (funcall print-args stream))))))
+
+(export 'pprint-argument-list)
+(defun pprint-argument-list (args stream)
+  "Print an argument list.
+
+   The ARGS is a list of `argument' objects, optionally containing an
+   `:ellipsis' marker.  The output is written to STREAM.
+
+   Returns non-nil if any arguments were actually printed."
+  (let ((anyp nil))
+    (pprint-logical-block (stream nil)
+      (dolist (arg args)
+       (if anyp
+           (format stream ", ~_")
+           (setf anyp t))
+       (etypecase arg
+         ((member :ellipsis)
+          (write-string "..." stream))
+         (argument
+          (pprint-logical-block (stream nil)
+            (pprint-c-type (argument-type arg) stream
+                           (argument-name arg)))))))
+    anyp))
+
 (let ((void-arglist (list (make-argument nil c-type-void))))
   (defmethod pprint-c-type ((type c-function-type) stream kernel)
-    (pprint-c-type (c-type-subtype type) stream
-                  (lambda (stream prio spacep)
-                    (maybe-in-parens (stream (> prio 2))
-                      (when spacep (c-type-space stream))
-                      (funcall kernel stream 2 nil)
-                      (pprint-indent :block 4 stream)
-                      (pprint-logical-block
-                          (stream nil :prefix "(" :suffix ")")
-                        (let ((firstp t))
-                          (dolist (arg (or (c-function-arguments type)
-                                           void-arglist))
-                            (if firstp
-                                (setf firstp nil)
-                                (format stream ", ~_"))
-                            (if (eq arg :ellipsis)
-                                (write-string "..." stream)
-                                (pprint-c-type (argument-type arg)
-                                               stream
-                                               (argument-name arg)))))))))))
+    (let ((args (or (c-function-arguments type) void-arglist)))
+      (pprint-c-function-type (c-type-subtype type) stream
+                             (lambda (stream)
+                               (pprint-argument-list args stream))
+                             kernel))))
 
 ;; S-expression notation protocol.