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

[sod] / src / c-types-impl.lisp

diff --git a/src/c-types-impl.lisp b/src/c-types-impl.lisp
index 9257bf2..89a7c27 100644 (file)
--- a/src/c-types-impl.lisp
+++ b/src/c-types-impl.lisp
@@ -456,27 +456,56 @@
 
 ;; 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.