PATCH: #+CMU arglist tweaks

   1.  This patch makes it possible to get the arglist of a traced
function in CMUCL, by looking beneath the trace encapsulation.

   2.  Formerly, ILISP showed "FOO:" for the arglist if FOO was traced;
this looks obviously broken.  But if FOO had no arguments, it would show
the same thing, so you couldn't really tell what an arglist of "FOO:"
meant.  The patched version *always* produces something when successful.
It also renders "NIL" as "()", because that's the way most people write
empty arglists.  (It seems to me that this shouldn't be part of the
CMUCL-specific code, but should be centralized so that these kinds of UI
presentation decisions can be made consistently across implementations.
Comments?)

					-- Bob Rogers
					   http://rgrjr.dyndns.org/

------------------------------------------------------------------------
Index: cmulisp.lisp
===================================================================
RCS file: /cvsroot/ilisp/ILISP/cmulisp.lisp,v
retrieving revision 1.7
diff -u -r1.7 cmulisp.lisp
--- cmulisp.lisp	5 Sep 2002 13:33:03 -0000	1.7
+++ cmulisp.lisp	11 Sep 2002 19:01:13 -0000
@@ -101,12 +101,21 @@
 	fun)))
 
 (defun extract-function-info-from-name (sym)
-  (let ((mf (macro-function sym)))
-    (if mf
-	(values mf :macro)
-	(if (fboundp sym)
-	    (values (symbol-function sym) :function)
-	    (values nil nil)))))
+  (let ((function (and (fboundp sym)
+		       (symbol-function sym))))
+    (cond ((macro-function sym)
+	    (values (macro-function sym) :macro))
+	  ((not function)
+	    (values nil nil))
+	  ((lisp::encapsulation-info function)
+	    ;; If the function has been traced, we need to get to the underlying
+	    ;; function.  [what about multiple encapsulations?  -- rgr,
+	    ;; 11-Sep-02.]
+	    (values (lisp::encapsulation-info-definition
+		      (lisp::encapsulation-info function))
+		    :function))
+	  (t
+	    (values function :function)))))
 
 ;;;%% arglist - return arglist of function
 ;;;
@@ -115,17 +124,17 @@
 
 (defun arglist (symbol package)
   (ilisp-errors
-   (let* ((package-name (if (packagep package)
-			    (package-name package)
-			    package))
-	  (x (ilisp-find-symbol symbol package-name)))
+   (let ((x (if (symbolp symbol)
+		symbol
+		(ilisp-find-symbol symbol
+				   (if (packagep package)
+				       (package-name package)
+				       package)))))
      (flet ((massage-arglist (args)
 	      (typecase args
-		(string (if (or (null args) (string= args "()"))
-			    ""
-			    args))
-		(list (format nil "~S" args))
-		(t ""))))
+		(string args)
+		(null "()")
+		(t (format nil "~S" args)))))
 
        (multiple-value-bind (func kind)
 	   (extract-function-info-from-name x)


-------------------------------------------------------
In remembrance
www.osdn.com/911/