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

Close #219: lambda list keyword checking too lenient for ANSI.

Note: This introduces a new argument to the FUNCTION special form
  (LAMBDA and NAMED-LAMBDA were already supported)
  (FUNCTION (MACRO-FUNCTION ...))
parent 4f75c321
......@@ -38,9 +38,17 @@ import java.util.List;
import java.util.ArrayList;
import static org.armedbear.lisp.Lisp.*;
/** A class to parse a lambda list and match function call arguments with it
/** A class to parse a lambda list and match function call arguments with it.
*
* The lambda list may either be of type ORDINARY or MACRO lambda list.
* All other lambda lists are parsed elsewhere in our code base.
*/
public class ArgumentListProcessor {
public enum LambdaListType {
ORDINARY,
MACRO
}
// States.
private static final int STATE_REQUIRED = 0;
......@@ -162,7 +170,8 @@ public class ArgumentListProcessor {
* @param specials A list of symbols specifying which variables to
* bind as specials during initform evaluation
*/
public ArgumentListProcessor(Operator fun, LispObject lambdaList, LispObject specials) {
public ArgumentListProcessor(Operator fun, LispObject lambdaList,
LispObject specials, LambdaListType type) {
function = fun;
boolean _andKey = false;
......@@ -176,11 +185,28 @@ public class ArgumentListProcessor {
ArrayList<Param> aux = null;
int state = STATE_REQUIRED;
LispObject remaining = lambdaList;
if (remaining.car() == Symbol.AND_WHOLE) {
if (type == LambdaListType.ORDINARY) {
error(new ProgramError("&WHOLE not allowed in ordinary lambda lists."));
} else {
// skip the &WHOLE <var> part of the lambda list
remaining = remaining.cdr().cdr();
}
}
while (remaining != NIL)
{
LispObject obj = remaining.car();
if (obj instanceof Symbol)
{
if (obj == Symbol.AND_WHOLE) {
if (type == LambdaListType.ORDINARY)
error(new ProgramError("&WHOLE not allowed in ordinary lambda lists."));
else
error(new ProgramError("&WHOLE must appear first in macro lambda list."));
}
if (state == STATE_AUX)
{
if (aux == null)
......@@ -200,6 +226,8 @@ public class ArgumentListProcessor {
error(new ProgramError(
"&REST/&BODY must precede &KEY."));
}
if (type == LambdaListType.ORDINARY && obj == Symbol.AND_BODY)
error(new ProgramError("&BODY not allowed in ordinary lambda lists."));
state = STATE_REST;
arity = -1;
maxArgs = -1;
......@@ -228,6 +256,8 @@ public class ArgumentListProcessor {
}
else if (obj == Symbol.AND_ENVIRONMENT)
{
if (type == LambdaListType.ORDINARY)
error(new ProgramError("&ENVIRONMENT not allowed in ordinary lambda lists."));
remaining = remaining.cdr();
envVar = (Symbol) remaining.car();
envParam = new EnvironmentParam(envVar, isSpecial(envVar, specials));
......
......@@ -95,7 +95,16 @@ public class Closure extends Function
this.environment = env;
arglist = new ArgumentListProcessor(this, lambdaList, specials);
/* In the bootstrapping process, functions with MACRO LAMBDA LIST
* lambda list types are being generated using the MACRO_FUNCTION instead
* of the LAMBDA or NAMED_LAMBDA keys.
*
* Use that to perform argument list lambda list keyword checking.
*/
arglist = new ArgumentListProcessor(this, lambdaList, specials,
(lambdaExpression.car() == Symbol.MACRO_FUNCTION) ?
ArgumentListProcessor.LambdaListType.MACRO
: ArgumentListProcessor.LambdaListType.ORDINARY);
freeSpecials = arglist.freeSpecials(specials);
}
......
......@@ -1879,12 +1879,18 @@ public final class Primitives {
public LispObject execute(LispObject args, Environment env)
{
/* Create an expansion function
* `(lambda (,formArg ,envArg)
* (apply (function (macro-function ,lambdaList
* (block ,symbol ,@body)))
* (cdr ,formArg)))
*/
Symbol symbol = checkSymbol(args.car());
LispObject lambdaList = checkList(args.cadr());
LispObject body = args.cddr();
LispObject block = new Cons(Symbol.BLOCK, new Cons(symbol, body));
LispObject toBeApplied =
list(Symbol.FUNCTION, list(Symbol.LAMBDA, lambdaList, block));
list(Symbol.FUNCTION, list(Symbol.MACRO_FUNCTION, lambdaList, block));
final LispThread thread = LispThread.currentThread();
LispObject formArg = gensym("FORM-", thread);
LispObject envArg = gensym("ENV-", thread); // Ignored.
......@@ -1899,8 +1905,8 @@ public final class Primitives {
put(symbol, Symbol.MACROEXPAND_MACRO, macroObject);
else
symbol.setSymbolFunction(macroObject);
macroObject.setLambdaList(lambdaList);
thread._values = null;
macroObject.setLambdaList(args.cadr());
LispThread.currentThread()._values = null;
return symbol;
}
};
......@@ -3656,13 +3662,19 @@ public final class Primitives {
public LispObject execute(LispObject definition)
{
/* Create an expansion function
* `(lambda (,formArg ,envArg)
* (apply (function (macro-function ,lambdaList
* (block ,symbol ,@body)))
* (cdr ,formArg)))
*/
Symbol symbol = checkSymbol(definition.car());
LispObject lambdaList = definition.cadr();
LispObject body = definition.cddr();
LispObject block =
new Cons(Symbol.BLOCK, new Cons(symbol, body));
LispObject toBeApplied =
list(Symbol.LAMBDA, lambdaList, block);
list(Symbol.FUNCTION, list(Symbol.MACRO_FUNCTION, lambdaList, block));
final LispThread thread = LispThread.currentThread();
LispObject formArg = gensym("WHOLE-", thread);
LispObject envArg = gensym("ENVIRONMENT-", thread); // Ignored.
......
......@@ -498,6 +498,8 @@ for (Cons x : nonSequentialVars)
}
return type_error(name, FUNCTION_NAME);
}
if (car == Symbol.MACRO_FUNCTION)
return new Closure(arg, env);
}
return error(new UndefinedFunction(list(Keyword.NAME, arg)));
}
......
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