Raymond Toy pushed to branch issue-497-describe-macro-with-arglist at cmucl / cmucl Commits: a0db1d64 by Raymond Toy at 2026-05-01T11:07:15-07:00 Use common function for printing arglist New function `print-function/macro-arglist` to print the arglist consistently between native compiled or byte-compiled funtions (macros). - - - - - 105f8c4a by Raymond Toy at 2026-05-01T11:13:07-07:00 Add tests for defmacro Tests that we can see the arglist macros. - - - - - 2 changed files: - src/code/describe.lisp - + tests/defmacro.lisp Changes: ===================================== src/code/describe.lisp ===================================== @@ -331,6 +331,20 @@ (:stream (format t "~&~S" name)) (:lisp (format t "~&~S" name))))))))) +;; Common function for printing the function or macro lambda-list. +(defun print-function/macro-arglist (kind args knownp) + (format t (intl:gettext "~&~@(~@[~A ~]arguments:~%~)") kind) + (cond ((not knownp) + (format t (intl:gettext " There is no argument information available."))) + ((or (null args) + (equal args "()")) + (write-string (intl:gettext " There are no arguments."))) + (t + (write-string " ") + (indenting-further *standard-output* 2 + (etypecase args + (string (write-string args)) + (list (prin1 args))))))) ;;; DESCRIBE-FUNCTION-COMPILED -- Internal ;;; @@ -339,15 +353,7 @@ ;;; (defun describe-function-compiled (x kind name) (let ((args (%function-arglist x))) - (format t (intl:gettext "~&~@(~@[~A ~]arguments:~%~)") kind) - (cond ((not args) - (format t (intl:gettext " There is no argument information available."))) - ((string= args "()") - (write-string (intl:gettext " There are no arguments."))) - (t - (write-string " ") - (indenting-further *standard-output* 2 - (write-string args))))) + (print-function/macro-arglist kind args (not (null args)))) (let ((name (or name (%function-name x)))) (desc-doc name 'function kind) @@ -356,25 +362,15 @@ (print-compiled-from (kernel:function-code-header x))) - -#+nil -(defun describe-function-byte-compiled (x kind name) - - (let ((name (or name (c::byte-function-name x)))) - (desc-doc name 'function kind) - (unless (eq kind :macro) - (describe-function-name name 'function))) - - (print-compiled-from (c::byte-function-component x))) - +;;; DESCRIBE-FUNCTION-BYTE-COMPILED -- Internal +;;; +;;; Describe a byte-compiled function. (defun describe-function-byte-compiled (x kind name) - (let ((name (or name (c::byte-function-name x)))) (when (eq kind :macro) - (let ((args (c::info :function :macro-arglist name))) - (when args - (format t (intl:gettext "~&~@(~@[~A ~]arguments:~%~)") kind) - (format t " ~S" args)))) + (multiple-value-bind (args knownp) + (c::info :function :macro-arglist name) + (print-function/macro-arglist kind args knownp))) (desc-doc name 'function kind) (unless (eq kind :macro) (describe-function-name name 'function))) ===================================== tests/defmacro.lisp ===================================== @@ -0,0 +1,78 @@ +;;; Tests for defmacro documention and location info + +(defpackage :defmacro-tests + (:use :cl :lisp-unit)) + +(in-package "DEFMACRO-TESTS") + +(defmacro issue.497.no-args () + `(list)) + +(defmacro issue.497.simple (a b) + `(list ,a ,b)) + +(defmacro issue.497.optional (a &optional (b 0)) + `(* ,a ,b)) + +(defmacro issue.497.body (name &body body) + `(progn ,name ,@body)) + +(defmacro issue.497.with-doc (a b) + "Build a list from two args" + `(list ,a ,b)) + +(define-test issue.497.macro-arglist-no-args + (:tag :issues) + (multiple-value-bind (value knownp) + (c::info :function :macro-arglist 'issue.497.no-args) + (assert-equal '() value) + (assert-true knownp))) + +(define-test issue.497.macro-arglist-simple + (:tag :issues) + (assert-equal '(a b) + (c::info :function :macro-arglist 'issue.497.simple))) + +(define-test issue.497.macro-arglist-optional + (:tag :issues) + (assert-equal '(a &optional (b 0)) + (c::info :function :macro-arglist 'issue.497.optional))) + +(define-test issue.497.macro-arglist-body + (:tag :issues) + (assert-equal '(name &body body) + (c::info :function :macro-arglist 'issue.497.body))) + +(define-test issue.497.macro-expands + (:tag :issues) + ;; Storing the lambda-list must not have broken the macro-function + (assert-equal '(list 1 2) + (macroexpand-1 '(issue.497.simple 1 2)))) + +(define-test issue.497.describe-runs-cleanly + (:tag :issues) + ;; describe must not error on these macros. + (assert-true + (stringp (with-output-to-string (*standard-output*) + (describe 'issue.497.simple)))) + (assert-true + (stringp (with-output-to-string (*standard-output*) + (describe 'issue.497.no-args)))) + (assert-true + (stringp (with-output-to-string (*standard-output*) + (describe 'issue.497.with-doc)))) + ;; And on a byte-compiled macro from the build itself. + (assert-true + (stringp (with-output-to-string (*standard-output*) + (describe 'ext:letf*))))) + +(define-test issue.497.byte-compiled-macro-has-arglist + (:tag :issues) + ;; ext:letf* is byte-compiled (extensions.lisp is :byte-compile t) + ;; and is the canonical example from the bug report. Its arglist + ;; should be available now. + (multiple-value-bind (args winp) + (c::info :function :macro-arglist 'ext:letf*) + (assert-true winp) + (assert-true (consp args)))) + View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/f049451bea794f946103c2b... -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/f049451bea794f946103c2b... You're receiving this email because of your account on gitlab.common-lisp.net. Manage all notifications: https://gitlab.common-lisp.net/-/profile/notifications | Help: https://gitlab.common-lisp.net/help