From: Mark Wooding <mdw@distorted.org.uk>
Date: Tue, 15 Dec 2015 18:29:49 +0000 (+0000)
Subject: src/c-types-impl.lisp: Refactor pretty-printing of function types.
X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~mdw/git/sod/commitdiff_plain/678b6c0f7fe1d62abdf249b173a8a922c4e5c1d3

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 f580864..68ece0c 100644
--- 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 0a89a90..38e4b20 100644
--- 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 9257bf2..89a7c27 100644
--- 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.