Commit 4f75c321 authored by ehuelsmann@1c010e3e-69d0-11dd-93a8-456734b0d56f's avatar ehuelsmann@1c010e3e-69d0-11dd-93a8-456734b0d56f
Browse files

Replace a Java primitive LAMBDA-LIST-NAMES with a lisp function.

Make the returned REQUIRED value from PARSE-LAMBDA-LIST match is docstring.
parent 0c672d93
......@@ -220,16 +220,4 @@ public class Closure extends Function
{
return arglist.match(args, environment, environment, thread);
}
// ### lambda-list-names
private static final Primitive LAMBDA_LIST_NAMES =
new Primitive("lambda-list-names", PACKAGE_SYS, true)
{
@Override
public LispObject execute(LispObject arg)
{
Closure closure = new Closure(list(Symbol.LAMBDA, arg, NIL), new Environment());
return closure.getVariableList();
}
};
}
......@@ -107,7 +107,7 @@ where each of the vars returned is a list with these elements:
(&environment (setf state :env))
(t
(case state
(:req (push arg req))
(:req (push (list arg) req))
(:rest (setf rest (list arg)
state :none))
(:env (setf env (list arg)
......@@ -176,7 +176,8 @@ where each of the vars returned is a list with these elements:
(let (req-bindings temp-bindings bindings ignorables)
;;Required arguments.
(setf req-bindings
(loop :for var :in req :collect `(,var ,(pop-required-argument))))
(loop :for (var) :in req
:collect `(,var ,(pop-required-argument))))
;;Optional arguments.
(when opt
......@@ -758,6 +759,17 @@ where each of the vars returned is a list with these elements:
(values (nreverse other-decls)
(nreverse specific-decls))))
(defun lambda-list-names (lambda-list)
"Returns a list of variable names extracted from `lambda-list'."
(multiple-value-bind
(req opt key key-p rest allow-key-p aux whole env)
(parse-lambda-list lambda-list)
(declare (ignore key-p allow-key-p))
(mapcan (lambda (x)
(mapcar #'first x))
(list req opt key aux rest whole env))))
(defun rewrite-aux-vars (form)
(let* ((lambda-list (cadr form))
(aux-p (memq '&AUX lambda-list))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment