Implemented a new function EXT:FUNCTION-LAMBDA-LIST building on the new annotations facility.

src/CHANGELOG

@@ -124,6 +124,10 @@ and important fixes to let ECL work better with Slime.
  - Documentation files now allow for annotation of arbitrary symbols,
    based on a key and a sub-key which are both symbols.
 
+ - New function EXT:FUNCTION-LAMBDA-LIST which currently only works with
+   functions from the core ECL library, generic functions and interpreted
+   functions.
+
 ;;; Local Variables: ***
 ;;; mode:text ***
 ;;; fill-column:79 ***

src/c/symbols_list.h

@@ -1873,6 +1873,7 @@ cl_symbols[] = {
 {EXT_ "ANNOTATE", EXT_ORDINARY, NULL, -1, Cnil},
 {EXT_ "GET-ANNOTATION", EXT_ORDINARY, NULL, -1, Cnil},
 {EXT_ "REMOVE-ANNOTATION", EXT_ORDINARY, NULL, -1, Cnil},
+{EXT_ "FUNCTION-LAMBDA-LIST", EXT_ORDINARY, NULL, -1, Cnil},
 
 /* Tag for end of list */
 {NULL, CL_ORDINARY, NULL, -1, OBJNULL}};

src/c/symbols_list2.h

@@ -1873,6 +1873,7 @@ cl_symbols[] = {
 {EXT_ "ANNOTATE",NULL},
 {EXT_ "GET-ANNOTATION",NULL},
 {EXT_ "REMOVE-ANNOTATION",NULL},
+{EXT_ "FUNCTION-LAMBDA-LIST",NULL},
 
 /* Tag for end of list */
 {NULL,NULL}};

src/lsp/top.lsp

@@ -833,26 +833,38 @@ Use special code 0 to cancel this operation.")
 
 (defun function-lambda-list (function)
   (cond
+    ((symbolp function)
+     (if (or (not (fboundp function))
+             (special-operator-p function)
+             (macro-function function))
+         (values nil nil)
+         (function-lambda-list (fdefinition function))))
     ((typep function 'generic-function)
-     (generic-function-lambda-list function))
-    ((not (typep function 'compiled-function))
-     (function-lambda-list (fdefinition function)))
+     (values (clos:generic-function-lambda-list function) t))
     ;; Use the lambda list from the function definition, if available,
     ;; but remove &aux arguments.
     ((let ((f (function-lambda-expression function)))
        (when f
-	 (let* ((list (if (eql (first f) 'LAMBDA)
-			  (second f)
-			  (third f)))
-		(ndx (position '&aux list)))
-	   (if ndx
-	       (subseq list 0 (1- ndx))
-	       list)))))
+         (let* ((list (if (eql (first f) 'LAMBDA)
+                          (second f)
+                          (third f)))
+                (ndx (position '&aux list)))
+           (return-from function-lambda-list
+             (values (if ndx (subseq list 0 (1- ndx)) list) t))))))
     ;; Reconstruct the lambda list from the bytecodes
     ((multiple-value-bind (lex-env bytecodes data)
-	 (si::bc-split function)
+         (si::bc-split function)
+       (declare (ignore lex-env))
        (when bytecodes
-	 (reconstruct-bytecodes-lambda-list (coerce data 'list)))))))
+         (setq data (coerce data 'list))
+         (return-from function-lambda-list
+           (values (reconstruct-bytecodes-lambda-list data) t)))))
+    ;; If it's a compiled function of ECL itself, reconstruct the
+    ;; lambda-list from its documentation string.
+    (t
+     (let* ((name (compiled-function-name function))
+            (args (ext:get-annotation name :lambda-list nil)))
+       (values args (and args t))))))
 
 #-ecl-min
 (defun decode-env-elt (env ndx)