X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/e43d353268fc869045f757932d78d6073db9de6e..243cffbf70b9e0155a17563a66efbb6bf34c820c:/src/c-types-impl.lisp

diff --git a/src/c-types-impl.lisp b/src/c-types-impl.lisp
index 9257bf2..5bd9703 100644
--- a/src/c-types-impl.lisp
+++ b/src/c-types-impl.lisp
@@ -456,27 +456,57 @@
 
 ;; 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-newline :linear 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.
 
@@ -484,8 +514,9 @@
     (stream (type c-function-type) &optional colon atsign)
   (declare (ignore colon atsign))
   (format stream "~:@<~
-		  FUN ~@_~:I~/sod:print-c-type/~
-		  ~{ ~_~:<~S ~@_~/sod:print-c-type/~:>~}~
+		  FUN ~@_~:I~
+		  ~/sod:print-c-type/~:[~; ~]~:*~_~
+		  ~<~@{~:<~S ~@_~/sod:print-c-type/~:>~^ ~_~}~:>~
 		  ~:>"
 	  (c-type-subtype type)
 	  (mapcar (lambda (arg)