org.armedbear.lisp.Closure Maven / Gradle / Ivy
Go to download
Show more of this group Show more artifacts with this name
Show all versions of abcl Show documentation
Show all versions of abcl Show documentation
Common Lisp implementation running on the JVM
/*
* Closure.java
*
* Copyright (C) 2002-2008 Peter Graves
* Copyright (C) 2008 Ville Voutilainen
* $Id: Closure.java 13461 2011-08-11 17:01:41Z ehuelsmann $
*
* This program is free software; you can redistribute it and/or
* modify it under the terms of the GNU General Public License
* as published by the Free Software Foundation; either version 2
* of the License, or (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* As a special exception, the copyright holders of this library give you
* permission to link this library with independent modules to produce an
* executable, regardless of the license terms of these independent
* modules, and to copy and distribute the resulting executable under
* terms of your choice, provided that you also meet, for each linked
* independent module, the terms and conditions of the license of that
* module. An independent module is a module which is not derived from
* or based on this library. If you modify this library, you may extend
* this exception to your version of the library, but you are not
* obligated to do so. If you do not wish to do so, delete this
* exception statement from your version.
*/
package org.armedbear.lisp;
import static org.armedbear.lisp.Lisp.*;
import java.util.ArrayList;
public class Closure extends Function
{
// Parameter types.
public static final int REQUIRED = 0;
public static final int OPTIONAL = 1;
public static final int KEYWORD = 2;
public static final int REST = 3;
public static final int AUX = 4;
// States.
private static final int STATE_REQUIRED = 0;
private static final int STATE_OPTIONAL = 1;
private static final int STATE_KEYWORD = 2;
private static final int STATE_REST = 3;
private static final int STATE_AUX = 4;
private Parameter[] requiredParameters = new Parameter[0];
private Parameter[] optionalParameters = requiredParameters;
private Parameter[] keywordParameters = requiredParameters;
private Parameter[] auxVars = requiredParameters;
private final LispObject body;
private final LispObject executionBody;
private final Environment environment;
private final boolean andKey;
private final boolean allowOtherKeys;
private Symbol restVar;
private Symbol envVar;
private int arity;
private int minArgs;
private int maxArgs;
private Symbol[] variables = new Symbol[0];
private LispObject specials = NIL;
private boolean bindInitForms;
/** Construct a closure object with a lambda-list described
* by these parameters.
*
*
* @param required Required parameters or an empty array for none
* @param optional Optional parameters or an empty array for none
* @param keyword Keyword parameters or an empty array for none
* @param keys NIL if the lambda-list doesn't contain &key, T otherwise
* @param rest the &rest parameter, or NIL if none
* @param moreKeys NIL if &allow-other-keys not present, T otherwise
*/
public Closure(Parameter[] required,
Parameter[] optional,
Parameter[] keyword,
Symbol keys, Symbol rest, Symbol moreKeys) {
minArgs = required.length;
maxArgs = (rest == NIL && moreKeys == NIL)
? minArgs + optional.length + 2*keyword.length : -1;
arity = (rest == NIL && moreKeys == NIL && keys == NIL
&& optional.length == 0)
? maxArgs : -1;
requiredParameters = required;
optionalParameters = optional;
keywordParameters = keyword;
if (rest != NIL)
restVar = rest;
andKey = keys != NIL;
allowOtherKeys = moreKeys != NIL;
variables = processVariables();
bindInitForms = false;
// stuff we don't need: we're a compiled function
body = null;
executionBody = null;
environment = null;
}
public Closure(LispObject lambdaExpression, Environment env)
{
this(null, lambdaExpression, env);
}
public Closure(final LispObject name, final LispObject lambdaExpression,
final Environment env)
{
super(name, lambdaExpression.cadr());
final LispObject lambdaList = lambdaExpression.cadr();
setLambdaList(lambdaList);
if (!(lambdaList == NIL || lambdaList instanceof Cons))
error(new ProgramError("The lambda list " + lambdaList.princToString() +
" is invalid."));
boolean _andKey = false;
boolean _allowOtherKeys = false;
if (lambdaList instanceof Cons)
{
final int length = lambdaList.length();
ArrayList required = null;
ArrayList optional = null;
ArrayList keywords = null;
ArrayList aux = null;
int state = STATE_REQUIRED;
LispObject remaining = lambdaList;
while (remaining != NIL)
{
LispObject obj = remaining.car();
if (obj instanceof Symbol)
{
if (state == STATE_AUX)
{
if (aux == null)
aux = new ArrayList();
aux.add(new Parameter((Symbol)obj, NIL, AUX));
}
else if (obj == Symbol.AND_OPTIONAL)
{
state = STATE_OPTIONAL;
arity = -1;
}
else if (obj == Symbol.AND_REST || obj == Symbol.AND_BODY)
{
if (_andKey)
{
error(new ProgramError(
"&REST/&BODY must precede &KEY."));
}
state = STATE_REST;
arity = -1;
maxArgs = -1;
remaining = remaining.cdr();
if (remaining == NIL)
{
error(new ProgramError(
"&REST/&BODY must be followed by a variable."));
}
if (restVar != null)
{
error(new ProgramError(
"&REST/&BODY may occur only once."));
}
final LispObject remainingcar = remaining.car();
if (remainingcar instanceof Symbol)
{
restVar = (Symbol) remainingcar;
}
else
{
error(new ProgramError(
"&REST/&BODY must be followed by a variable."));
}
}
else if (obj == Symbol.AND_ENVIRONMENT)
{
remaining = remaining.cdr();
envVar = (Symbol) remaining.car();
arity = -1; // FIXME
}
else if (obj == Symbol.AND_KEY)
{
state = STATE_KEYWORD;
_andKey = true;
arity = -1;
}
else if (obj == Symbol.AND_ALLOW_OTHER_KEYS)
{
_allowOtherKeys = true;
maxArgs = -1;
}
else if (obj == Symbol.AND_AUX)
{
// All remaining specifiers are aux variable specifiers.
state = STATE_AUX;
arity = -1; // FIXME
}
else
{
if (state == STATE_OPTIONAL)
{
if (optional == null)
optional = new ArrayList();
optional.add(new Parameter((Symbol)obj, NIL, OPTIONAL));
if (maxArgs >= 0)
++maxArgs;
}
else if (state == STATE_KEYWORD)
{
if (keywords == null)
keywords = new ArrayList();
keywords.add(new Parameter((Symbol)obj, NIL, KEYWORD));
if (maxArgs >= 0)
maxArgs += 2;
}
else
{
if (state != STATE_REQUIRED)
{
error(new ProgramError(
"required parameters cannot appear after &REST/&BODY."));
}
if (required == null)
required = new ArrayList();
required.add(new Parameter((Symbol)obj));
if (maxArgs >= 0)
++maxArgs;
}
}
}
else if (obj instanceof Cons)
{
if (state == STATE_AUX)
{
Symbol sym = checkSymbol(obj.car());
LispObject initForm = obj.cadr();
Debug.assertTrue(initForm != null);
if (aux == null)
aux = new ArrayList();
aux.add(new Parameter(sym, initForm, AUX));
}
else if (state == STATE_OPTIONAL)
{
Symbol sym = checkSymbol(obj.car());
LispObject initForm = obj.cadr();
LispObject svar = obj.cdr().cdr().car();
if (optional == null)
optional = new ArrayList();
optional.add(new Parameter(sym, initForm, svar, OPTIONAL));
if (maxArgs >= 0)
++maxArgs;
}
else if (state == STATE_KEYWORD)
{
Symbol keyword;
Symbol var;
LispObject initForm = NIL;
LispObject svar = NIL;
LispObject first = obj.car();
if (first instanceof Cons)
{
keyword = checkSymbol(first.car());
var = checkSymbol(first.cadr());
}
else
{
var = checkSymbol(first);
keyword =
PACKAGE_KEYWORD.intern(var.name);
}
obj = obj.cdr();
if (obj != NIL)
{
initForm = obj.car();
obj = obj.cdr();
if (obj != NIL)
svar = obj.car();
}
if (keywords == null)
keywords = new ArrayList();
keywords.add(new Parameter(keyword, var, initForm, svar));
if (maxArgs >= 0)
maxArgs += 2;
}
else
invalidParameter(obj);
}
else
invalidParameter(obj);
remaining = remaining.cdr();
}
if (arity == 0)
arity = length;
if (required != null)
{
requiredParameters = new Parameter[required.size()];
required.toArray(requiredParameters);
}
if (optional != null)
{
optionalParameters = new Parameter[optional.size()];
optional.toArray(optionalParameters);
}
if (keywords != null)
{
keywordParameters = new Parameter[keywords.size()];
keywords.toArray(keywordParameters);
}
if (aux != null)
{
auxVars = new Parameter[aux.size()];
aux.toArray(auxVars);
}
}
else
{
// Lambda list is empty.
Debug.assertTrue(lambdaList == NIL);
arity = 0;
maxArgs = 0;
}
this.body = lambdaExpression.cddr();
LispObject bodyAndDecls = parseBody(this.body, false);
this.executionBody = bodyAndDecls.car();
this.specials = parseSpecials(bodyAndDecls.NTH(1));
this.environment = env;
this.andKey = _andKey;
this.allowOtherKeys = _allowOtherKeys;
minArgs = requiredParameters.length;
if (arity >= 0)
Debug.assertTrue(arity == minArgs);
variables = processVariables();
}
private final void processParameters(ArrayList vars,
final Parameter[] parameters)
{
for (Parameter parameter : parameters)
{
vars.add(parameter.var);
if (parameter.svar != NIL)
vars.add((Symbol)parameter.svar);
if (!bindInitForms)
if (!parameter.initForm.constantp())
bindInitForms = true;
}
}
// Also sets bindInitForms.
private final Symbol[] processVariables()
{
ArrayList vars = new ArrayList();
for (Parameter parameter : requiredParameters)
vars.add(parameter.var);
processParameters(vars, optionalParameters);
if (restVar != null)
{
vars.add(restVar);
}
processParameters(vars, keywordParameters);
Symbol[] array = new Symbol[vars.size()];
vars.toArray(array);
return array;
}
private static final void invalidParameter(LispObject obj)
{
error(new ProgramError(obj.princToString() +
" may not be used as a variable in a lambda list."));
}
@Override
public LispObject typep(LispObject typeSpecifier)
{
if (typeSpecifier == Symbol.COMPILED_FUNCTION)
return NIL;
return super.typep(typeSpecifier);
}
public final LispObject getVariableList()
{
LispObject result = NIL;
for (int i = variables.length; i-- > 0;)
result = new Cons(variables[i], result);
return result;
}
// Returns body as a list.
public final LispObject getBody()
{
return body;
}
public final Environment getEnvironment()
{
return environment;
}
@Override
public LispObject execute()
{
if (arity == 0)
{
return progn(executionBody, environment,
LispThread.currentThread());
}
else
return execute(new LispObject[0]);
}
private final LispObject bindParametersAndExecute(LispObject... objects)
{
final LispThread thread = LispThread.currentThread();
final SpecialBindingsMark mark = thread.markSpecialBindings();
Environment ext = new Environment(environment);
bindRequiredParameters(ext, thread, objects);
if (arity != minArgs)
{
bindParameterDefaults(optionalParameters, ext, thread);
if (restVar != null)
bindArg(specials, restVar, NIL, ext, thread);
bindParameterDefaults(keywordParameters, ext, thread);
}
bindAuxVars(ext, thread);
declareFreeSpecials(ext);
try
{
return progn(executionBody, ext, thread);
}
finally
{
thread.resetSpecialBindings(mark);
}
}
private final void bindRequiredParameters(Environment ext,
LispThread thread,
LispObject[] objects)
{
// &whole and &environment before anything
if (envVar != null)
bindArg(specials, envVar, environment, ext, thread);
for (int i = 0; i < objects.length; ++i)
{
bindArg(specials, requiredParameters[i].var, objects[i], ext, thread);
}
}
public final LispObject invokeArrayExecute(LispObject... objects)
{
return execute(objects);
}
@Override
public LispObject execute(LispObject arg)
{
if (minArgs == 1)
{
return bindParametersAndExecute(arg);
}
else
{
return invokeArrayExecute(arg);
}
}
@Override
public LispObject execute(LispObject first, LispObject second)
{
if (minArgs == 2)
{
return bindParametersAndExecute(first, second);
}
else
{
return invokeArrayExecute(first, second);
}
}
@Override
public LispObject execute(LispObject first, LispObject second,
LispObject third)
{
if (minArgs == 3)
{
return bindParametersAndExecute(first, second, third);
}
else
{
return invokeArrayExecute(first, second, third);
}
}
@Override
public LispObject execute(LispObject first, LispObject second,
LispObject third, LispObject fourth)
{
if (minArgs == 4)
{
return bindParametersAndExecute(first, second, third, fourth);
}
else
{
return invokeArrayExecute(first, second, third, fourth);
}
}
@Override
public LispObject execute(LispObject first, LispObject second,
LispObject third, LispObject fourth,
LispObject fifth)
{
if (minArgs == 5)
{
return bindParametersAndExecute(first, second, third, fourth,
fifth);
}
else
{
return invokeArrayExecute(first, second, third, fourth, fifth);
}
}
@Override
public LispObject execute(LispObject first, LispObject second,
LispObject third, LispObject fourth,
LispObject fifth, LispObject sixth)
{
if (minArgs == 6)
{
return bindParametersAndExecute(first, second, third, fourth,
fifth, sixth);
}
else
{
return invokeArrayExecute(first, second, third, fourth, fifth,
sixth);
}
}
@Override
public LispObject execute(LispObject first, LispObject second,
LispObject third, LispObject fourth,
LispObject fifth, LispObject sixth,
LispObject seventh)
{
if (minArgs == 7)
{
return bindParametersAndExecute(first, second, third, fourth,
fifth, sixth, seventh);
}
else
{
return invokeArrayExecute(first, second, third, fourth, fifth,
sixth, seventh);
}
}
@Override
public LispObject execute(LispObject first, LispObject second,
LispObject third, LispObject fourth,
LispObject fifth, LispObject sixth,
LispObject seventh, LispObject eighth)
{
if (minArgs == 8)
{
return bindParametersAndExecute(first, second, third, fourth,
fifth, sixth, seventh, eighth);
}
else
{
return invokeArrayExecute(first, second, third, fourth, fifth,
sixth, seventh, eighth);
}
}
private final void declareFreeSpecials(Environment ext)
{
LispObject s = specials;
special:
while (s != NIL) {
Symbol special = (Symbol)s.car();
s = s.cdr();
for (Symbol var : variables)
if (special == var)
continue special;
for (Parameter parameter : auxVars)
if (special == parameter.var)
continue special;
ext.declareSpecial(special);
}
}
@Override
public LispObject execute(LispObject[] args)
{
final LispThread thread = LispThread.currentThread();
final SpecialBindingsMark mark = thread.markSpecialBindings();
Environment ext = new Environment(environment);
if (optionalParameters.length == 0 && keywordParameters.length == 0)
args = fastProcessArgs(args);
else
args = processArgs(args, thread);
Debug.assertTrue(args.length == variables.length);
if (envVar != null)
{
bindArg(specials, envVar, environment, ext, thread);
}
for (int i = 0; i < variables.length; i++)
{
Symbol sym = variables[i];
bindArg(specials, sym, args[i], ext, thread);
}
bindAuxVars(ext, thread);
declareFreeSpecials(ext);
try
{
return progn(executionBody, ext, thread);
}
finally
{
thread.resetSpecialBindings(mark);
}
}
protected final LispObject[] processArgs(LispObject[] args, LispThread thread)
{
if (optionalParameters.length == 0 && keywordParameters.length == 0)
return fastProcessArgs(args);
final int argsLength = args.length;
if (arity >= 0)
{
// Fixed arity.
if (argsLength != arity)
error(new WrongNumberOfArgumentsException(this, arity));
return args;
}
// Not fixed arity.
if (argsLength < minArgs)
error(new WrongNumberOfArgumentsException(this, minArgs, -1));
final LispObject[] array = new LispObject[variables.length];
int index = 0;
// 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 {
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));
}
}
}
finally {
thread.resetSpecialBindings(mark);
}
return array;
}
// No optional or keyword parameters.
protected final LispObject[] fastProcessArgs(LispObject[] args)
{
final int argsLength = args.length;
if (arity >= 0)
{
// Fixed arity.
if (argsLength != arity)
error(new WrongNumberOfArgumentsException(this, arity));
return args;
}
// Not fixed arity.
if (argsLength < minArgs)
error(new WrongNumberOfArgumentsException(this, minArgs, -1));
final LispObject[] array = new LispObject[variables.length];
int index = 0;
// Required parameters.
for (int i = 0; i < minArgs; i++)
{
array[index++] = args[i];
}
int argsUsed = minArgs;
// &rest parameter.
if (restVar != null)
{
LispObject rest = NIL;
for (int j = argsLength; j-- > argsUsed;)
rest = new Cons(args[j], rest);
array[index++] = rest;
}
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;
}
private final void bindParameterDefaults(Parameter[] parameters,
Environment env,
LispThread thread)
{
for (Parameter parameter : parameters)
{
LispObject value;
if (parameter.initVal != null)
value = parameter.initVal;
else
value = eval(parameter.initForm, env, thread);
bindArg(specials, parameter.var, value, env, thread);
if (parameter.svar != NIL)
bindArg(specials, (Symbol)parameter.svar, NIL, env, thread);
}
}
private final void bindAuxVars(Environment env, LispThread thread)
{
// Aux variable processing is analogous to LET* processing.
for (Parameter parameter : auxVars)
{
Symbol sym = parameter.var;
LispObject value;
if (parameter.initVal != null)
value = parameter.initVal;
else
value = eval(parameter.initForm, env, thread);
bindArg(specials, sym, value, env, thread);
}
}
public static class Parameter
{
final Symbol var;
final LispObject initForm;
final LispObject initVal;
final LispObject svar;
private final int type;
final Symbol keyword;
public Parameter(Symbol var)
{
this.var = var;
this.initForm = null;
this.initVal = null;
this.svar = NIL;
this.type = REQUIRED;
this.keyword = null;
}
public Parameter(Symbol var, LispObject initForm, int type)
{
this.var = var;
this.initForm = initForm;
this.initVal = processInitForm(initForm);
this.svar = NIL;
this.type = type;
keyword =
type == KEYWORD ? PACKAGE_KEYWORD.intern(var.name) : null;
}
public Parameter(Symbol var, LispObject initForm, LispObject svar,
int type)
{
this.var = var;
this.initForm = initForm;
this.initVal = processInitForm(initForm);
this.svar = (svar != NIL) ? checkSymbol(svar) : NIL;
this.type = type;
keyword =
type == KEYWORD ? PACKAGE_KEYWORD.intern(var.name) : null;
}
public Parameter(Symbol keyword, Symbol var, LispObject initForm,
LispObject svar)
{
this.var = var;
this.initForm = initForm;
this.initVal = processInitForm(initForm);
this.svar = (svar != NIL) ? checkSymbol(svar) : NIL;
type = KEYWORD;
this.keyword = keyword;
}
@Override
public String toString()
{
if (type == REQUIRED)
return var.toString();
StringBuffer sb = new StringBuffer();
if (keyword != null)
{
sb.append(keyword);
sb.append(' ');
}
sb.append(var.toString());
sb.append(' ');
sb.append(initForm);
sb.append(' ');
sb.append(type);
return sb.toString();
}
private static final LispObject processInitForm(LispObject initForm)
{
if (initForm.constantp())
{
if (initForm instanceof Symbol)
return initForm.getSymbolValue();
if (initForm instanceof Cons)
{
Debug.assertTrue(initForm.car() == Symbol.QUOTE);
return initForm.cadr();
}
return initForm;
}
return null;
}
}
// ### 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();
}
};
}