diff --git a/src/CHANGELOG b/src/CHANGELOG index e02ce464a..736e061e3 100755 --- a/src/CHANGELOG +++ b/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 *** diff --git a/src/c/symbols_list.h b/src/c/symbols_list.h index ecbf973fc..1b51b6ccc 100755 --- a/src/c/symbols_list.h +++ b/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}}; diff --git a/src/c/symbols_list2.h b/src/c/symbols_list2.h index c41a71dd1..b386e4b83 100755 --- a/src/c/symbols_list2.h +++ b/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}}; diff --git a/src/lsp/top.lsp b/src/lsp/top.lsp index b05549cc7..5d457f845 100644 --- a/src/lsp/top.lsp +++ b/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)