001: /*
002: * arglist.java
003: *
004: * Copyright (C) 2003-2004 Peter Graves
005: * $Id: arglist.java,v 1.10 2004/07/10 15:59:36 piso Exp $
006: *
007: * This program is free software; you can redistribute it and/or
008: * modify it under the terms of the GNU General Public License
009: * as published by the Free Software Foundation; either version 2
010: * of the License, or (at your option) any later version.
011: *
012: * This program is distributed in the hope that it will be useful,
013: * but WITHOUT ANY WARRANTY; without even the implied warranty of
014: * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
015: * GNU General Public License for more details.
016: *
017: * You should have received a copy of the GNU General Public License
018: * along with this program; if not, write to the Free Software
019: * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
020: */
021:
022: package org.armedbear.lisp;
023:
024: public final class arglist extends Lisp {
025: private static final Functional getFunctional(LispObject obj)
026: throws ConditionThrowable {
027: if (obj instanceof Functional)
028: return (Functional) obj;
029: if (obj instanceof Symbol) {
030: LispObject fun = obj.getSymbolFunction();
031: if (fun instanceof Autoload) {
032: Autoload autoload = (Autoload) fun;
033: autoload.load();
034: fun = (Functional) autoload.getSymbol()
035: .getSymbolFunction();
036: }
037: if (fun instanceof Functional) {
038: Functional func = (Functional) fun;
039: if (func.getArglist() != null)
040: return func;
041: LispObject other = get(checkSymbol(obj),
042: Symbol.MACROEXPAND_MACRO, NIL);
043: if (other != null)
044: return getFunctional(other);
045: else
046: return null;
047: }
048: } else if (obj instanceof Cons && obj.car() == Symbol.LAMBDA)
049: return new Closure(obj.cadr(), obj.cddr(),
050: new Environment());
051: return null;
052: }
053:
054: // ### arglist
055: private static final Primitive1 ARGLIST = new Primitive1("arglist",
056: PACKAGE_EXT, true) {
057: public LispObject execute(LispObject arg)
058: throws ConditionThrowable {
059: LispThread thread = LispThread.currentThread();
060: Functional functional = getFunctional(arg);
061: LispObject arglist = null;
062: if (functional != null)
063: arglist = functional.getArglist();
064: final LispObject value1, value2;
065: if (arglist instanceof AbstractString) {
066: String s = arglist.getStringValue();
067: // Give the string list syntax.
068: s = "(" + s + ")";
069: // Bind *PACKAGE* so we use the EXT package if we need
070: // to intern any symbols.
071: Environment oldDynEnv = thread.getDynamicEnvironment();
072: thread.bindSpecial(_PACKAGE_, PACKAGE_EXT);
073: try {
074: arglist = readObjectFromString(s);
075: } finally {
076: thread.setDynamicEnvironment(oldDynEnv);
077: }
078: functional.setArglist(arglist);
079: }
080: if (arglist != null) {
081: value1 = arglist;
082: value2 = T;
083: } else {
084: value1 = NIL;
085: value2 = NIL;
086: }
087: return thread.setValues(value1, value2);
088: }
089: };
090:
091: // ### %set-arglist
092: private static final Primitive2 _SET_ARGLIST = new Primitive2(
093: "%set-arglist", PACKAGE_SYS, false) {
094: public LispObject execute(LispObject first, LispObject second)
095: throws ConditionThrowable {
096: coerceToFunctional(first).setArglist(second);
097: return second;
098: }
099: };
100: }
|