Changeset 11313


Ignore:
Timestamp:
09/13/08 10:03:24 (14 years ago)
Author:
ehuelsmann
Message:

Fix FLET.64 and LABELS.43: flet forms without function bindings can still have bodies which start with DECLARE forms.

Down to 56 failures.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/j/src/org/armedbear/lisp/SpecialOperators.java

    r11311 r11313  
    348348    LispObject defs = checkList(args.car());
    349349    final LispThread thread = LispThread.currentThread();
    350     LispObject result;
    351     if (defs != NIL)
    352       {
    353         SpecialBinding lastSpecialBinding = thread.lastSpecialBinding;
    354         Environment ext = new Environment(env);
    355         while (defs != NIL)
    356           {
    357             final LispObject def = checkList(defs.car());
    358             final LispObject name = def.car();
    359             final Symbol symbol;
    360             if (name instanceof Symbol)
    361               {
    362                 symbol = checkSymbol(name);
    363                 if (symbol.getSymbolFunction() instanceof SpecialOperator)
    364                   {
    365                     String message =
    366                       symbol.getName() + " is a special operator and may not be redefined";
    367                     return error(new ProgramError(message));
    368                   }
    369               }
    370             else if (isValidSetfFunctionName(name))
    371               symbol = checkSymbol(name.cadr());
    372             else
    373               return type_error(name, FUNCTION_NAME);
    374             LispObject rest = def.cdr();
    375             LispObject parameters = rest.car();
    376             LispObject body = rest.cdr();
    377             LispObject decls = NIL;
    378             while (body.car() instanceof Cons && body.car().car() == Symbol.DECLARE)
    379               {
    380                 decls = new Cons(body.car(), decls);
    381                 body = body.cdr();
    382               }
    383             body = new Cons(symbol, body);
    384             body = new Cons(Symbol.BLOCK, body);
    385             body = new Cons(body, NIL);
    386             while (decls != NIL)
    387               {
    388                 body = new Cons(decls.car(), body);
    389                 decls = decls.cdr();
    390               }
    391             LispObject lambda_expression =
    392               new Cons(Symbol.LAMBDA, new Cons(parameters, body));
    393             LispObject lambda_name =
    394               list2(recursive ? Symbol.LABELS : Symbol.FLET, name);
    395             Closure closure =
    396               new Closure(lambda_name, lambda_expression,
    397                           recursive ? ext : env);
    398             ext.addFunctionBinding(name, closure);
    399             defs = defs.cdr();
    400           }
    401         try
    402           {
    403             result = progn(args.cdr(), ext, thread);
    404           }
    405         finally
    406           {
    407             thread.lastSpecialBinding = lastSpecialBinding;
    408           }
    409       }
    410     else
    411       result = progn(args.cdr(), env, thread);
    412     return result;
     350    SpecialBinding lastSpecialBinding = thread.lastSpecialBinding;
     351    Environment ext = new Environment(env);
     352    while (defs != NIL)
     353      {
     354        final LispObject def = checkList(defs.car());
     355        final LispObject name = def.car();
     356        final Symbol symbol;
     357        if (name instanceof Symbol)
     358          {
     359            symbol = checkSymbol(name);
     360            if (symbol.getSymbolFunction() instanceof SpecialOperator)
     361              {
     362                String message =
     363                  symbol.getName() + " is a special operator and may not be redefined";
     364                return error(new ProgramError(message));
     365              }
     366          }
     367        else if (isValidSetfFunctionName(name))
     368          symbol = checkSymbol(name.cadr());
     369        else
     370          return type_error(name, FUNCTION_NAME);
     371        LispObject rest = def.cdr();
     372        LispObject parameters = rest.car();
     373        LispObject body = rest.cdr();
     374        LispObject decls = NIL;
     375        while (body.car() instanceof Cons && body.car().car() == Symbol.DECLARE)
     376          {
     377            decls = new Cons(body.car(), decls);
     378            body = body.cdr();
     379          }
     380        body = new Cons(symbol, body);
     381        body = new Cons(Symbol.BLOCK, body);
     382        body = new Cons(body, NIL);
     383        while (decls != NIL)
     384          {
     385            body = new Cons(decls.car(), body);
     386            decls = decls.cdr();
     387          }
     388        LispObject lambda_expression =
     389          new Cons(Symbol.LAMBDA, new Cons(parameters, body));
     390        LispObject lambda_name =
     391          list2(recursive ? Symbol.LABELS : Symbol.FLET, name);
     392        Closure closure =
     393          new Closure(lambda_name, lambda_expression,
     394                      recursive ? ext : env);
     395        ext.addFunctionBinding(name, closure);
     396        defs = defs.cdr();
     397      }
     398    try
     399      {
     400        return progn(args.cdr(), ext, thread);
     401      }
     402    finally
     403      {
     404        thread.lastSpecialBinding = lastSpecialBinding;
     405      }
    413406  }
    414407
Note: See TracChangeset for help on using the changeset viewer.