Changeset 5256


Ignore:
Timestamp:
12/27/03 03:08:19 (17 years ago)
Author:
piso
Message:

%DEFUN: refactoring.

File:
1 edited

Legend:

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

    r5234 r5256  
    33 *
    44 * Copyright (C) 2002-2003 Peter Graves
    5  * $Id: Primitives.java,v 1.539 2003-12-20 18:31:27 piso Exp $
     5 * $Id: Primitives.java,v 1.540 2003-12-27 03:08:19 piso Exp $
    66 *
    77 * This program is free software; you can redistribute it and/or
     
    13381338            else
    13391339                env = new Environment();
     1340            final Symbol symbol;
    13401341            if (first instanceof Symbol) {
    1341                 Symbol symbol = checkSymbol(first);
     1342                symbol = checkSymbol(first);
    13421343                if (symbol.getSymbolFunction() instanceof SpecialOperator) {
    13431344                    String message =
    13441345                        symbol.getName() + " is a special operator and may not be redefined";
    1345                     signal(new ProgramError(message));
    1346                     return NIL;
    1347                 }
    1348                 LispObject arglist = checkList(second);
    1349                 LispObject body = checkList(third);
    1350                 if (body.car() instanceof LispString && body.cdr() != NIL) {
    1351                     // Documentation.
     1346                    return signal(new ProgramError(message));
     1347                }
     1348            } else if (first instanceof Cons && first.car() == Symbol.SETF) {
     1349                symbol = checkSymbol(first.cadr());
     1350            } else
     1351                return signal(new TypeError(first, "valid function name"));
     1352            LispObject arglist = checkList(second);
     1353            LispObject body = checkList(third);
     1354            if (body.car() instanceof LispString && body.cdr() != NIL) {
     1355                // Documentation.
     1356                if (first instanceof Symbol)
    13521357                    symbol.setFunctionDocumentation(body.car());
    1353                     body = body.cdr();
    1354                 }
    1355                 LispObject decls = NIL;
    1356                 while (body.car() instanceof Cons && body.car().car() == Symbol.DECLARE) {
    1357                     decls = new Cons(body.car(), decls);
    1358                     body = body.cdr();
    1359                 }
    1360                 body = new Cons(symbol, body);
    1361                 body = new Cons(Symbol.BLOCK, body);
    1362                 body = new Cons(body, NIL);
    1363                 while (decls != NIL) {
    1364                     body = new Cons(decls.car(), body);
    1365                     decls = decls.cdr();
    1366                 }
    1367                 Closure closure = new Closure(symbol.getName(), arglist, body,
    1368                                               env);
    1369                 closure.setArglist(arglist);
     1358                else
     1359                    ; // FIXME Support documentation for SETF functions!
     1360                body = body.cdr();
     1361            }
     1362            LispObject decls = NIL;
     1363            while (body.car() instanceof Cons && body.car().car() == Symbol.DECLARE) {
     1364                decls = new Cons(body.car(), decls);
     1365                body = body.cdr();
     1366            }
     1367            body = new Cons(symbol, body);
     1368            body = new Cons(Symbol.BLOCK, body);
     1369            body = new Cons(body, NIL);
     1370            while (decls != NIL) {
     1371                body = new Cons(decls.car(), body);
     1372                decls = decls.cdr();
     1373            }
     1374            final String name;
     1375            if (first instanceof Symbol)
     1376                name = symbol.getName();
     1377            else
     1378                name = null;
     1379            Closure closure = new Closure(name, arglist, body, env);
     1380            closure.setArglist(arglist);
     1381            if (first instanceof Symbol)
    13701382                symbol.setSymbolFunction(closure);
    1371                 return symbol;
    1372             }
    1373             if (first instanceof Cons && first.car() == Symbol.SETF) {
    1374                 Symbol symbol = checkSymbol(first.cadr());
    1375                 LispObject arglist = checkList(second);
    1376                 LispObject body = checkList(third);
    1377                 if (body.car() instanceof LispString && body.cdr() != NIL) {
    1378                     // Documentation.
    1379 //                     symbol.setFunctionDocumentation(body.car());
    1380                     body = body.cdr();
    1381                 }
    1382                 body = new Cons(symbol, body);
    1383                 body = new Cons(Symbol.BLOCK, body);
    1384                 body = new Cons(body, NIL);
    1385                 Closure closure = new Closure(arglist, body, env);
    1386                 closure.setArglist(arglist);
     1383            else
     1384                // SETF function
    13871385                put(symbol, PACKAGE_SYS.intern("SETF-FUNCTION"), closure);
    1388                 return symbol;
    1389             }
    1390             signal(new TypeError(first, "valid function name"));
    1391             return NIL;
     1386            return first;
    13921387        }
    13931388    };
Note: See TracChangeset for help on using the changeset viewer.