[armedbear-cvs] r13826 - trunk/abcl/src/org/armedbear/lisp
ehuelsmann at common-lisp.net
ehuelsmann at common-lisp.net
Sun Jan 29 22:09:01 UTC 2012
Author: ehuelsmann
Date: Sun Jan 29 14:09:01 2012
New Revision: 13826
Log:
Implement processArgs() using the ArgumentListProcessor.
Modified:
trunk/abcl/src/org/armedbear/lisp/Closure.java
Modified: trunk/abcl/src/org/armedbear/lisp/Closure.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Closure.java Sun Jan 29 13:55:34 2012 (r13825)
+++ trunk/abcl/src/org/armedbear/lisp/Closure.java Sun Jan 29 14:09:01 2012 (r13826)
@@ -647,276 +647,9 @@
}
}
-
- private LispObject[] _processArgs(LispObject[] args, LispThread thread,
- Environment ext) {
- final LispObject[] array = new LispObject[variables.length];
- int index = 0;
-
- int argsLength = args.length;
-
- if (bindInitForms)
- if (envVar != null)
- bindArg(specials, envVar, environment, ext, thread);
- // Required parameters.
- for (int i = 0; i < minArgs; i++)
- {
- if (bindInitForms)
- bindArg(specials, requiredParameters[i].var, args[i], ext, thread);
- array[index++] = args[i];
- }
- int i = minArgs;
- int argsUsed = minArgs;
- // Optional parameters.
- for (Parameter parameter : optionalParameters)
- {
- if (i < argsLength)
- {
- if (bindInitForms)
- bindArg(specials, parameter.var, args[i], ext, thread);
- array[index++] = args[i];
- ++argsUsed;
- if (parameter.svar != NIL)
- {
- if (bindInitForms)
- bindArg(specials, (Symbol)parameter.svar, T, ext, thread);
- array[index++] = T;
- }
- }
- else
- {
- // We've run out of arguments.
- LispObject value;
- if (parameter.initVal != null)
- value = parameter.initVal;
- else
- value = eval(parameter.initForm, ext, thread);
- if (bindInitForms)
- bindArg(specials, parameter.var, value, ext, thread);
- array[index++] = value;
- if (parameter.svar != NIL)
- {
- if (bindInitForms)
- bindArg(specials, (Symbol)parameter.svar, NIL, ext, thread);
- array[index++] = NIL;
- }
- }
- ++i;
- }
- // &rest parameter.
- if (restVar != null)
- {
- LispObject rest = NIL;
- for (int j = argsLength; j-- > argsUsed;)
- rest = new Cons(args[j], rest);
- if (bindInitForms)
- bindArg(specials, restVar, rest, ext, thread);
- array[index++] = rest;
- }
- // Keyword parameters.
- if (keywordParameters.length > 0)
- {
- int argsLeft = argsLength - argsUsed;
- if (argsLeft == 0)
- {
- // No keyword arguments were supplied.
- // Bind all keyword parameters to their defaults.
- for (int k = 0; k < keywordParameters.length; k++)
- {
- Parameter parameter = keywordParameters[k];
- LispObject value;
- if (parameter.initVal != null)
- value = parameter.initVal;
- else
- value = eval(parameter.initForm, ext, thread);
- if (bindInitForms)
- bindArg(specials, parameter.var, value, ext, thread);
- array[index++] = value;
- if (parameter.svar != NIL)
- {
- if (bindInitForms)
- bindArg(specials, (Symbol)parameter.svar, NIL, ext, thread);
- array[index++] = NIL;
- }
- }
- }
- else
- {
- if ((argsLeft % 2) != 0)
- error(new ProgramError("Odd number of keyword arguments."));
- LispObject allowOtherKeysValue = null;
- for (Parameter parameter : keywordParameters)
- {
- Symbol keyword = parameter.keyword;
- LispObject value = null;
- boolean unbound = true;
- for (int j = argsUsed; j < argsLength; j += 2)
- {
- if (args[j] == keyword)
- {
- if (bindInitForms)
- bindArg(specials, parameter.var, args[j+1], ext, thread);
- value = array[index++] = args[j+1];
- if (parameter.svar != NIL)
- {
- if (bindInitForms)
- bindArg(specials,(Symbol)parameter.svar, T, ext, thread);
- array[index++] = T;
- }
- args[j] = null;
- args[j+1] = null;
- unbound = false;
- break;
- }
- }
- if (unbound)
- {
- if (parameter.initVal != null)
- value = parameter.initVal;
- else
- value = eval(parameter.initForm, ext, thread);
- if (bindInitForms)
- bindArg(specials, parameter.var, value, ext, thread);
- array[index++] = value;
- if (parameter.svar != NIL)
- {
- if (bindInitForms)
- bindArg(specials, (Symbol)parameter.svar, NIL, ext, thread);
- array[index++] = NIL;
- }
- }
- if (keyword == Keyword.ALLOW_OTHER_KEYS)
- {
- if (allowOtherKeysValue == null)
- allowOtherKeysValue = value;
- }
- }
- if (!allowOtherKeys)
- {
- if (allowOtherKeysValue == null || allowOtherKeysValue == NIL)
- {
- LispObject unrecognizedKeyword = null;
- for (int j = argsUsed; j < argsLength; j += 2)
- {
- LispObject keyword = args[j];
- if (keyword == null)
- continue;
- if (keyword == Keyword.ALLOW_OTHER_KEYS)
- {
- if (allowOtherKeysValue == null)
- {
- allowOtherKeysValue = args[j+1];
- if (allowOtherKeysValue != NIL)
- break;
- }
- continue;
- }
- // Unused keyword argument.
- boolean ok = false;
- for (Parameter parameter : keywordParameters)
- {
- if (parameter.keyword == keyword)
- {
- // Found it!
- ok = true;
- break;
- }
- }
- if (ok)
- continue;
- // Unrecognized keyword argument.
- if (unrecognizedKeyword == null)
- unrecognizedKeyword = keyword;
- }
- if (unrecognizedKeyword != null)
- {
- if (!allowOtherKeys &&
- (allowOtherKeysValue == null || allowOtherKeysValue == NIL))
- error(new ProgramError("Unrecognized keyword argument " +
- unrecognizedKeyword.printObject()));
- }
- }
- }
- }
- }
- else if (argsUsed < argsLength)
- {
- // No keyword parameters.
- if (argsUsed + 2 <= argsLength)
- {
- // Check for :ALLOW-OTHER-KEYS.
- LispObject allowOtherKeysValue = NIL;
- int n = argsUsed;
- while (n < argsLength)
- {
- LispObject keyword = args[n];
- if (keyword == Keyword.ALLOW_OTHER_KEYS)
- {
- allowOtherKeysValue = args[n+1];
- break;
- }
- n += 2;
- }
- if (allowOtherKeys || allowOtherKeysValue != NIL)
- {
- // Skip keyword/value pairs.
- while (argsUsed + 2 <= argsLength)
- argsUsed += 2;
- }
- else if (andKey)
- {
- LispObject keyword = args[argsUsed];
- if (keyword == Keyword.ALLOW_OTHER_KEYS)
- {
- // Section 3.4.1.4: "Note that if &KEY is present, a
- // keyword argument of :ALLOW-OTHER-KEYS is always
- // permitted---regardless of whether the associated
- // value is true or false."
- argsUsed += 2;
- }
- }
- }
- if (argsUsed < argsLength)
- {
- if (restVar == null)
- error(new WrongNumberOfArgumentsException(this));
- }
- }
- return array;
- }
-
protected final LispObject[] processArgs(LispObject[] args, LispThread thread)
-
{
- if (optionalParameters.length == 0 && keywordParameters.length == 0)
- return fastProcessArgs(args);
- if (arity >= 0)
- {
- // Fixed arity.
- if (args.length != arity)
- error(new WrongNumberOfArgumentsException(this, arity));
- return args;
- }
- // Not fixed arity.
- if (args.length < minArgs)
- error(new WrongNumberOfArgumentsException(this, minArgs, -1));
-
- if (!bindInitForms)
- return _processArgs(args, thread, environment);
-
- // The bindings established here (if any) are lost when this function
- // returns. They are used only in the evaluation of initforms for
- // optional and keyword arguments.
- final SpecialBindingsMark mark = thread.markSpecialBindings();
- Environment ext = new Environment(environment);
- // Section 3.4.4: "...the &environment parameter is bound along with
- // &whole before any other variables in the lambda list..."
- try {
- return _processArgs(args, thread, ext);
- }
- finally {
- thread.resetSpecialBindings(mark);
- }
+ return arglist.match(args, environment, environment, thread);
}
// No optional or keyword parameters.
More information about the armedbear-cvs
mailing list