Changeset 14131

Timestamp:

08/21/12 14:00:13 (8 years ago)

Author:

ehuelsmann

Message:

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 ...))

Location:

trunk/abcl/src/org/armedbear/lisp

Files:

• ArgumentListProcessor.java (modified) (6 diffs)
• Closure.java (modified) (1 diff)
• Primitives.java (modified) (5 diffs)
• SpecialOperators.java (modified) (1 diff)

trunk/abcl/src/org/armedbear/lisp/ArgumentListProcessor.java

@@ -39 +39 @@
 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.
@@ -163 +171 @@
    *    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;
     
@@ -177 +186 @@
         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)
           {
@@ -182 +202 @@
             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)
                   {
@@ -201 +227 @@
                           "&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;
@@ -229 +257 @@
                 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();

trunk/abcl/src/org/armedbear/lisp/Closure.java

@@ -96 +96 @@
     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);
   }

trunk/abcl/src/org/armedbear/lisp/Primitives.java

@@ -1880 +1880 @@
 
         {
+            /* 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());
@@ -1885 +1891 @@
             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);
@@ -1900 +1906 @@
             else
                 symbol.setSymbolFunction(macroObject);
-            macroObject.setLambdaList(lambdaList);
-            thread._values = null;
+            macroObject.setLambdaList(args.cadr());
+            LispThread.currentThread()._values = null;
             return symbol;
         }
@@ -3657 +3663 @@
 
         {
+            /* 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();
@@ -3663 +3675 @@
                 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);

trunk/abcl/src/org/armedbear/lisp/SpecialOperators.java

@@ -499 +499 @@
                     return type_error(name, FUNCTION_NAME);
                 }
+                if (car == Symbol.MACRO_FUNCTION)
+                    return new Closure(arg, env);
             }
             return error(new UndefinedFunction(list(Keyword.NAME, arg)));