[armedbear-cvs] r14131 - trunk/abcl/src/org/armedbear/lisp
ehuelsmann at common-lisp.net
ehuelsmann at common-lisp.net
Tue Aug 21 14:00:21 UTC 2012
Author: ehuelsmann
Date: Tue Aug 21 07:00:13 2012
New Revision: 14131
Log:
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 ...))
Modified:
trunk/abcl/src/org/armedbear/lisp/ArgumentListProcessor.java
trunk/abcl/src/org/armedbear/lisp/Closure.java
trunk/abcl/src/org/armedbear/lisp/Primitives.java
trunk/abcl/src/org/armedbear/lisp/SpecialOperators.java
Modified: trunk/abcl/src/org/armedbear/lisp/ArgumentListProcessor.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/ArgumentListProcessor.java Mon Aug 20 11:39:26 2012 (r14130)
+++ trunk/abcl/src/org/armedbear/lisp/ArgumentListProcessor.java Tue Aug 21 07:00:13 2012 (r14131)
@@ -38,9 +38,17 @@
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 @@
* @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 @@
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 @@
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 @@
}
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));
Modified: trunk/abcl/src/org/armedbear/lisp/Closure.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Closure.java Mon Aug 20 11:39:26 2012 (r14130)
+++ trunk/abcl/src/org/armedbear/lisp/Closure.java Tue Aug 21 07:00:13 2012 (r14131)
@@ -95,7 +95,16 @@
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);
}
Modified: trunk/abcl/src/org/armedbear/lisp/Primitives.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Primitives.java Mon Aug 20 11:39:26 2012 (r14130)
+++ trunk/abcl/src/org/armedbear/lisp/Primitives.java Tue Aug 21 07:00:13 2012 (r14131)
@@ -1879,12 +1879,18 @@
public LispObject execute(LispObject args, Environment env)
{
+ /* Create an expansion function
+ * `(lambda (,formArg ,envArg)
+ * (apply (function (macro-function ,lambdaList
+ * (block ,symbol , at 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 @@
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 LispObject execute(LispObject definition)
{
+ /* Create an expansion function
+ * `(lambda (,formArg ,envArg)
+ * (apply (function (macro-function ,lambdaList
+ * (block ,symbol , at 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.
Modified: trunk/abcl/src/org/armedbear/lisp/SpecialOperators.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/SpecialOperators.java Mon Aug 20 11:39:26 2012 (r14130)
+++ trunk/abcl/src/org/armedbear/lisp/SpecialOperators.java Tue Aug 21 07:00:13 2012 (r14131)
@@ -498,6 +498,8 @@
}
return type_error(name, FUNCTION_NAME);
}
+ if (car == Symbol.MACRO_FUNCTION)
+ return new Closure(arg, env);
}
return error(new UndefinedFunction(list(Keyword.NAME, arg)));
}
More information about the armedbear-cvs
mailing list