0001: /*
0002: * Lisp.java
0003: *
0004: * Copyright (C) 2002-2003 Peter Graves
0005: * $Id: Lisp.java,v 1.8 2003/11/15 11:03:28 beedlem Exp $
0006: *
0007: * This program is free software; you can redistribute it and/or
0008: * modify it under the terms of the GNU General Public License
0009: * as published by the Free Software Foundation; either version 2
0010: * of the License, or (at your option) any later version.
0011: *
0012: * This program is distributed in the hope that it will be useful,
0013: * but WITHOUT ANY WARRANTY; without even the implied warranty of
0014: * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
0015: * GNU General Public License for more details.
0016: *
0017: * You should have received a copy of the GNU General Public License
0018: * along with this program; if not, write to the Free Software
0019: * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
0020: */
0021:
0022: package org.armedbear.lisp;
0023:
0024: import java.math.BigInteger;
0025: import java.util.Hashtable;
0026: import java.util.Random;
0027:
0028: public abstract class Lisp {
0029: // Packages.
0030: public static final Package PACKAGE_CL = Packages.createPackage(
0031: "COMMON-LISP", 1024);
0032: public static final Package PACKAGE_CL_USER = Packages
0033: .createPackage("COMMON-LISP-USER", 1024);
0034: public static final Package PACKAGE_SYS = Packages
0035: .createPackage("SYSTEM");
0036: public static final Package PACKAGE_TPL = Packages
0037: .createPackage("TOP-LEVEL");
0038: public static final Package PACKAGE_EXT = Packages
0039: .createPackage("EXTENSIONS");
0040: public static final Package PACKAGE_PROF = Packages
0041: .createPackage("PROFILER");
0042: public static final Package PACKAGE_JAVA = Packages
0043: .createPackage("JAVA");
0044: static {
0045: try {
0046: PACKAGE_CL.addNickname("CL");
0047: PACKAGE_CL_USER.addNickname("CL-USER");
0048: PACKAGE_CL_USER.usePackage(PACKAGE_CL);
0049: PACKAGE_CL_USER.usePackage(PACKAGE_EXT);
0050: PACKAGE_CL_USER.usePackage(PACKAGE_JAVA);
0051: PACKAGE_SYS.addNickname("SYS");
0052: PACKAGE_SYS.usePackage(PACKAGE_CL);
0053: PACKAGE_SYS.usePackage(PACKAGE_EXT);
0054: PACKAGE_TPL.addNickname("TPL");
0055: PACKAGE_TPL.usePackage(PACKAGE_CL);
0056: PACKAGE_TPL.usePackage(PACKAGE_EXT);
0057: PACKAGE_EXT.addNickname("EXT");
0058: PACKAGE_EXT.usePackage(PACKAGE_CL);
0059: PACKAGE_PROF.addNickname("PROF");
0060: PACKAGE_PROF.usePackage(PACKAGE_CL);
0061: PACKAGE_PROF.usePackage(PACKAGE_EXT);
0062: PACKAGE_JAVA.usePackage(PACKAGE_CL);
0063: PACKAGE_JAVA.usePackage(PACKAGE_EXT);
0064: } catch (Throwable t) {
0065: t.printStackTrace();
0066: }
0067: }
0068: public static final Package PACKAGE_KEYWORD = Packages
0069: .createPackage("KEYWORD", 1024);
0070:
0071: static {
0072: PACKAGE_CL.addInitialExports(Exports.COMMON_LISP_SYMBOL_NAMES);
0073: }
0074:
0075: // ### nil
0076: public static final LispObject NIL = new Nil(PACKAGE_CL);
0077:
0078: // End-of-file marker.
0079: public static final LispObject EOF = new LispObject();
0080:
0081: // Functional types.
0082: static final int FTYPE_SPECIAL_OPERATOR = 1;
0083: static final int FTYPE_MACRO = 2;
0084: static final int FTYPE_AUTOLOAD = 3;
0085:
0086: public static boolean debug = true;
0087:
0088: public static boolean profiling;
0089:
0090: public static boolean sampling;
0091:
0092: public static volatile boolean sampleNow;
0093:
0094: // argv must not be null!
0095: public static final LispObject funcall(LispObject fun,
0096: LispObject[] argv, LispThread thread)
0097: throws ConditionThrowable {
0098: if (fun instanceof Autoload) {
0099: Autoload autoload = (Autoload) fun;
0100: autoload.load();
0101: fun = autoload.getSymbol().getSymbolFunction();
0102: }
0103: if (debug)
0104: thread.pushStackFrame(fun, argv);
0105: thread.clearValues();
0106: LispObject result;
0107: if (profiling)
0108: if (!sampling)
0109: fun.incrementCallCount();
0110: switch (argv.length) {
0111: case 0:
0112: result = fun.execute();
0113: break;
0114: case 1:
0115: result = fun.execute(argv[0]);
0116: break;
0117: case 2:
0118: result = fun.execute(argv[0], argv[1]);
0119: break;
0120: case 3:
0121: result = fun.execute(argv[0], argv[1], argv[2]);
0122: break;
0123: default:
0124: result = fun.execute(argv);
0125: break;
0126: }
0127: if (debug)
0128: thread.popStackFrame();
0129: return result;
0130: }
0131:
0132: public static final LispObject funcall0(LispObject fun,
0133: LispThread thread) throws ConditionThrowable {
0134: if (fun instanceof Autoload) {
0135: Autoload autoload = (Autoload) fun;
0136: autoload.load();
0137: fun = autoload.getSymbol().getSymbolFunction();
0138: }
0139: if (debug) {
0140: LispObject[] argv = new LispObject[0];
0141: thread.pushStackFrame(fun, argv);
0142: }
0143: thread.clearValues();
0144: LispObject result;
0145: if (profiling)
0146: if (!sampling)
0147: fun.incrementCallCount();
0148: result = fun.execute();
0149: if (debug)
0150: thread.popStackFrame();
0151: return result;
0152: }
0153:
0154: public static final LispObject funcall1(LispObject fun,
0155: LispObject arg, LispThread thread)
0156: throws ConditionThrowable {
0157: if (fun instanceof Autoload) {
0158: Autoload autoload = (Autoload) fun;
0159: autoload.load();
0160: fun = autoload.getSymbol().getSymbolFunction();
0161: }
0162: if (debug) {
0163: LispObject[] argv = new LispObject[1];
0164: argv[0] = arg;
0165: thread.pushStackFrame(fun, argv);
0166: }
0167: thread.clearValues();
0168: LispObject result;
0169: if (profiling)
0170: if (!sampling)
0171: fun.incrementCallCount();
0172: result = fun.execute(arg);
0173: if (debug)
0174: thread.popStackFrame();
0175: return result;
0176: }
0177:
0178: public static final LispObject funcall2(LispObject fun,
0179: LispObject first, LispObject second, LispThread thread)
0180: throws ConditionThrowable {
0181: if (fun instanceof Autoload) {
0182: Autoload autoload = (Autoload) fun;
0183: autoload.load();
0184: fun = autoload.getSymbol().getSymbolFunction();
0185: }
0186: if (debug) {
0187: LispObject[] argv = new LispObject[2];
0188: argv[0] = first;
0189: argv[1] = second;
0190: thread.pushStackFrame(fun, argv);
0191: }
0192: thread.clearValues();
0193: LispObject result;
0194: if (profiling)
0195: if (!sampling)
0196: fun.incrementCallCount();
0197: result = fun.execute(first, second);
0198: if (debug)
0199: thread.popStackFrame();
0200: return result;
0201: }
0202:
0203: public static final LispObject funcall3(LispObject fun,
0204: LispObject first, LispObject second, LispObject third,
0205: LispThread thread) throws ConditionThrowable {
0206: if (fun instanceof Autoload) {
0207: Autoload autoload = (Autoload) fun;
0208: autoload.load();
0209: fun = autoload.getSymbol().getSymbolFunction();
0210: }
0211: if (debug) {
0212: LispObject[] argv = new LispObject[3];
0213: argv[0] = first;
0214: argv[1] = second;
0215: argv[2] = third;
0216: thread.pushStackFrame(fun, argv);
0217: }
0218: thread.clearValues();
0219: LispObject result;
0220: if (profiling)
0221: if (!sampling)
0222: fun.incrementCallCount();
0223: result = fun.execute(first, second, third);
0224: if (debug)
0225: thread.popStackFrame();
0226: return result;
0227: }
0228:
0229: public static final LispObject macroexpand(LispObject form,
0230: final Environment env, final LispThread thread)
0231: throws ConditionThrowable {
0232: LispObject expanded = NIL;
0233: while (true) {
0234: form = macroexpand_1(form, env, thread);
0235: LispObject[] values = thread.getValues();
0236: if (values[1] == NIL) {
0237: values[1] = expanded;
0238: return form;
0239: }
0240: expanded = T;
0241: }
0242: }
0243:
0244: public static final LispObject macroexpand_1(final LispObject form,
0245: final Environment env, final LispThread thread)
0246: throws ConditionThrowable {
0247: LispObject[] results = new LispObject[2];
0248: if (form instanceof Cons) {
0249: LispObject car = form.car();
0250: if (car instanceof Symbol) {
0251: LispObject obj = env.lookupFunctional(car);
0252: if (obj instanceof Autoload) {
0253: Autoload autoload = (Autoload) obj;
0254: autoload.load();
0255: obj = autoload.getSymbol().getSymbolFunction();
0256: }
0257: if (obj instanceof SpecialOperator)
0258: obj = get((Symbol) car, Symbol.MACROEXPAND_MACRO);
0259: if (obj instanceof MacroObject) {
0260: LispObject expander = ((MacroObject) obj)
0261: .getExpander();
0262: if (profiling)
0263: if (!sampling)
0264: expander.incrementCallCount();
0265: results[0] = expander.execute(form, env);
0266: results[1] = T;
0267: thread.setValues(results);
0268: return results[0];
0269: }
0270: }
0271: } else if (form instanceof Symbol) {
0272: Symbol symbol = (Symbol) form;
0273: LispObject obj = null;
0274: if (symbol.isSpecialVariable())
0275: obj = thread.lookupSpecial(symbol);
0276: else
0277: obj = env.lookup(symbol);
0278: if (obj == null)
0279: obj = symbol.getSymbolValue();
0280: if (obj instanceof SymbolMacro) {
0281: results[0] = ((SymbolMacro) obj).getExpansion();
0282: results[1] = T;
0283: thread.setValues(results);
0284: return results[0];
0285: }
0286: }
0287: // Not a macro.
0288: results[0] = form;
0289: results[1] = NIL;
0290: thread.setValues(results);
0291: return results[0];
0292: }
0293:
0294: private static final Primitive1 INTERACTIVE_EVAL = new Primitive1(
0295: "interactive-eval", PACKAGE_SYS, false) {
0296: public LispObject execute(LispObject object)
0297: throws ConditionThrowable {
0298: final LispThread thread = LispThread.currentThread();
0299: final Environment environment = new Environment();
0300: Symbol.MINUS.setSymbolValue(object);
0301: LispObject result;
0302: try {
0303: result = eval(object, environment, thread);
0304: } catch (StackOverflowError e) {
0305: if (debug)
0306: thread.saveBacktrace();
0307: throw new ConditionThrowable(new LispError(
0308: "stack overflow"));
0309: } catch (ConditionThrowable t) {
0310: if (debug)
0311: thread.saveBacktrace();
0312: throw t;
0313: }
0314: Debug.assertTrue(result != null);
0315: Symbol.STAR_STAR_STAR.setSymbolValue(Symbol.STAR_STAR
0316: .getSymbolValue());
0317: Symbol.STAR_STAR.setSymbolValue(Symbol.STAR
0318: .getSymbolValue());
0319: Symbol.STAR.setSymbolValue(result);
0320: Symbol.PLUS_PLUS_PLUS.setSymbolValue(Symbol.PLUS_PLUS
0321: .getSymbolValue());
0322: Symbol.PLUS_PLUS.setSymbolValue(Symbol.PLUS
0323: .getSymbolValue());
0324: Symbol.PLUS.setSymbolValue(Symbol.MINUS.getSymbolValue());
0325: LispObject[] values = thread.getValues();
0326: Symbol.SLASH_SLASH_SLASH.setSymbolValue(Symbol.SLASH_SLASH
0327: .getSymbolValue());
0328: Symbol.SLASH_SLASH.setSymbolValue(Symbol.SLASH
0329: .getSymbolValue());
0330: if (values != null) {
0331: LispObject slash = NIL;
0332: for (int i = values.length; i-- > 0;)
0333: slash = new Cons(values[i], slash);
0334: Symbol.SLASH.setSymbolValue(slash);
0335: } else {
0336: Symbol.SLASH.setSymbolValue(new Cons(result));
0337: }
0338: return result;
0339: }
0340: };
0341:
0342: public static final LispObject eval(final LispObject obj,
0343: final Environment env, final LispThread thread)
0344: throws ConditionThrowable {
0345: if (profiling && sampling) {
0346: // FIXME
0347: // This is not exactly the right place to do this. We should
0348: // include the current call as well.
0349: if (sampleNow)
0350: Profiler.sample(thread);
0351: }
0352: thread.clearValues();
0353: if (thread.isDestroyed())
0354: throw new ThreadDestroyed();
0355: if (obj instanceof Symbol) {
0356: LispObject result = null;
0357: if (obj.isSpecialVariable()) {
0358: result = thread.lookupSpecial(obj);
0359: } else
0360: result = env.lookup(obj);
0361: if (result == null) {
0362: result = obj.getSymbolValue();
0363: if (result == null)
0364: throw new ConditionThrowable(new UnboundVariable(
0365: obj));
0366: }
0367: if (result instanceof SymbolMacro)
0368: return eval(((SymbolMacro) result).getExpansion(), env,
0369: thread);
0370: return result;
0371: } else if (obj instanceof Cons) {
0372: LispObject first = obj.car();
0373: if (first instanceof Symbol) {
0374: LispObject fun = env.lookupFunctional(first);
0375: if (fun == null)
0376: throw new ConditionThrowable(new UndefinedFunction(
0377: first));
0378: switch (fun.getFunctionalType()) {
0379: case FTYPE_SPECIAL_OPERATOR: {
0380: if (profiling)
0381: if (!sampling)
0382: fun.incrementCallCount();
0383: // Don't eval args!
0384: return fun.execute(obj.cdr(), env);
0385: }
0386: case FTYPE_MACRO:
0387: return eval(macroexpand(obj, env, thread), env,
0388: thread);
0389: case FTYPE_AUTOLOAD: {
0390: Autoload autoload = (Autoload) fun;
0391: autoload.load();
0392: return eval(obj, env, thread);
0393: }
0394: default: {
0395: if (debug)
0396: return funcall(fun, evalList(obj.cdr(), env,
0397: thread), thread);
0398: if (profiling)
0399: if (!sampling)
0400: fun.incrementCallCount();
0401: LispObject args = obj.cdr();
0402: if (args == NIL)
0403: return fun.execute();
0404: LispObject arg1 = args.car();
0405: args = args.cdr();
0406: if (args == NIL)
0407: return fun.execute(thread.value(eval(arg1, env,
0408: thread)));
0409: LispObject arg2 = args.car();
0410: args = args.cdr();
0411: if (args == NIL)
0412: return fun.execute(eval(arg1, env, thread),
0413: thread.value(eval(arg2, env, thread)));
0414: LispObject arg3 = args.car();
0415: args = args.cdr();
0416: if (args == NIL)
0417: return fun
0418: .execute(eval(arg1, env, thread), eval(
0419: arg2, env, thread), thread
0420: .value(eval(arg3, env, thread)));
0421: // More than 3 arguments.
0422: final int length = args.length() + 3;
0423: LispObject[] results = new LispObject[length];
0424: results[0] = eval(arg1, env, thread);
0425: results[1] = eval(arg2, env, thread);
0426: results[2] = eval(arg3, env, thread);
0427: for (int i = 3; i < length; i++) {
0428: results[i] = eval(args.car(), env, thread);
0429: args = args.cdr();
0430: }
0431: thread.clearValues();
0432: return fun.execute(results);
0433: }
0434: }
0435: } else {
0436: LispObject args = obj.cdr();
0437: if (!args.listp())
0438: throw new ConditionThrowable(new TypeError(args,
0439: "list"));
0440: LispObject funcar = first.car();
0441: LispObject rest = first.cdr();
0442: Symbol symbol = checkSymbol(funcar);
0443: if (symbol == Symbol.LAMBDA) {
0444: Closure closure = new Closure(rest.car(), rest
0445: .cdr(), env);
0446: return closure.execute(evalList(args, env, thread));
0447: } else
0448: throw new ConditionThrowable(new ProgramError(
0449: "illegal function object: " + first));
0450: }
0451: } else
0452: return obj;
0453: }
0454:
0455: private static final LispObject[] evalList(LispObject exps,
0456: Environment env, LispThread thread)
0457: throws ConditionThrowable {
0458: final int length = exps.length();
0459: LispObject[] results = new LispObject[length];
0460: for (int i = 0; i < length; i++) {
0461: results[i] = eval(exps.car(), env, thread);
0462: exps = exps.cdr();
0463: }
0464: // Ignore multiple values!
0465: thread.clearValues();
0466: return results;
0467: }
0468:
0469: public static final LispObject progn(LispObject body,
0470: Environment env, LispThread thread)
0471: throws ConditionThrowable {
0472: LispObject result = NIL;
0473: while (body != NIL) {
0474: result = eval(body.car(), env, thread);
0475: body = body.cdr();
0476: }
0477: return result;
0478: }
0479:
0480: // Environment wrappers.
0481: public static final void bind(Symbol symbol, LispObject value,
0482: Environment env) {
0483: if (symbol.isSpecialVariable())
0484: LispThread.currentThread().bindSpecial(symbol, value);
0485: else
0486: env.bind(symbol, value);
0487: }
0488:
0489: public static final void rebind(Symbol symbol, LispObject value,
0490: Environment env) {
0491: if (symbol.isSpecialVariable()) {
0492: Environment dynEnv = LispThread.currentThread()
0493: .getDynamicEnvironment();
0494: Debug.assertTrue(dynEnv != null);
0495: dynEnv.rebind(symbol, value);
0496: } else
0497: env.rebind(symbol, value);
0498: }
0499:
0500: public static final void bindSpecialVariable(Symbol symbol,
0501: LispObject value) {
0502: Debug.assertTrue(symbol.isSpecialVariable());
0503: LispThread.currentThread().bindSpecial(symbol, value);
0504: }
0505:
0506: public static final LispObject setSpecialVariable(Symbol symbol,
0507: LispObject value) {
0508: Environment dynEnv = LispThread.currentThread()
0509: .getDynamicEnvironment();
0510: if (dynEnv != null) {
0511: Binding binding = dynEnv.getBinding(symbol);
0512: if (binding != null) {
0513: binding.value = value;
0514: return value;
0515: }
0516: }
0517: symbol.setSymbolValue(value);
0518: return value;
0519: }
0520:
0521: public static final Cons list1(LispObject obj1) {
0522: return new Cons(obj1);
0523: }
0524:
0525: public static final Cons list2(LispObject obj1, LispObject obj2) {
0526: return new Cons(obj1, new Cons(obj2));
0527: }
0528:
0529: public static final Cons list3(LispObject obj1, LispObject obj2,
0530: LispObject obj3) {
0531: return new Cons(obj1, new Cons(obj2, new Cons(obj3)));
0532: }
0533:
0534: public static final Cons list4(LispObject obj1, LispObject obj2,
0535: LispObject obj3, LispObject obj4) {
0536: return new Cons(obj1, new Cons(obj2, new Cons(obj3, new Cons(
0537: obj4))));
0538: }
0539:
0540: public static final Cons list5(LispObject obj1, LispObject obj2,
0541: LispObject obj3, LispObject obj4, LispObject obj5) {
0542: return new Cons(obj1, new Cons(obj2, new Cons(obj3, new Cons(
0543: obj4, new Cons(obj5)))));
0544: }
0545:
0546: public static final Cons list6(LispObject obj1, LispObject obj2,
0547: LispObject obj3, LispObject obj4, LispObject obj5,
0548: LispObject obj6) {
0549: return new Cons(obj1, new Cons(obj2, new Cons(obj3, new Cons(
0550: obj4, new Cons(obj5, new Cons(obj6))))));
0551: }
0552:
0553: public static final Cons list7(LispObject obj1, LispObject obj2,
0554: LispObject obj3, LispObject obj4, LispObject obj5,
0555: LispObject obj6, LispObject obj7) {
0556: return new Cons(obj1, new Cons(obj2, new Cons(obj3, new Cons(
0557: obj4, new Cons(obj5, new Cons(obj6, new Cons(obj7)))))));
0558: }
0559:
0560: // Used by jvm compiler.
0561: public static final LispObject multipleValueList(LispObject result) {
0562: LispThread thread = LispThread.currentThread();
0563: LispObject[] values = thread.getValues();
0564: thread.clearValues();
0565: if (values == null)
0566: return new Cons(result);
0567: LispObject list = NIL;
0568: for (int i = values.length; i-- > 0;)
0569: list = new Cons(values[i], list);
0570: return list;
0571: }
0572:
0573: public static Symbol checkSymbol(LispObject obj)
0574: throws ConditionThrowable {
0575: if (obj == null)
0576: throw new NullPointerException();
0577: try {
0578: return (Symbol) obj;
0579: } catch (ClassCastException e) {
0580: throw new ConditionThrowable(new TypeError(obj, "symbol"));
0581: }
0582: }
0583:
0584: public static final Cons checkCons(LispObject obj)
0585: throws ConditionThrowable {
0586: if (obj == null)
0587: throw new NullPointerException();
0588: try {
0589: return (Cons) obj;
0590: } catch (ClassCastException e) {
0591: throw new ConditionThrowable(new TypeError(obj, "cons"));
0592: }
0593: }
0594:
0595: public static final LispObject checkList(LispObject obj)
0596: throws ConditionThrowable {
0597: if (obj == null)
0598: throw new NullPointerException();
0599: if (obj.listp())
0600: return obj;
0601: throw new ConditionThrowable(new TypeError(obj, "list"));
0602: }
0603:
0604: public static final AbstractArray checkArray(LispObject obj)
0605: throws ConditionThrowable {
0606: if (obj == null)
0607: throw new NullPointerException();
0608: try {
0609: return (AbstractArray) obj;
0610: } catch (ClassCastException e) {
0611: throw new ConditionThrowable(new TypeError(obj, "array"));
0612: }
0613: }
0614:
0615: public static final AbstractVector checkVector(LispObject obj)
0616: throws ConditionThrowable {
0617: if (obj == null)
0618: throw new NullPointerException();
0619: try {
0620: return (AbstractVector) obj;
0621: } catch (ClassCastException e) {
0622: throw new ConditionThrowable(new TypeError(obj, "vector"));
0623: }
0624: }
0625:
0626: public static final LispString checkString(LispObject obj)
0627: throws ConditionThrowable {
0628: if (obj == null)
0629: throw new NullPointerException();
0630: try {
0631: return (LispString) obj;
0632: } catch (ClassCastException e) {
0633: throw new ConditionThrowable(new TypeError(obj, "string"));
0634: }
0635: }
0636:
0637: public static final LispString string(LispObject arg)
0638: throws ConditionThrowable {
0639: if (arg instanceof LispString)
0640: return (LispString) arg;
0641: if (arg instanceof Symbol)
0642: return new LispString(arg.getName());
0643: if (arg instanceof LispCharacter)
0644: return new LispString(((LispCharacter) arg).getValue());
0645: throw new ConditionThrowable(new TypeError(String.valueOf(arg)
0646: + " cannot be coerced to a string"));
0647: }
0648:
0649: public static final String javaString(LispObject arg)
0650: throws ConditionThrowable {
0651: if (arg instanceof LispString)
0652: return ((LispString) arg).getValue();
0653: if (arg instanceof Symbol)
0654: return arg.getName();
0655: if (arg instanceof LispCharacter)
0656: return String.valueOf(new char[] { ((LispCharacter) arg)
0657: .getValue() });
0658: throw new ConditionThrowable(new TypeError(String.valueOf(arg)
0659: + " cannot be coerced to a string"));
0660: }
0661:
0662: public static final LispObject number(long n) {
0663: if (n >= Integer.MIN_VALUE && n <= Integer.MAX_VALUE)
0664: return new Fixnum((int) n);
0665: return new Bignum(n);
0666: }
0667:
0668: private static final BigInteger INT_MIN = BigInteger
0669: .valueOf(Integer.MIN_VALUE);
0670: private static final BigInteger INT_MAX = BigInteger
0671: .valueOf(Integer.MAX_VALUE);
0672:
0673: public static final LispObject number(BigInteger numerator,
0674: BigInteger denominator) throws ConditionThrowable {
0675: if (denominator.signum() == 0)
0676: throw new ConditionThrowable(new DivisionByZero());
0677: if (denominator.signum() < 0) {
0678: numerator = numerator.negate();
0679: denominator = denominator.negate();
0680: }
0681: BigInteger gcd = numerator.gcd(denominator);
0682: if (!gcd.equals(BigInteger.ONE)) {
0683: numerator = numerator.divide(gcd);
0684: denominator = denominator.divide(gcd);
0685: }
0686: if (denominator.equals(BigInteger.ONE))
0687: return number(numerator);
0688: return new Ratio(numerator, denominator);
0689: }
0690:
0691: public static final LispObject number(BigInteger n) {
0692: if (n.compareTo(INT_MIN) >= 0 && n.compareTo(INT_MAX) <= 0)
0693: return new Fixnum(n.intValue());
0694: return new Bignum(n);
0695: }
0696:
0697: public static final LispObject values(LispObject first,
0698: LispObject second) {
0699: LispObject[] values = new LispObject[2];
0700: values[0] = first;
0701: values[1] = second;
0702: LispThread.currentThread().setValues(values);
0703: return first;
0704: }
0705:
0706: public static final LispObject values(LispObject[] args) {
0707: if (args.length == 1) {
0708: LispThread.currentThread().clearValues();
0709: return args[0];
0710: }
0711: LispThread.currentThread().setValues(args);
0712: return args.length > 0 ? args[0] : NIL;
0713: }
0714:
0715: public static final LispObject readObjectFromString(String s) {
0716: try {
0717: return new StringInputStream(s).read(true, NIL, false);
0718: } catch (Throwable t) {
0719: return null;
0720: }
0721: }
0722:
0723: public static final int nameToChar(String s) {
0724: String lower = s.toLowerCase();
0725: if (lower.equals("space"))
0726: return ' ';
0727: if (lower.equals("tab"))
0728: return '\t';
0729: if (lower.equals("newline"))
0730: return '\n';
0731: if (lower.equals("linefeed"))
0732: return '\n';
0733: if (lower.equals("return"))
0734: return '\r';
0735: if (lower.equals("page"))
0736: return '\f';
0737: if (lower.equals("null"))
0738: return 0;
0739: if (lower.equals("backspace"))
0740: return '\b';
0741: // Unknown.
0742: return -1;
0743: }
0744:
0745: public static final LispObject getUpgradedArrayElementType(
0746: LispObject type) {
0747: if (type == Symbol.CHARACTER || type == Symbol.BASE_CHAR
0748: || type == Symbol.STANDARD_CHAR)
0749: return Symbol.CHARACTER;
0750: if (type == Symbol.BIT)
0751: return Symbol.BIT;
0752: if (type == NIL)
0753: return Symbol.CHARACTER;
0754: return T;
0755: }
0756:
0757: public static final LispCharacter checkCharacter(LispObject obj)
0758: throws ConditionThrowable {
0759: if (obj == null)
0760: throw new NullPointerException();
0761: try {
0762: return (LispCharacter) obj;
0763: } catch (ClassCastException e) {
0764: throw new ConditionThrowable(
0765: new TypeError(obj, "character"));
0766: }
0767: }
0768:
0769: public static final Package checkPackage(LispObject obj)
0770: throws ConditionThrowable {
0771: if (obj == null)
0772: throw new NullPointerException();
0773: try {
0774: return (Package) obj;
0775: } catch (ClassCastException e) {
0776: throw new ConditionThrowable(new TypeError(obj, "package"));
0777: }
0778: }
0779:
0780: public static final Function checkFunction(LispObject obj)
0781: throws ConditionThrowable {
0782: if (obj == null)
0783: throw new NullPointerException();
0784: try {
0785: return (Function) obj;
0786: } catch (ClassCastException e) {
0787: throw new ConditionThrowable(new TypeError(obj, "function"));
0788: }
0789: }
0790:
0791: public static final LispStream checkStream(LispObject obj)
0792: throws ConditionThrowable {
0793: if (obj == null)
0794: throw new NullPointerException();
0795: try {
0796: return (LispStream) obj;
0797: } catch (ClassCastException e) {
0798: throw new ConditionThrowable(new TypeError(obj, "stream"));
0799: }
0800: }
0801:
0802: public static final CharacterInputStream checkCharacterInputStream(
0803: LispObject obj) throws ConditionThrowable {
0804: if (obj == null)
0805: throw new NullPointerException();
0806: if (obj instanceof CharacterInputStream)
0807: return (CharacterInputStream) obj;
0808: if (obj instanceof TwoWayStream) {
0809: LispInputStream in = ((TwoWayStream) obj).getInputStream();
0810: if (in instanceof CharacterInputStream)
0811: return (CharacterInputStream) in;
0812: }
0813: throw new ConditionThrowable(new TypeError(obj,
0814: "character input stream"));
0815: }
0816:
0817: public static final CharacterOutputStream checkCharacterOutputStream(
0818: LispObject obj) throws ConditionThrowable {
0819: if (obj == null)
0820: throw new NullPointerException();
0821: if (obj instanceof CharacterOutputStream)
0822: return (CharacterOutputStream) obj;
0823: if (obj instanceof TwoWayStream) {
0824: LispOutputStream out = ((TwoWayStream) obj)
0825: .getOutputStream();
0826: if (out instanceof CharacterOutputStream)
0827: return (CharacterOutputStream) out;
0828: }
0829: throw new ConditionThrowable(new TypeError(obj,
0830: "character output stream"));
0831: }
0832:
0833: public static final BinaryInputStream checkBinaryInputStream(
0834: LispObject obj) throws ConditionThrowable {
0835: if (obj == null)
0836: throw new NullPointerException();
0837: if (obj instanceof BinaryInputStream)
0838: return (BinaryInputStream) obj;
0839: if (obj instanceof TwoWayStream) {
0840: LispInputStream in = ((TwoWayStream) obj).getInputStream();
0841: if (in instanceof BinaryInputStream)
0842: return (BinaryInputStream) in;
0843: }
0844: throw new ConditionThrowable(new TypeError(obj,
0845: "binary input stream"));
0846: }
0847:
0848: public static final BinaryOutputStream checkBinaryOutputStream(
0849: LispObject obj) throws ConditionThrowable {
0850: if (obj == null)
0851: throw new NullPointerException();
0852: if (obj instanceof BinaryOutputStream)
0853: return (BinaryOutputStream) obj;
0854: if (obj instanceof TwoWayStream) {
0855: LispOutputStream out = ((TwoWayStream) obj)
0856: .getOutputStream();
0857: if (out instanceof BinaryOutputStream)
0858: return (BinaryOutputStream) out;
0859: }
0860: throw new ConditionThrowable(new TypeError(obj,
0861: "binary output stream"));
0862: }
0863:
0864: public static final CharacterInputStream inSynonymOf(LispObject obj)
0865: throws ConditionThrowable {
0866: if (obj == T)
0867: return checkCharacterInputStream(_TERMINAL_IO_
0868: .symbolValue());
0869: if (obj == NIL)
0870: return checkCharacterInputStream(_STANDARD_INPUT_
0871: .symbolValue());
0872: if (obj instanceof CharacterInputStream)
0873: return (CharacterInputStream) obj;
0874: if (obj instanceof TwoWayStream) {
0875: LispInputStream in = ((TwoWayStream) obj).getInputStream();
0876: if (in instanceof CharacterInputStream)
0877: return (CharacterInputStream) in;
0878: }
0879: throw new ConditionThrowable(new TypeError(obj,
0880: "character input stream"));
0881: }
0882:
0883: public static final CharacterOutputStream outSynonymOf(
0884: LispObject obj) throws ConditionThrowable {
0885: if (obj == T)
0886: return checkCharacterOutputStream(_TERMINAL_IO_
0887: .symbolValue());
0888: if (obj == NIL)
0889: return checkCharacterOutputStream(_STANDARD_OUTPUT_
0890: .symbolValue());
0891: if (obj instanceof CharacterOutputStream)
0892: return (CharacterOutputStream) obj;
0893: if (obj instanceof TwoWayStream) {
0894: LispOutputStream out = ((TwoWayStream) obj)
0895: .getOutputStream();
0896: if (out instanceof CharacterOutputStream)
0897: return (CharacterOutputStream) out;
0898: }
0899: throw new ConditionThrowable(new TypeError(obj,
0900: "character output stream"));
0901: }
0902:
0903: public static final Readtable checkReadtable(LispObject obj)
0904: throws ConditionThrowable {
0905: if (obj == null)
0906: throw new NullPointerException();
0907: try {
0908: return (Readtable) obj;
0909: } catch (ClassCastException e) {
0910: throw new ConditionThrowable(
0911: new TypeError(obj, "readtable"));
0912: }
0913: }
0914:
0915: public static final Environment checkEnvironment(LispObject obj)
0916: throws ConditionThrowable {
0917: if (obj == null)
0918: throw new NullPointerException();
0919: try {
0920: return (Environment) obj;
0921: } catch (ClassCastException e) {
0922: throw new ConditionThrowable(new TypeError(obj,
0923: "environment"));
0924: }
0925: }
0926:
0927: public static final Function coerceToFunction(LispObject obj)
0928: throws ConditionThrowable {
0929: if (obj instanceof Function)
0930: return (Function) obj;
0931: if (obj instanceof Symbol) {
0932: LispObject fun = obj.getSymbolFunction();
0933: if (fun instanceof Function)
0934: return (Function) fun;
0935: } else if (obj instanceof Cons && obj.car() == Symbol.LAMBDA)
0936: return new Closure(obj.cadr(), obj.cddr(),
0937: new Environment());
0938: throw new ConditionThrowable(new UndefinedFunction(obj));
0939: }
0940:
0941: // Returns package or throws exception.
0942: public static final Package coerceToPackage(LispObject obj)
0943: throws ConditionThrowable {
0944: if (obj instanceof Package)
0945: return (Package) obj;
0946: Package pkg = Packages.findPackage(javaString(obj));
0947: if (pkg != null)
0948: return pkg;
0949: throw new ConditionThrowable(new PackageError(obj
0950: + " is not the name of a package"));
0951: }
0952:
0953: // Property lists.
0954: public static final LispObject getf(LispObject plist,
0955: LispObject indicator, LispObject defaultValue)
0956: throws ConditionThrowable {
0957: LispObject list = plist;
0958: while (list != NIL) {
0959: if (list.car() == indicator)
0960: return list.cadr();
0961: if (list.cdr() instanceof Cons)
0962: list = list.cddr();
0963: else
0964: throw new ConditionThrowable(new TypeError(
0965: "malformed property list: " + plist));
0966: }
0967: return defaultValue;
0968: }
0969:
0970: public static final LispObject get(Symbol symbol,
0971: LispObject indicator, LispObject defaultValue)
0972: throws ConditionThrowable {
0973: LispObject list = symbol.getPropertyList();
0974: while (list != NIL) {
0975: if (list.car() == indicator)
0976: return list.cadr();
0977: list = list.cddr();
0978: }
0979: return defaultValue;
0980: }
0981:
0982: // Returns null if there is no property with the specified indicator.
0983: public static final LispObject get(Symbol symbol,
0984: LispObject indicator) throws ConditionThrowable {
0985: LispObject list = symbol.getPropertyList();
0986: while (list != NIL) {
0987: if (list.car() == indicator)
0988: return list.cadr();
0989: list = list.cddr();
0990: }
0991: return null;
0992: }
0993:
0994: public static final LispObject put(Symbol symbol,
0995: LispObject indicator, LispObject value)
0996: throws ConditionThrowable {
0997: LispObject list = symbol.getPropertyList();
0998: while (list != NIL) {
0999: if (list.car() == indicator) {
1000: // Found it!
1001: LispObject rest = list.cdr();
1002: rest.setCar(value);
1003: return value;
1004: }
1005: list = list.cddr();
1006: }
1007: // Not found.
1008: symbol.setPropertyList(new Cons(indicator, new Cons(value,
1009: symbol.getPropertyList())));
1010: return value;
1011: }
1012:
1013: public static final LispObject remprop(Symbol symbol,
1014: LispObject indicator) throws ConditionThrowable {
1015: LispObject list = checkList(symbol.getPropertyList());
1016: LispObject prev = null;
1017: while (list != NIL) {
1018: if (!(list.cdr() instanceof Cons))
1019: throw new ConditionThrowable(
1020: new ProgramError(
1021: String.valueOf(symbol)
1022: + " has an odd number of items in its property list"));
1023: if (list.car() == indicator) {
1024: // Found it!
1025: if (prev != null)
1026: prev.setCdr(list.cddr());
1027: else
1028: symbol.setPropertyList(list.cddr());
1029: return T;
1030: }
1031: prev = list;
1032: list = list.cddr();
1033: }
1034: // Not found.
1035: return NIL;
1036: }
1037:
1038: public static final Symbol intern(String name, Package pkg) {
1039: return pkg.intern(name);
1040: }
1041:
1042: // Used by jvm compiler.
1043: public static final Symbol internInPackage(String name,
1044: String packageName) throws ConditionThrowable {
1045: Package pkg = Packages.findPackage(packageName);
1046: if (pkg == null)
1047: throw new ConditionThrowable(new LispError(packageName
1048: + " is not the name of a package"));
1049: return pkg.intern(name);
1050: }
1051:
1052: // The jvm compiler's object table.
1053: private static final Hashtable objectTable = new Hashtable();
1054:
1055: public static final LispObject recall(LispString key) {
1056: return (LispObject) objectTable.get(((LispString) key)
1057: .getValue());
1058: }
1059:
1060: public static final void forget(LispString key) {
1061: objectTable.remove(((LispString) key).getValue());
1062: }
1063:
1064: public static final Primitive2 REMEMBER = new Primitive2(
1065: "remember", PACKAGE_SYS, false) {
1066: public LispObject execute(LispObject first, LispObject second)
1067: throws ConditionThrowable {
1068: objectTable.put(LispString.getValue(first), second);
1069: return NIL;
1070: }
1071: };
1072:
1073: public static final Symbol export(String name, Package pkg) {
1074: Symbol symbol = pkg.intern(name);
1075: try {
1076: pkg.export(symbol); // FIXME Inefficient!
1077: } catch (ConditionThrowable t) {
1078: Debug.trace(t);
1079: }
1080: return symbol;
1081: }
1082:
1083: public static final Symbol internSpecial(String name, Package pkg,
1084: LispObject value) {
1085: Symbol symbol = pkg.intern(name);
1086: symbol.setSpecial(true);
1087: symbol.setSymbolValue(value);
1088: return symbol;
1089: }
1090:
1091: public static final Symbol exportSpecial(String name, Package pkg,
1092: LispObject value) {
1093: Symbol symbol = pkg.intern(name);
1094: try {
1095: pkg.export(symbol); // FIXME Inefficient!
1096: } catch (ConditionThrowable t) {
1097: Debug.trace(t);
1098: }
1099: symbol.setSpecial(true);
1100: symbol.setSymbolValue(value);
1101: return symbol;
1102: }
1103:
1104: public static final Symbol exportConstant(String name, Package pkg,
1105: LispObject value) {
1106: Symbol symbol = pkg.intern(name);
1107: try {
1108: pkg.export(symbol); // FIXME Inefficient!
1109: } catch (ConditionThrowable t) {
1110: Debug.trace(t);
1111: }
1112: symbol.setConstant(true);
1113: symbol.setSymbolValue(value);
1114: return symbol;
1115: }
1116:
1117: public static Symbol _DEFAULT_PATHNAME_DEFAULTS_ = exportSpecial(
1118: "*DEFAULT-PATHNAME-DEFAULTS*", PACKAGE_CL, new LispString(
1119: System.getProperty("user.dir")));
1120:
1121: public static final Symbol _PACKAGE_ = exportSpecial("*PACKAGE*",
1122: PACKAGE_CL, PACKAGE_CL_USER);
1123:
1124: public static final Package getCurrentPackage() {
1125: return (Package) _PACKAGE_.symbolValueNoThrow();
1126: }
1127:
1128: private static CharacterInputStream stdin = new CharacterInputStream(
1129: System.in);
1130:
1131: private static CharacterOutputStream stdout = new CharacterOutputStream(
1132: System.out);
1133:
1134: public static final Symbol _STANDARD_INPUT_ = exportSpecial(
1135: "*STANDARD-INPUT*", PACKAGE_CL, stdin);
1136:
1137: public static final Symbol _STANDARD_OUTPUT_ = exportSpecial(
1138: "*STANDARD-OUTPUT*", PACKAGE_CL, stdout);
1139:
1140: public static final Symbol _ERROR_OUTPUT_ = exportSpecial(
1141: "*ERROR-OUTPUT*", PACKAGE_CL, stdout);
1142:
1143: public static final Symbol _TRACE_OUTPUT_ = exportSpecial(
1144: "*TRACE-OUTPUT*", PACKAGE_CL, stdout);
1145:
1146: public static final Symbol _TERMINAL_IO_ = exportSpecial(
1147: "*TERMINAL-IO*", PACKAGE_CL,
1148: new TwoWayStream(stdin, stdout));
1149:
1150: public static final Symbol _QUERY_IO_ = exportSpecial("*QUERY-IO*",
1151: PACKAGE_CL, new TwoWayStream(stdin, stdout));
1152:
1153: public static final Symbol _DEBUG_IO_ = exportSpecial("*DEBUG-IO*",
1154: PACKAGE_CL, new TwoWayStream(stdin, stdout));
1155:
1156: public void resetIO(CharacterInputStream in,
1157: CharacterOutputStream out) {
1158: stdin = in;
1159: stdout = out;
1160: _STANDARD_INPUT_.setSymbolValue(stdin);
1161: _STANDARD_OUTPUT_.setSymbolValue(stdout);
1162: _ERROR_OUTPUT_.setSymbolValue(stdout);
1163: _TRACE_OUTPUT_.setSymbolValue(stdout);
1164: _TERMINAL_IO_.setSymbolValue(new TwoWayStream(stdin, stdout));
1165: _QUERY_IO_.setSymbolValue(new TwoWayStream(stdin, stdout));
1166: _DEBUG_IO_.setSymbolValue(new TwoWayStream(stdin, stdout));
1167: }
1168:
1169: public static final TwoWayStream getTerminalIO() {
1170: return (TwoWayStream) _TERMINAL_IO_.symbolValueNoThrow();
1171: }
1172:
1173: public static final CharacterInputStream getStandardInput() {
1174: return (CharacterInputStream) _STANDARD_INPUT_
1175: .symbolValueNoThrow();
1176: }
1177:
1178: public static final CharacterOutputStream getStandardOutput()
1179: throws ConditionThrowable {
1180: return checkCharacterOutputStream(_STANDARD_OUTPUT_
1181: .symbolValueNoThrow());
1182: }
1183:
1184: public static final CharacterOutputStream getTraceOutput() {
1185: return (CharacterOutputStream) _TRACE_OUTPUT_
1186: .symbolValueNoThrow();
1187: }
1188:
1189: public static final Symbol _READTABLE_ = exportSpecial(
1190: "*READTABLE*", PACKAGE_CL, new Readtable());
1191:
1192: public static final Readtable getCurrentReadtable() {
1193: return (Readtable) _READTABLE_.symbolValueNoThrow();
1194: }
1195:
1196: public static final Symbol _READ_SUPPRESS_ = exportSpecial(
1197: "*READ-SUPPRESS*", PACKAGE_CL, NIL);
1198:
1199: public static final Symbol _DEBUGGER_HOOK_ = exportSpecial(
1200: "*DEBUGGER-HOOK*", PACKAGE_CL, NIL);
1201:
1202: public static final Symbol MOST_POSITIVE_FIXNUM = exportConstant(
1203: "MOST-POSITIVE-FIXNUM", PACKAGE_CL, new Fixnum(
1204: Integer.MAX_VALUE));
1205:
1206: public static final Symbol MOST_NEGATIVE_FIXNUM = exportConstant(
1207: "MOST-NEGATIVE-FIXNUM", PACKAGE_CL, new Fixnum(
1208: Integer.MIN_VALUE));
1209:
1210: public static void exit() {
1211: Interpreter interpreter = Interpreter.getInstance();
1212: if (interpreter != null)
1213: interpreter.kill();
1214: }
1215:
1216: public static final Primitive0 DEBUG = new Primitive0("%debug",
1217: PACKAGE_SYS, false) {
1218: public LispObject execute() throws ConditionThrowable {
1219: final LispThread thread = LispThread.currentThread();
1220: if (!debug) {
1221: debug = true;
1222: thread.resetStack();
1223: }
1224: return thread.nothing();
1225: }
1226: };
1227:
1228: public static final Primitive0 NODEBUG = new Primitive0("%nodebug",
1229: PACKAGE_SYS, false) {
1230: public LispObject execute() throws ConditionThrowable {
1231: final LispThread thread = LispThread.currentThread();
1232: if (debug) {
1233: debug = false;
1234: thread.resetStack();
1235: }
1236: return thread.nothing();
1237: }
1238: };
1239:
1240: // ### t
1241: public static final Symbol T = PACKAGE_CL.addExternalSymbol("T");
1242: static {
1243: T.setSymbolValue(T);
1244: T.setConstant(true);
1245: }
1246:
1247: // ### *modules*
1248: public static final Symbol _MODULES_ = exportSpecial("*MODULES*",
1249: PACKAGE_CL, NIL);
1250:
1251: // ### *load-verbose*
1252: public static final Symbol _LOAD_VERBOSE_ = exportSpecial(
1253: "*LOAD-VERBOSE*", PACKAGE_CL, NIL);
1254:
1255: // ### *load-print*
1256: public static final Symbol _LOAD_PRINT_ = exportSpecial(
1257: "*LOAD-PRINT*", PACKAGE_CL, NIL);
1258:
1259: // ### *load-truename*
1260: public static final Symbol _LOAD_TRUENAME_ = exportSpecial(
1261: "*LOAD-TRUENAME*", PACKAGE_CL, NIL);
1262:
1263: // ### *load-depth*
1264: // internal symbol
1265: public static final Symbol _LOAD_DEPTH_ = internSpecial(
1266: "*LOAD-DEPTH*", PACKAGE_SYS, new Fixnum(0));
1267:
1268: // ### *autoload-verbose*
1269: // internal symbol
1270: public static final Symbol _AUTOLOAD_VERBOSE_ = exportSpecial(
1271: "*AUTOLOAD-VERBOSE*", PACKAGE_EXT, NIL);
1272:
1273: // Printer control variables.
1274: public static final Symbol _PRINT_ARRAY_ = exportSpecial(
1275: "*PRINT-ARRAY*", PACKAGE_CL, T);
1276:
1277: public static final Symbol _PRINT_BASE_ = exportSpecial(
1278: "*PRINT-BASE*", PACKAGE_CL, new Fixnum(10));
1279:
1280: public static final Symbol _PRINT_CASE_ = exportSpecial(
1281: "*PRINT-CASE*", PACKAGE_CL, Keyword.UPCASE);
1282:
1283: public static final Symbol _PRINT_CIRCLE_ = exportSpecial(
1284: "*PRINT-CIRCLE*", PACKAGE_CL, NIL);
1285:
1286: public static final Symbol _PRINT_ESCAPE_ = exportSpecial(
1287: "*PRINT-ESCAPE*", PACKAGE_CL, T);
1288:
1289: public static final Symbol _PRINT_GENSYM_ = exportSpecial(
1290: "*PRINT-GENSYM*", PACKAGE_CL, T);
1291:
1292: public static final Symbol _PRINT_LENGTH_ = exportSpecial(
1293: "*PRINT-LENGTH*", PACKAGE_CL, NIL);
1294:
1295: public static final Symbol _PRINT_LEVEL_ = exportSpecial(
1296: "*PRINT-LEVEL*", PACKAGE_CL, NIL);
1297:
1298: public static final Symbol _PRINT_LINES_ = exportSpecial(
1299: "*PRINT-LINES*", PACKAGE_CL, NIL);
1300:
1301: public static final Symbol _PRINT_MISER_WIDTH_ = exportSpecial(
1302: "*PRINT-MISER-WIDTH*", PACKAGE_CL, NIL);
1303:
1304: public static final Symbol _PRINT_PPRINT_DISPATCH_ = exportSpecial(
1305: "*PRINT-PPRINT-DISPATCH*", PACKAGE_CL, NIL); // FIXME
1306:
1307: public static final Symbol _PRINT_PRETTY_ = exportSpecial(
1308: "*PRINT-PRETTY*", PACKAGE_CL, NIL);
1309:
1310: public static final Symbol _PRINT_RADIX_ = exportSpecial(
1311: "*PRINT-RADIX*", PACKAGE_CL, NIL);
1312:
1313: public static final Symbol _PRINT_READABLY_ = exportSpecial(
1314: "*PRINT-READABLY*", PACKAGE_CL, NIL);
1315:
1316: public static final Symbol _PRINT_RIGHT_MARGIN_ = exportSpecial(
1317: "*PRINT-RIGHT-MARGIN*", PACKAGE_CL, NIL);
1318:
1319: public static final Symbol _RANDOM_STATE_ = exportSpecial(
1320: "*RANDOM-STATE*", PACKAGE_CL, new JavaObject(new Random()));
1321:
1322: public static final Symbol STAR = exportSpecial("*", PACKAGE_CL,
1323: NIL);
1324: public static final Symbol STAR_STAR = exportSpecial("**",
1325: PACKAGE_CL, NIL);
1326: public static final Symbol STAR_STAR_STAR = exportSpecial("***",
1327: PACKAGE_CL, NIL);
1328:
1329: public static final Symbol MINUS = exportSpecial("-", PACKAGE_CL,
1330: NIL);
1331:
1332: public static final Symbol PLUS = exportSpecial("+", PACKAGE_CL,
1333: NIL);
1334: public static final Symbol PLUS_PLUS = exportSpecial("++",
1335: PACKAGE_CL, NIL);
1336: public static final Symbol PLUS_PLUS_PLUS = exportSpecial("+++",
1337: PACKAGE_CL, NIL);
1338:
1339: public static final Symbol SLASH = exportSpecial("/", PACKAGE_CL,
1340: NIL);
1341: public static final Symbol SLASH_SLASH = exportSpecial("//",
1342: PACKAGE_CL, NIL);
1343: public static final Symbol SLASH_SLASH_SLASH = exportSpecial("///",
1344: PACKAGE_CL, NIL);
1345:
1346: public static final Symbol PI = exportConstant("PI", PACKAGE_CL,
1347: new LispFloat((double) 3.141592653589793));
1348:
1349: public static final Symbol SHORT_FLOAT_EPSILON = exportConstant(
1350: "SHORT-FLOAT-EPSILON", PACKAGE_CL, new LispFloat(
1351: (double) 1.1102230246251568E-16));
1352:
1353: public static final Symbol SINGLE_FLOAT_EPSILON = exportConstant(
1354: "SINGLE-FLOAT-EPSILON", PACKAGE_CL, new LispFloat(
1355: (double) 1.1102230246251568E-16));
1356:
1357: public static final Symbol DOUBLE_FLOAT_EPSILON = exportConstant(
1358: "DOUBLE-FLOAT-EPSILON", PACKAGE_CL, new LispFloat(
1359: (double) 1.1102230246251568E-16));
1360:
1361: public static final Symbol LONG_FLOAT_EPSILON = exportConstant(
1362: "LONG-FLOAT-EPSILON", PACKAGE_CL, new LispFloat(
1363: (double) 1.1102230246251568E-16));
1364:
1365: public static final Symbol SHORT_FLOAT_NEGATIVE_EPSILON = exportConstant(
1366: "SHORT-FLOAT-NEGATIVE-EPSILON", PACKAGE_CL, new LispFloat(
1367: (double) 5.551115123125784E-17));
1368:
1369: public static final Symbol SINGLE_FLOAT_NEGATIVE_EPSILON = exportConstant(
1370: "SINGLE-FLOAT-NEGATIVE-EPSILON", PACKAGE_CL, new LispFloat(
1371: (double) 5.551115123125784E-17));
1372:
1373: public static final Symbol DOUBLE_FLOAT_NEGATIVE_EPSILON = exportConstant(
1374: "DOUBLE-FLOAT-NEGATIVE-EPSILON", PACKAGE_CL, new LispFloat(
1375: (double) 5.551115123125784E-17));
1376:
1377: public static final Symbol LONG_FLOAT_NEGATIVE_EPSILON = exportConstant(
1378: "LONG-FLOAT-NEGATIVE-EPSILON", PACKAGE_CL, new LispFloat(
1379: (double) 5.551115123125784E-17));
1380:
1381: public static final Symbol MOST_POSITIVE_SHORT_FLOAT = exportConstant(
1382: "MOST-POSITIVE-SHORT-FLOAT", PACKAGE_CL, new LispFloat(
1383: Double.MAX_VALUE));
1384:
1385: public static final Symbol MOST_POSITIVE_SINGLE_FLOAT = exportConstant(
1386: "MOST-POSITIVE-SINGLE-FLOAT", PACKAGE_CL, new LispFloat(
1387: Double.MAX_VALUE));
1388:
1389: public static final Symbol MOST_POSITIVE_DOUBLE_FLOAT = exportConstant(
1390: "MOST-POSITIVE-DOUBLE-FLOAT", PACKAGE_CL, new LispFloat(
1391: Double.MAX_VALUE));
1392:
1393: public static final Symbol MOST_POSITIVE_LONG_FLOAT = exportConstant(
1394: "MOST-POSITIVE-LONG-FLOAT", PACKAGE_CL, new LispFloat(
1395: Double.MAX_VALUE));
1396:
1397: public static final Symbol LEAST_POSITIVE_SHORT_FLOAT = exportConstant(
1398: "LEAST-POSITIVE-SHORT-FLOAT", PACKAGE_CL, new LispFloat(
1399: Double.MIN_VALUE));
1400:
1401: public static final Symbol LEAST_POSITIVE_SINGLE_FLOAT = exportConstant(
1402: "LEAST-POSITIVE-SINGLE-FLOAT", PACKAGE_CL, new LispFloat(
1403: Double.MIN_VALUE));
1404:
1405: public static final Symbol LEAST_POSITIVE_DOUBLE_FLOAT = exportConstant(
1406: "LEAST-POSITIVE-DOUBLE-FLOAT", PACKAGE_CL, new LispFloat(
1407: Double.MIN_VALUE));
1408:
1409: public static final Symbol LEAST_POSITIVE_LONG_FLOAT = exportConstant(
1410: "LEAST-POSITIVE-LONG-FLOAT", PACKAGE_CL, new LispFloat(
1411: Double.MIN_VALUE));
1412:
1413: public static final Symbol LEAST_POSITIVE_NORMALIZED_SHORT_FLOAT = exportConstant(
1414: "LEAST-POSITIVE-NORMALIZED-SHORT-FLOAT", PACKAGE_CL,
1415: new LispFloat(Double.MIN_VALUE));
1416:
1417: public static final Symbol LEAST_POSITIVE_NORMALIZED_SINGLE_FLOAT = exportConstant(
1418: "LEAST-POSITIVE-NORMALIZED-SINGLE-FLOAT", PACKAGE_CL,
1419: new LispFloat(Double.MIN_VALUE));
1420:
1421: public static final Symbol LEAST_POSITIVE_NORMALIZED_DOUBLE_FLOAT = exportConstant(
1422: "LEAST-POSITIVE-NORMALIZED-DOUBLE-FLOAT", PACKAGE_CL,
1423: new LispFloat(Double.MIN_VALUE));
1424:
1425: public static final Symbol LEAST_POSITIVE_NORMALIZED_LONG_FLOAT = exportConstant(
1426: "LEAST-POSITIVE-NORMALIZED-LONG-FLOAT", PACKAGE_CL,
1427: new LispFloat(Double.MIN_VALUE));
1428:
1429: public static final Symbol MOST_NEGATIVE_SHORT_FLOAT = exportConstant(
1430: "MOST-NEGATIVE-SHORT-FLOAT", PACKAGE_CL, new LispFloat(
1431: -Double.MAX_VALUE));
1432:
1433: public static final Symbol MOST_NEGATIVE_SINGLE_FLOAT = exportConstant(
1434: "MOST-NEGATIVE-SINGLE-FLOAT", PACKAGE_CL, new LispFloat(
1435: -Double.MAX_VALUE));
1436:
1437: public static final Symbol MOST_NEGATIVE_DOUBLE_FLOAT = exportConstant(
1438: "MOST-NEGATIVE-DOUBLE-FLOAT", PACKAGE_CL, new LispFloat(
1439: -Double.MAX_VALUE));
1440:
1441: public static final Symbol MOST_NEGATIVE_LONG_FLOAT = exportConstant(
1442: "MOST-NEGATIVE-LONG-FLOAT", PACKAGE_CL, new LispFloat(
1443: -Double.MAX_VALUE));
1444:
1445: public static final Symbol LEAST_NEGATIVE_SHORT_FLOAT = exportConstant(
1446: "LEAST-NEGATIVE-SHORT-FLOAT", PACKAGE_CL, new LispFloat(
1447: -Double.MIN_VALUE));
1448:
1449: public static final Symbol LEAST_NEGATIVE_SINGLE_FLOAT = exportConstant(
1450: "LEAST-NEGATIVE-SINGLE-FLOAT", PACKAGE_CL, new LispFloat(
1451: -Double.MIN_VALUE));
1452:
1453: public static final Symbol LEAST_NEGATIVE_DOUBLE_FLOAT = exportConstant(
1454: "LEAST-NEGATIVE-DOUBLE-FLOAT", PACKAGE_CL, new LispFloat(
1455: -Double.MIN_VALUE));
1456:
1457: public static final Symbol LEAST_NEGATIVE_LONG_FLOAT = exportConstant(
1458: "LEAST-NEGATIVE-LONG-FLOAT", PACKAGE_CL, new LispFloat(
1459: -Double.MIN_VALUE));
1460:
1461: public static final Symbol LEAST_NEGATIVE_NORMALIZED_SHORT_FLOAT = exportConstant(
1462: "LEAST-NEGATIVE-NORMALIZED-SHORT-FLOAT", PACKAGE_CL,
1463: new LispFloat(-Double.MIN_VALUE));
1464:
1465: public static final Symbol LEAST_NEGATIVE_NORMALIZED_SINGLE_FLOAT = exportConstant(
1466: "LEAST-NEGATIVE-NORMALIZED-SINGLE-FLOAT", PACKAGE_CL,
1467: new LispFloat(-Double.MIN_VALUE));
1468:
1469: public static final Symbol LEAST_NEGATIVE_NORMALIZED_DOUBLE_FLOAT = exportConstant(
1470: "LEAST-NEGATIVE-NORMALIZED-DOUBLE-FLOAT", PACKAGE_CL,
1471: new LispFloat(-Double.MIN_VALUE));
1472:
1473: public static final Symbol LEAST_NEGATIVE_NORMALIZED_LONG_FLOAT = exportConstant(
1474: "LEAST-NEGATIVE-NORMALIZED-LONG-FLOAT", PACKAGE_CL,
1475: new LispFloat(-Double.MIN_VALUE));
1476:
1477: // ### *saved-backtrace*
1478: public static final Symbol _SAVED_BACKTRACE_ = exportSpecial(
1479: "*SAVED-BACKTRACE*", PACKAGE_EXT, NIL);
1480:
1481: private static final void loadClass(String className) {
1482: try {
1483: Class.forName(className);
1484: } catch (ClassNotFoundException e) {
1485: e.printStackTrace();
1486: }
1487: }
1488:
1489: static {
1490: loadClass("org.armedbear.lisp.Primitives");
1491: loadClass("org.armedbear.lisp.SpecialOperators");
1492: loadClass("org.armedbear.lisp.Extensions");
1493: loadClass("org.armedbear.lisp.Java");
1494: loadClass("org.armedbear.lisp.CompiledFunction");
1495: loadClass("org.armedbear.lisp.Autoload");
1496: loadClass("org.armedbear.lisp.AutoloadMacro");
1497: loadClass("org.armedbear.lisp.cxr");
1498: loadClass("org.armedbear.lisp.Do");
1499: loadClass("org.armedbear.lisp.dolist");
1500: loadClass("org.armedbear.lisp.dotimes");
1501: }
1502: }
|