-;;; The hard part is when the lambda-list is unparsed. If it is
-;;; unparsed, and all the arguments are required, this is still pretty
-;;; easy; just whip the appropriate DEBUG-VARs into a list. Otherwise,
-;;; we have to pick out the funny arguments including any suppliedp
-;;; variables. In this situation, the ir1-lambda is an external entry
-;;; point that takes arguments users really pass in. It looks at those
-;;; and computes defaults and suppliedp variables, ultimately passing
-;;; everything defined as a a parameter to the real function as final
-;;; arguments. If this has to compute the lambda list, it caches it in
-;;; debug-function.
-(defun interpreted-debug-function-lambda-list (debug-function)
- (let ((lambda-list (debug-function-%lambda-list debug-function))
- (debug-vars (debug-function-debug-vars debug-function))
- (ir1-lambda (interpreted-debug-function-ir1-lambda debug-function))
- (res nil))
- (if (eq lambda-list :unparsed)
- (flet ((frob (v debug-vars)
- (if (sb!c::lambda-var-refs v)
- (find v debug-vars
- :key #'interpreted-debug-var-ir1-var)
- :deleted)))
- (let ((xep-args (sb!c::lambda-optional-dispatch ir1-lambda)))
- (if (and xep-args
- (eq (sb!c::optional-dispatch-main-entry xep-args)
- ir1-lambda))
- ;; There are rest, optional, keyword, and suppliedp vars.
- (let ((final-args (sb!c::lambda-vars ir1-lambda)))
- (dolist (xep-arg (sb!c::optional-dispatch-arglist xep-args))
- (let ((info (sb!c::lambda-var-arg-info xep-arg))
- (final-arg (pop final-args)))
- (cond (info
- (case (sb!c::arg-info-kind info)
- (:required
- (push (frob final-arg debug-vars) res))
- (:keyword
- (push (list :keyword
- (sb!c::arg-info-key info)
- (frob final-arg debug-vars))
- res))
- (:rest
- (push (list :rest (frob final-arg debug-vars))
- res))
- (:optional
- (push (list :optional
- (frob final-arg debug-vars))
- res)))
- (when (sb!c::arg-info-supplied-p info)
- (nconc
- (car res)
- (list (frob (pop final-args) debug-vars)))))
- (t
- (push (frob final-arg debug-vars) res)))))
- (setf (debug-function-%lambda-list debug-function)
- (nreverse res)))
- ;; All required args, so return them in a list.
- (dolist (v (sb!c::lambda-vars ir1-lambda)
- (setf (debug-function-%lambda-list debug-function)
- (nreverse res)))
- (push (frob v debug-vars) res)))))
- ;; Everything's unparsed and cached, so return it.
- lambda-list)))
-
-;;; If this has to compute the lambda list, it caches it in debug-function.