0001: /**
0002: * Jatha - a Common LISP-compatible LISP library in Java.
0003: * Copyright (C) 1997-2005 Micheal Scott Hewett
0004: *
0005: * This library is free software; you can redistribute it and/or
0006: * modify it under the terms of the GNU Lesser General Public
0007: * License as published by the Free Software Foundation; either
0008: * version 2.1 of the License, or (at your option) any later version.
0009: *
0010: * This library is distributed in the hope that it will be useful,
0011: * but WITHOUT ANY WARRANTY; without even the implied warranty of
0012: * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
0013: * Lesser General Public License for more details.
0014: *
0015: * You should have received a copy of the GNU Lesser General Public
0016: * License along with this library; if not, write to the Free Software
0017: * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
0018: *
0019: *
0020: * For further information, please contact Micheal Hewett at
0021: * hewett@cs.stanford.edu
0022: *
0023: */package org.jatha;
0024:
0025: import java.awt.event.ActionEvent;
0026: import java.awt.event.ActionListener;
0027: import java.io.BufferedReader;
0028: import java.io.EOFException;
0029: import java.io.FileNotFoundException;
0030: import java.io.FileReader;
0031: import java.io.IOException;
0032: import java.io.InputStream;
0033: import java.io.InputStreamReader;
0034: import java.io.PrintStream;
0035: import java.io.PrintWriter;
0036: import java.io.Reader;
0037: import java.io.StringReader;
0038: import java.io.StringWriter;
0039: import java.math.BigInteger;
0040: import java.text.DecimalFormat;
0041: import java.text.NumberFormat;
0042: import java.util.Collection;
0043: import java.util.Iterator;
0044: import java.util.jar.JarEntry;
0045: import java.util.jar.JarFile;
0046:
0047: import org.jatha.compile.CompilerException;
0048: import org.jatha.compile.LispCompiler;
0049: import org.jatha.display.Listener;
0050: import org.jatha.dynatype.LispAlreadyDefinedPackageException;
0051: import org.jatha.dynatype.LispBignum;
0052: import org.jatha.dynatype.LispCons;
0053: import org.jatha.dynatype.LispConsOrNil;
0054: import org.jatha.dynatype.LispConstant;
0055: import org.jatha.dynatype.LispException;
0056: import org.jatha.dynatype.LispInteger;
0057: import org.jatha.dynatype.LispKeyword;
0058: import org.jatha.dynatype.LispNil;
0059: import org.jatha.dynatype.LispNumber;
0060: import org.jatha.dynatype.LispPackage;
0061: import org.jatha.dynatype.LispReal;
0062: import org.jatha.dynatype.LispString;
0063: import org.jatha.dynatype.LispSymbol;
0064: import org.jatha.dynatype.LispUndefinedFunctionException;
0065: import org.jatha.dynatype.LispValue;
0066: import org.jatha.dynatype.StandardLispBignum;
0067: import org.jatha.dynatype.StandardLispCharacter;
0068: import org.jatha.dynatype.StandardLispCons;
0069: import org.jatha.dynatype.StandardLispConstant;
0070: import org.jatha.dynatype.StandardLispInteger;
0071: import org.jatha.dynatype.StandardLispKeyword;
0072: import org.jatha.dynatype.StandardLispNIL;
0073: import org.jatha.dynatype.StandardLispPackage;
0074: import org.jatha.dynatype.StandardLispReal;
0075: import org.jatha.dynatype.StandardLispString;
0076: import org.jatha.dynatype.StandardLispSymbol;
0077: import org.jatha.eval.LispEvaluator;
0078: import org.jatha.machine.SECDMachine;
0079: import org.jatha.read.LispParser;
0080: import org.jatha.util.SymbolTable;
0081:
0082: // * @date Thu Feb 6 09:24:18 1997
0083: /**
0084: * Jatha is an Applet supporting a subset of Common LISP,
0085: * with extensions to support some features of Java
0086: * such as networking and graphical interfaces.
0087: * <p>
0088: * Usage: java org.jatha.Jatha [-nodisplay] [-help]
0089: * </p>
0090: * @author Micheal S. Hewett hewett@cs.stanford.edu
0091: *
0092: */
0093: public class Jatha extends Object implements ActionListener {
0094: private static boolean DEBUG = false;
0095:
0096: // 1.2a 14 May 1997
0097: // 1.3a 03 Oct 2002
0098: // 1.3b 01 January 2003
0099: private String VERSION_NAME = "Jatha";
0100: private int VERSION_MAJOR = 2;
0101: private int VERSION_MINOR = 8;
0102: private int VERSION_MICRO = 0;
0103: private String VERSION_TYPE = "";
0104: private String VERSION_DATE = "25 Apr 2007";
0105: private String VERSION_URL = "http://jatha.sourceforge.net/";
0106:
0107: // @author Micheal S. Hewett hewett@cs.stanford.edu
0108: // @date Thu Feb 6 09:26:00 1997
0109: // @version 1.0
0110: /**
0111: * EVAL is a pointer to a LISP evaluator.
0112: * Used for evaluating LISP expressions in Java code.
0113: *
0114: */
0115: public LispEvaluator EVAL;
0116:
0117: // * @author Micheal S. Hewett hewett@cs.stanford.edu
0118: // * @date Thu Feb 6 09:26:00 1997
0119: /**
0120: * PACKAGE is a pointer to the current package (*package*).
0121: * Its SYMTAB is always the curent SYMTAB of Jatha.
0122: *
0123: * @see org.jatha.dynatype.LispPackage
0124: */
0125: public LispPackage PACKAGE;
0126: public LispValue PACKAGE_SYMBOL; // ptr to *package*
0127:
0128: // @author Micheal S. Hewett hewett@cs.stanford.edu
0129: // @date Thu Feb 6 09:26:00 1997
0130: /**
0131: * SYMTAB is a pointer to the namespace used by LISP.
0132: * Needed for initialization of the parser. It is
0133: * always the SYMTAB of the current PACKAGE;
0134: *
0135: * @see org.jatha.dynatype.LispPackage
0136: */
0137: public SymbolTable SYMTAB; //TODO: fix so that this is ALWAYS correct, in some way.
0138:
0139: // @author Micheal S. Hewett hewett@cs.stanford.edu
0140: // @date Thu Feb 6 09:26:00 1997
0141: /**
0142: * MACHINE is a pointer to the primary SECD abstract machine
0143: * used for executing compiled LISP code.
0144: *
0145: * @see org.jatha.machine.SECDMachine
0146: */
0147: public SECDMachine MACHINE;
0148:
0149: // @author Micheal S. Hewett hewett@cs.stanford.edu
0150: // @date Thu Feb 6 09:26:00 1997
0151: /**
0152: * COMPILER is a pointer to a LispCompiler.
0153: *
0154: * @see org.jatha.compile.LispCompiler
0155: */
0156: public LispCompiler COMPILER;
0157:
0158: // @author Micheal S. Hewett hewett@cs.stanford.edu
0159: // @date Thu Feb 6 09:26:00 1997
0160: /**
0161: * SYSTEM_INFO is a pointer to the Runtime object
0162: * for this Applet.
0163: *
0164: * @see java.lang.Runtime
0165: */
0166: public final Runtime SYSTEM_INFO = Runtime.getRuntime();
0167:
0168: // @author Micheal S. Hewett hewett@cs.stanford.edu
0169: // @date Thu Feb 6 09:26:00 1997
0170: /**
0171: * PARSER is a pointer to the main parser
0172: * used by Jatha. Others may be instantiated to
0173: * deal with String or Stream input.
0174: *
0175: * @see org.jatha.read.LispParser
0176: *
0177: */
0178: public LispParser PARSER;
0179:
0180: // @author Micheal S. Hewett hewett@cs.stanford.edu
0181: // @date Thu Feb 6 09:26:00 1997
0182: /**
0183: * Listener is a pointer to the I/O Window.
0184: *
0185: * @see org.jatha.display.Listener
0186: */
0187: public Listener LISTENER;
0188:
0189: // @author Micheal S. Hewett hewett@cs.stanford.edu
0190: // @date Thu Feb 6 09:26:00 1997
0191: /**
0192: * JATHA is a pointer to the Applet.
0193: */
0194:
0195: public static int APROPOS_TAB = 30;
0196:
0197: // The '.' to represent a cons cell.
0198: public LispValue DOT;
0199:
0200: // The list/symbol NIL.
0201: public LispConsOrNil NIL;
0202:
0203: // These are used in macros
0204: public LispValue QUOTE;
0205: public LispValue BACKQUOTE;
0206: public LispValue LIST;
0207: public LispValue APPEND;
0208: public LispValue CONS;
0209: public LispValue COMMA_FN;
0210: public LispValue COMMA_ATSIGN_FN;
0211: public LispValue COMMA_DOT_FN;
0212:
0213: public LispValue COLON;
0214: public LispValue NEWLINE;
0215: public LispValue SPACE;
0216:
0217: // Used in CONCATENATE
0218: public LispValue STRING;
0219:
0220: // Used in the compiler
0221: public LispValue ZERO;
0222: public LispValue ONE;
0223: public LispValue TWO;
0224:
0225: // Math constants
0226: public LispValue PI;
0227: public LispValue E;
0228:
0229: // The symbol T
0230: public LispValue T;
0231:
0232: // Types
0233: public LispValue ARRAY_TYPE;
0234: public LispValue ATOM_TYPE;
0235: public LispValue BIGNUM_TYPE;
0236: public LispValue BOOLEAN_TYPE;
0237: public LispValue CHARACTER_TYPE;
0238: public LispValue COMPLEX_TYPE;
0239: public LispValue CONS_TYPE;
0240: public LispValue DOUBLE_FLOAT_TYPE;
0241: public LispValue FLOAT_TYPE;
0242: public LispValue FUNCTION_TYPE;
0243: public LispValue HASHTABLE_TYPE;
0244: public LispValue INTEGER_TYPE;
0245: public LispValue MACRO_TYPE;
0246: public LispValue NULL_TYPE;
0247: public LispValue NUMBER_TYPE;
0248: public LispValue PACKAGE_TYPE;
0249: public LispValue PATHNAME_TYPE;
0250: public LispValue REAL_TYPE;
0251: public LispValue STREAM_TYPE;
0252: public LispValue STRING_TYPE;
0253: public LispValue SYMBOL_TYPE;
0254: public LispValue VECTOR_TYPE;
0255:
0256: /**
0257: * This is used in apropos_print on StandardLispSymbol.
0258: * Not really for public consumption.
0259: * @param object a LispSymbol
0260: * @return true if it is equal to ARRAY_TYPE, ATOM_TYPE, etc.
0261: */
0262: public boolean isType(LispValue object) {
0263: return ((object == ARRAY_TYPE) || (object == ATOM_TYPE)
0264: || (object == BIGNUM_TYPE) || (object == BOOLEAN_TYPE)
0265: || (object == CHARACTER_TYPE)
0266: || (object == COMPLEX_TYPE) || (object == CONS_TYPE)
0267: || (object == DOUBLE_FLOAT_TYPE)
0268: || (object == FLOAT_TYPE) || (object == FUNCTION_TYPE)
0269: || (object == HASHTABLE_TYPE)
0270: || (object == INTEGER_TYPE) || (object == MACRO_TYPE)
0271: || (object == NUMBER_TYPE) || (object == NULL_TYPE)
0272: || (object == PACKAGE_TYPE)
0273: || (object == PATHNAME_TYPE) || (object == REAL_TYPE)
0274: || (object == STREAM_TYPE) || (object == STRING_TYPE)
0275: || (object == SYMBOL_TYPE) || (object == VECTOR_TYPE));
0276: }
0277:
0278: private LispPackage f_systemPackage = null;
0279: private LispPackage f_keywordPackage = null;
0280:
0281: private void initializeConstants() {
0282: try {
0283: if (SYMTAB == null) {
0284: System.err.println("In LispValue, symtab is null!");
0285: throw new Exception(
0286: "In LispValue init, symtab is null!");
0287: }
0288: } catch (Exception e) {
0289: System.out.println(e);
0290: e.printStackTrace();
0291: }
0292:
0293: f_systemPackage = new StandardLispPackage(this ,
0294: makeString("SYSTEM"));
0295: f_keywordPackage = new StandardLispPackage(this ,
0296: makeString("KEYWORD"));
0297:
0298: DOT = new StandardLispSymbol(this , ".");
0299: EVAL.intern(makeString("DOT"), DOT, f_systemPackage);
0300:
0301: NIL = new StandardLispNIL(this , "NIL");
0302: EVAL.intern(makeString("NIL"), NIL, f_systemPackage);
0303:
0304: QUOTE = new StandardLispSymbol(this , "QUOTE");
0305: EVAL.intern(makeString("QUOTE"), QUOTE, f_systemPackage);
0306:
0307: BACKQUOTE = new StandardLispSymbol(this , "BACKQUOTE");
0308: EVAL
0309: .intern(makeString("BACKQUOTE"), BACKQUOTE,
0310: f_systemPackage);
0311:
0312: LIST = new StandardLispSymbol(this , "LIST");
0313: EVAL.intern(makeString("LIST"), LIST, f_systemPackage);
0314:
0315: APPEND = new StandardLispSymbol(this , "APPEND");
0316: EVAL.intern(makeString("APPEND"), APPEND, f_systemPackage);
0317:
0318: CONS = new StandardLispSymbol(this , "CONS");
0319: EVAL.intern(makeString("CONS"), CONS, f_systemPackage);
0320:
0321: COMMA_FN = new StandardLispKeyword(this , "COMMA");
0322: EVAL.intern(makeString("COMMA"), COMMA_FN, f_keywordPackage);
0323:
0324: COMMA_ATSIGN_FN = new StandardLispKeyword(this , "COMMA-ATSIGN");
0325: EVAL.intern(makeString("COMMA-ATSIGN"), COMMA_ATSIGN_FN,
0326: f_keywordPackage);
0327:
0328: COMMA_DOT_FN = new StandardLispKeyword(this , "COMMA-DOT");
0329: EVAL.intern(makeString("COMMA-DOT"), COMMA_DOT_FN,
0330: f_keywordPackage);
0331:
0332: T = new StandardLispConstant(this , "T");
0333: EVAL.intern(makeString("T"), T, f_systemPackage);
0334: T.setf_symbol_value(T);
0335:
0336: ZERO = new StandardLispInteger(this , 0);
0337: ONE = new StandardLispInteger(this , 1);
0338: TWO = new StandardLispInteger(this , 2);
0339:
0340: E = new StandardLispReal(this , StrictMath.E);
0341: PI = new StandardLispReal(this , StrictMath.PI);
0342:
0343: COLON = new StandardLispCharacter(this , ':');
0344: NEWLINE = new StandardLispCharacter(this , '\n');
0345: SPACE = new StandardLispCharacter(this , ' ');
0346:
0347: STRING = new StandardLispSymbol(this , "STRING");
0348: EVAL.intern(makeString("STRING"), STRING, f_systemPackage);
0349:
0350: // Lisp data types --------------------------------------------
0351:
0352: ARRAY_TYPE = new StandardLispSymbol(this , "ARRAY");
0353: EVAL.intern(makeString("ARRAY"), ARRAY_TYPE, f_systemPackage);
0354:
0355: ATOM_TYPE = new StandardLispSymbol(this , "ATOM");
0356: EVAL.intern(makeString("ATOM"), ATOM_TYPE, f_systemPackage);
0357:
0358: BIGNUM_TYPE = new StandardLispSymbol(this , "BIGNUM");
0359: EVAL.intern(makeString("BIGNUM"), BIGNUM_TYPE, f_systemPackage);
0360:
0361: BOOLEAN_TYPE = new StandardLispSymbol(this , "BOOLEAN");
0362: EVAL.intern(makeString("BOOLEAN"), BOOLEAN_TYPE,
0363: f_systemPackage);
0364:
0365: CHARACTER_TYPE = new StandardLispSymbol(this , "CHARACTER");
0366: EVAL.intern(makeString("CHARACTER"), CHARACTER_TYPE,
0367: f_systemPackage);
0368:
0369: COMPLEX_TYPE = new StandardLispSymbol(this , "COMPLEX");
0370: EVAL.intern(makeString("COMPLEX"), COMPLEX_TYPE,
0371: f_systemPackage);
0372:
0373: CONS_TYPE = new StandardLispSymbol(this , "CONS");
0374: EVAL.intern(makeString("CONS"), CONS_TYPE, f_systemPackage);
0375:
0376: DOUBLE_FLOAT_TYPE = new StandardLispSymbol(this , "DOUBLE-FLOAT");
0377: EVAL.intern(makeString("DOUBLE-FLOAT"), DOUBLE_FLOAT_TYPE,
0378: f_systemPackage);
0379:
0380: FLOAT_TYPE = new StandardLispSymbol(this , "FLOAT");
0381: EVAL.intern(makeString("FLOAT"), FLOAT_TYPE, f_systemPackage);
0382:
0383: FUNCTION_TYPE = new StandardLispSymbol(this , "FUNCTION");
0384: EVAL.intern(makeString("FUNCTION"), FUNCTION_TYPE,
0385: f_systemPackage);
0386:
0387: HASHTABLE_TYPE = new StandardLispSymbol(this , "HASH-TABLE");
0388: EVAL.intern(makeString("TABLE"), HASHTABLE_TYPE,
0389: f_systemPackage);
0390:
0391: INTEGER_TYPE = new StandardLispSymbol(this , "INTEGER");
0392: EVAL.intern(makeString("INTEGER"), INTEGER_TYPE,
0393: f_systemPackage);
0394:
0395: NULL_TYPE = new StandardLispSymbol(this , "NULL");
0396: EVAL.intern(makeString("NULL"), NULL_TYPE, f_systemPackage);
0397:
0398: MACRO_TYPE = new StandardLispSymbol(this , "MACRO");
0399: EVAL.intern(makeString("MACRO"), NULL_TYPE, f_systemPackage);
0400:
0401: NUMBER_TYPE = new StandardLispSymbol(this , "NUMBER");
0402: EVAL.intern(makeString("NUMBER"), NUMBER_TYPE, f_systemPackage);
0403:
0404: PACKAGE_TYPE = new StandardLispSymbol(this , "PACKAGE");
0405: EVAL.intern(makeString("PACKAGE"), PACKAGE_TYPE,
0406: f_systemPackage);
0407:
0408: PATHNAME_TYPE = new StandardLispSymbol(this , "PATHNAME");
0409: EVAL.intern(makeString("PATHNAME"), PATHNAME_TYPE,
0410: f_systemPackage);
0411:
0412: REAL_TYPE = new StandardLispSymbol(this , "REAL");
0413: EVAL.intern(makeString("REAL"), REAL_TYPE, f_systemPackage);
0414:
0415: STREAM_TYPE = new StandardLispSymbol(this , "STREAM");
0416: EVAL.intern(makeString("STREAM"), STREAM_TYPE, f_systemPackage);
0417:
0418: STRING_TYPE = new StandardLispSymbol(this , "STRING");
0419: EVAL.intern(makeString("STRING"), STRING_TYPE, f_systemPackage);
0420:
0421: SYMBOL_TYPE = new StandardLispSymbol(this , "SYMBOL");
0422: EVAL.intern(makeString("SYMBOL"), SYMBOL_TYPE, f_systemPackage);
0423:
0424: VECTOR_TYPE = new StandardLispSymbol(this , "VECTOR");
0425: EVAL.intern(makeString("VECTOR"), VECTOR_TYPE, f_systemPackage);
0426:
0427: }
0428:
0429: // Re-initializes the above symbols, after a PACKAGE is available.
0430: public void initConstants2() {
0431: if (SYMTAB == null) {
0432: System.err.println("In LispValue.init(), symtab is null!");
0433: System.exit(1);
0434: }
0435:
0436: if (PACKAGE == null) {
0437: System.err.println("In LispValue.init(), package is null!");
0438: System.exit(1);
0439: }
0440:
0441: f_systemPackage.export(DOT);
0442: f_systemPackage.export(NIL);
0443: f_systemPackage.export(QUOTE);
0444: f_systemPackage.export(BACKQUOTE);
0445: f_systemPackage.export(T);
0446: f_systemPackage.export(LIST);
0447: f_systemPackage.export(APPEND);
0448: f_systemPackage.export(CONS);
0449: f_keywordPackage.export(COMMA_FN);
0450: f_keywordPackage.export(COMMA_ATSIGN_FN);
0451: f_keywordPackage.export(COMMA_DOT_FN);
0452: f_systemPackage.export(ARRAY_TYPE);
0453: f_systemPackage.export(ATOM_TYPE);
0454: f_systemPackage.export(BIGNUM_TYPE);
0455: f_systemPackage.export(BOOLEAN_TYPE);
0456: f_systemPackage.export(CHARACTER_TYPE);
0457: f_systemPackage.export(COMPLEX_TYPE);
0458: f_systemPackage.export(CONS_TYPE);
0459: f_systemPackage.export(DOUBLE_FLOAT_TYPE);
0460: f_systemPackage.export(FLOAT_TYPE);
0461: f_systemPackage.export(FUNCTION_TYPE);
0462: f_systemPackage.export(HASHTABLE_TYPE);
0463: f_systemPackage.export(INTEGER_TYPE);
0464: f_systemPackage.export(MACRO_TYPE);
0465: f_systemPackage.export(NULL_TYPE);
0466: f_systemPackage.export(NUMBER_TYPE);
0467: f_systemPackage.export(PACKAGE_TYPE);
0468: f_systemPackage.export(PATHNAME_TYPE);
0469: f_systemPackage.export(REAL_TYPE);
0470: f_systemPackage.export(STREAM_TYPE);
0471: f_systemPackage.export(STRING_TYPE);
0472: f_systemPackage.export(SYMBOL_TYPE);
0473: f_systemPackage.export(VECTOR_TYPE);
0474:
0475: }
0476:
0477: /* ------------------ PRIVATE VARIABLES ------------------------------ */
0478:
0479: LispValue prompt, userPrompt;
0480: LispValue packages = null;
0481:
0482: LispValue STAR, STARSTAR, STARSTARSTAR;
0483: LispValue MAX_LIST_LENGTH;
0484: LispValue LOAD_VERBOSE;
0485:
0486: static long MAX_LIST_LENGTH_VALUE = 50000;
0487:
0488: boolean useGUI = true; // Whether or not to use GUI-based interaction.
0489: boolean useConsole = false; // Whether or not to use command-line interaction.
0490:
0491: /* ------------------ CONSTRUCTORS ------------------------------ */
0492:
0493: /**
0494: * Create a new Jatha that does not use the GUI, does use the console for I/O and does not display help.
0495: */
0496: public Jatha() {
0497: this (false, true, false);
0498: }
0499:
0500: /**
0501: * Create a new Jatha that optionally uses the GUI, does use the console for I/O and does not display help.
0502: */
0503: public Jatha(boolean useGui) {
0504: this (useGui, false, false);
0505: }
0506:
0507: /**
0508: * Create a new Jatha that optionally uses the GUI, optionally uses the console for I/O and does not display help.
0509: */
0510: public Jatha(boolean useGui, boolean useText) {
0511: this (useGui, useText, false);
0512: }
0513:
0514: /**
0515: * Create a new Jatha that optionally uses the GUI, optionally uses the console for I/O and optionally displays help.
0516: */
0517: public Jatha(boolean useDisplay, boolean useText, boolean showHelp) {
0518: super ();
0519:
0520: try {
0521: useGUI = useDisplay;
0522: useConsole = useText;
0523:
0524: if (showHelp)
0525: showHelp();
0526: } catch (Throwable e) {
0527: System.err.println("error initializing Jatha: " + e);
0528: }
0529: }
0530:
0531: /* ------------------ NON-LISP methods ------------------------------ */
0532:
0533: /**
0534: * Returns the entire version string.
0535: * @return a string containing the entire description of Algernon.
0536: */
0537: public String getVersionString() {
0538: return getVersionName() + " " + getVersionMajor() + "."
0539: + getVersionMinor() + "." + getVersionMicro()
0540: + getVersionType() + ", " + getVersionDate()
0541: + ", contact: " + getVersionURL();
0542: }
0543:
0544: /**
0545: * Returns the program name, e.g. Algernon.
0546: */
0547: public String getVersionName() {
0548: return VERSION_NAME;
0549: };
0550:
0551: /**
0552: * Returns the date of this version as a string: "nn MONTH yyyy".
0553: */
0554: public String getVersionDate() {
0555: return VERSION_DATE;
0556: };
0557:
0558: /**
0559: * Returns a URL where you can find info about Algernon.
0560: */
0561: public String getVersionURL() {
0562: return VERSION_URL;
0563: };
0564:
0565: /**
0566: * Returns the type of release: "production", "beta" or "alpha".
0567: */
0568: public String getVersionType() {
0569: return VERSION_TYPE;
0570: };
0571:
0572: /**
0573: * Returns the major version number, that is, 1 in version 1.2.3.
0574: */
0575: public int getVersionMajor() {
0576: return VERSION_MAJOR;
0577: };
0578:
0579: /**
0580: * Returns the minor version number, that is, 2 in version 1.2.3.
0581: */
0582: public int getVersionMinor() {
0583: return VERSION_MINOR;
0584: };
0585:
0586: /**
0587: * Returns the micro version number, that is, 3 in version 1.2.3.
0588: */
0589: public int getVersionMicro() {
0590: return VERSION_MICRO;
0591: };
0592:
0593: void showHelp() {
0594: System.out
0595: .println("\njava org.jatha.Jatha [-help] [-nodisplay]\n");
0596: System.out
0597: .println(" This is a small Common LISP compatible LISP environment.");
0598: System.out
0599: .println(" Use the -nodisplay option to suppress GUI features.");
0600: System.out.println("");
0601: System.exit(0);
0602: }
0603:
0604: /**
0605: * Returns the value of *MAX-LIST-LENGTH*.
0606: * This value is only used to prevent runaway list processing.
0607: */
0608: public LispInteger getMaxListLength() {
0609: return (LispInteger) (MAX_LIST_LENGTH.symbol_value());
0610: }
0611:
0612: /**
0613: * Sets the value of *MAX-LIST-LENGTH*.
0614: * This vlaue is only used to prevent runaway list processing.
0615: */
0616: public void setMaxListLength(long newLength) {
0617: MAX_LIST_LENGTH.setf_symbol_value(new StandardLispInteger(this ,
0618: newLength));
0619: }
0620:
0621: /**
0622: * Sets the value of *MAX-LIST-LENGTH*.
0623: * This vlaue is only used to prevent runaway list processing.
0624: */
0625: public void setMaxListLength(LispNumber newLength) {
0626: MAX_LIST_LENGTH.setf_symbol_value(new StandardLispInteger(this ,
0627: (long) (newLength.getDoubleValue())));
0628: }
0629:
0630: /**
0631: * With no arguments, creates a Jatha LISP Listener window
0632: * and enables the Console I/O stream. The user can optionally
0633: * specify -nodisplay to use the console for input.
0634: *
0635: * @param args
0636: */
0637: public static void main(String args[]) {
0638: Jatha applet;
0639:
0640: boolean useDisplay = true;
0641: boolean help = false;
0642: boolean illegalArg = false;
0643:
0644: for (int i = 0; i < args.length; i++)
0645: if (args[i].equalsIgnoreCase("-nodisplay"))
0646: useDisplay = false;
0647: else if (args[i].equalsIgnoreCase("-help"))
0648: help = true;
0649: else {
0650: System.out.println("Jatha: unknown argument: "
0651: + args[i]);
0652: illegalArg = true;
0653: }
0654:
0655: if (illegalArg)
0656: System.exit(1);
0657:
0658: // Okay to proceed. Make a text window if we are to use a GUI.
0659: applet = new Jatha(useDisplay, true, help);
0660: applet.init();
0661: applet.start();
0662: }
0663:
0664: public void init() {
0665:
0666: // EVAL must be before SYMTAB.
0667: EVAL = new LispEvaluator(this );
0668:
0669: SYMTAB = new SymbolTable(this );
0670:
0671: initializeConstants();
0672:
0673: // Have to be careful about initializing this...
0674:
0675: f_systemPackage.setNicknames(makeList(makeString("SYS")));
0676: f_keywordPackage.setNicknames(makeList(makeString("")));
0677:
0678: PACKAGE = new StandardLispPackage(this ,
0679: makeString("COMMON-LISP-USER"), makeList(
0680: makeString("CL-USER"), makeString("USER")),
0681: NIL, SYMTAB);
0682: final LispPackage clPackage = new StandardLispPackage(this ,
0683: makeString("COMMON-LISP"), makeList(makeString("CL")));
0684: PACKAGE.setUses(makeList(((StandardLispPackage) clPackage)
0685: .getName(), ((StandardLispPackage) f_systemPackage)
0686: .getName()));
0687: ((StandardLispPackage) clPackage)
0688: .setUses(makeList(((StandardLispPackage) f_systemPackage)
0689: .getName()));
0690: ((StandardLispPackage) f_keywordPackage).setUses(NIL);
0691: ((StandardLispPackage) f_systemPackage).setUses(NIL);
0692:
0693: // Create the rest of the packages
0694: packages = makeList(f_systemPackage, clPackage,
0695: f_keywordPackage, PACKAGE);
0696:
0697: initConstants2();
0698:
0699: COMPILER = new LispCompiler(this );
0700: MACHINE = new SECDMachine(this );
0701: PARSER = new LispParser(this , new InputStreamReader(System.in));
0702:
0703: // Need to allow *TOP-LEVEL-PROMPT* to change this.
0704: prompt = makeString("Jatha> ");
0705:
0706: STAR = EVAL.intern("*", f_systemPackage);
0707: STARSTAR = EVAL.intern("**", f_systemPackage);
0708: STARSTARSTAR = EVAL.intern("***", f_systemPackage);
0709:
0710: STAR.setf_symbol_value(NIL);
0711: STARSTAR.setf_symbol_value(NIL);
0712: STARSTARSTAR.setf_symbol_value(NIL);
0713:
0714: MAX_LIST_LENGTH = EVAL.intern("*MAX-LIST-LENGTH*",
0715: f_systemPackage);
0716: MAX_LIST_LENGTH.setf_symbol_value(new StandardLispInteger(this ,
0717: MAX_LIST_LENGTH_VALUE));
0718:
0719: f_systemPackage.export(STAR);
0720: f_systemPackage.export(STARSTAR);
0721: f_systemPackage.export(STARSTARSTAR);
0722: f_systemPackage.export(MAX_LIST_LENGTH);
0723:
0724: // Defines global variables, etc. Should only be called once.
0725: EVAL.init();
0726:
0727: PACKAGE_SYMBOL = EVAL.intern("*PACKAGE*");
0728: PACKAGE_SYMBOL.set_special(true); // 13 Dec 2005 (mh)
0729:
0730: LOAD_VERBOSE = EVAL.intern("*LOAD-VERBOSE*");
0731: LOAD_VERBOSE.setf_symbol_value(NIL);
0732:
0733: // Registers LISP primitive functions. Should only be called once.
0734: COMPILER.init();
0735:
0736: // Load any files in the /init directory (mh) 11 May 2005
0737: loadInitFiles();
0738:
0739: if (useGUI)
0740: LISTENER = new Listener(this , "Jatha LISP Listener",
0741: PACKAGE_SYMBOL.symbol_value().toString() + "> ");
0742: }
0743:
0744: public void start() {
0745: // javaTrace(true); // This doesn't seem to do anything...
0746: if (useConsole) {
0747: System.err.println(getVersionString());
0748: }
0749:
0750: if (!useGUI)
0751: if (useConsole)
0752: readEvalPrintLoop();
0753:
0754: // PARSER.simple_parser_test();
0755:
0756: // PARSER.test_parser_loop();
0757:
0758: // TestInterpreter();
0759:
0760: // free();
0761: // gc();
0762: }
0763:
0764: /**
0765: * Loads files in the /init directory in Jatha's jar file.
0766: * They must be named "01.lisp", "02.lisp", etc. Numbers must
0767: * be sequential starting from "01".
0768: */
0769: protected void loadInitFiles() {
0770: NumberFormat fileNF = new DecimalFormat("00");
0771: String filePrefix = "init/";
0772: String fileSuffix = ".lisp";
0773:
0774: if (useConsole) {
0775: System.out.println("Loading init files.");
0776: }
0777:
0778: int fileNumber = 1;
0779: int fileCounter = 0;
0780:
0781: while (true) {
0782: String baseFilename = fileNF.format(fileNumber++)
0783: + fileSuffix;
0784: String filename = filePrefix + baseFilename;
0785: try {
0786: LispValue result = loadFromJar(filename);
0787: if (result == T) {
0788: if (useConsole) {
0789: System.out.println(" loaded " + baseFilename);
0790: }
0791: fileCounter++;
0792: }
0793:
0794: else if (result == NIL) // No such file
0795: break;
0796:
0797: else {
0798: if (useConsole) {
0799: System.err.println(" error loading "
0800: + filename + ", " + result);
0801: }
0802: }
0803: } catch (Exception e) {
0804: System.err.println("Jatha.loadInitFiles: "
0805: + e.getMessage());
0806: break;
0807: }
0808: }
0809:
0810: if (useConsole) {
0811: System.out.println("Loaded " + fileCounter + " file(s).");
0812: }
0813: }
0814:
0815: /**
0816: * Loads a file from the container holding this class.
0817: * The container is normally a JAR file.
0818: * Uses getResource to create a stream, then calls load(Reader).
0819: * @param filename The file to be loaded, without an initial "/". Will be converted to a Java String using toStringSimple.
0820: * @param jarFile The URL of the jar file from which to load the resource.
0821: * @return T if the file was successfully loaded, NIL if the file doesn't exist and a String containing an error message otherwise.
0822: */
0823: public LispValue loadFromJar(LispValue filename, LispValue jarFile) {
0824: return loadFromJar(filename.toStringSimple(), jarFile
0825: .toStringSimple());
0826: }
0827:
0828: /**
0829: * Loads a file from the container holding this class.
0830: * The container is normally a JAR file.
0831: * Uses getResource to create a stream, then calls load(Reader).
0832: * @param filename The file to be loaded, WITHOUT an initial "/".
0833: * @param jarFileString The name of the jar file to load the file from.
0834: * @return T if the file was successfully loaded, NIL if the file doesn't exist and a String containing an error message otherwise.
0835: */
0836: public LispValue loadFromJar(String filename, String jarFileString) {
0837: if (DEBUG)
0838: System.out.println(" Jatha.loadFromJar: looking for "
0839: + filename + " in " + jarFileString);
0840:
0841: try {
0842: JarFile jarFile = new JarFile(jarFileString);
0843: JarEntry je = jarFile.getJarEntry(filename);
0844: if (je == null)
0845: return NIL;
0846:
0847: LispValue result = load(new InputStreamReader(jarFile
0848: .getInputStream(je)));
0849: jarFile.close();
0850: return result;
0851: } catch (IOException ioe) {
0852: return makeString(ioe.getMessage());
0853: } catch (SecurityException se) {
0854: return makeString(se.getMessage());
0855: } catch (CompilerException ce) {
0856: return makeString(ce.getMessage());
0857: } catch (Exception e) {
0858: return makeString(e.getMessage());
0859: }
0860: }
0861:
0862: /**
0863: * Loads a file from the container holding this class.
0864: * The container is normally a JAR file.
0865: * Uses getResource to create a stream, then calls load(Reader).
0866: * @param filename The file to be loaded, without an initial "/". Will be converted to a Java String using toStringSimple.
0867: * @return T if the file was successfully loaded, NIL if the file doesn't exist and a String containing an error message otherwise.
0868: */
0869: public LispValue loadFromJar(LispValue filename) {
0870: return loadFromJar(filename.toStringSimple());
0871: }
0872:
0873: /**
0874: * Loads a file from the container holding this class.
0875: * The container is normally a JAR file.
0876: * Uses getResource to create a stream, then calls load(Reader).
0877: * @param filename The file to be loaded, WITHOUT an initial "/".
0878: * @return T if the file was successfully loaded, NIL if the file doesn't exist and a String containing an error message otherwise.
0879: */
0880: public LispValue loadFromJar(String filename) {
0881: if (DEBUG)
0882: System.out.println(" Jatha.loadFromJar: looking for "
0883: + filename + " in the jar file.");
0884:
0885: InputStream resourceStream = getClass().getClassLoader()
0886: .getResourceAsStream(filename);
0887:
0888: if (resourceStream == null)
0889: return NIL;
0890:
0891: else
0892: try {
0893: load(new InputStreamReader(resourceStream));
0894: return T;
0895: } catch (Exception e) {
0896: return makeString(e.getMessage());
0897: }
0898: }
0899:
0900: /**
0901: * Evaluates a LISP expression in a Java string, such as "(* 5 7)".
0902: * To evaluate an expression with variables, there are several options:
0903: * <pre>
0904: * eval("(let ((x 7)) (* 5 x)))");
0905: * eval("(progn (setq x 7) (* 5 x))");
0906: * </pre>
0907: * Or use separate eval statements:
0908: * <pre>
0909: * eval("setq x 7");
0910: * eval("(* 5 x)");
0911: * </pre>
0912: */
0913: public LispValue eval(String expr) {
0914: LispValue input = NIL;
0915:
0916: // READ
0917: try {
0918: PARSER.setInputString(expr);
0919: input = PARSER.parse();
0920: return eval(input);
0921: } catch (EOFException e) {
0922: System.err.println("Incomplete input.");
0923: return NIL;
0924: }
0925: }
0926:
0927: /**
0928: * Standard LISP eval function.
0929: * @param inValue a parsed LISP expression, such as the output from Jatha.parse().
0930: * @see #parse(String)
0931: */
0932: public LispValue eval(LispValue inValue) {
0933: return eval(inValue, NIL);
0934: }
0935:
0936: /**
0937: * Standard LISP eval function.
0938: * @param inValue a parsed LISp expression such as the output from Jatha.parse()
0939: * @param vars a nested list of global variables and values, such as (((a . 3) (b . 5)) ((c . 10)))
0940: * @see #parse(String)
0941: */
0942: public LispValue eval(LispValue inValue, final LispValue vars) {
0943: LispValue code, value;
0944:
0945: final LispValue varNames = parseVarNames(vars);
0946: final LispValue varValues = parseVarValues(vars);
0947:
0948: try {
0949: // compile
0950: code = COMPILER.compile(MACHINE, inValue, varNames);
0951:
0952: // eval
0953: value = MACHINE.Execute(code, varValues);
0954: } catch (LispUndefinedFunctionException ufe) {
0955: System.err.println("ERROR: " + ufe.getMessage());
0956: return makeString(ufe.getMessage());
0957: } catch (CompilerException ce) {
0958: System.err.println("ERROR: " + ce);
0959: return makeString(ce.toString());
0960: } catch (LispException le) {
0961: System.err.println("ERROR: " + le.getMessage());
0962: le.printStackTrace();
0963: return makeString(le.getMessage());
0964: } catch (Exception e) {
0965: System.err.println("Unknown error: " + e.getMessage());
0966: return makeString(e.getMessage());
0967: }
0968:
0969: // useful variable management
0970: STARSTARSTAR.setf_symbol_value(STARSTAR.symbol_value());
0971: STARSTAR.setf_symbol_value(STAR.symbol_value());
0972: STAR.setf_symbol_value(value);
0973:
0974: return value;
0975: }
0976:
0977: /**
0978: * Expects a list with this format (((A 13) (C 7))((X "Zeta"))) and returns a list with this format ((A C)(X))
0979: */
0980: private LispValue parseVarNames(final LispValue vars) {
0981: LispValue outp = NIL;
0982: if (vars.basic_null())
0983: return outp;
0984:
0985: for (final Iterator iter = vars.iterator(); iter.hasNext();) {
0986: final LispValue current = (LispValue) iter.next();
0987: LispValue inner = NIL;
0988: for (final Iterator iter2 = current.iterator(); iter2
0989: .hasNext();) {
0990: final LispValue currInt = (LispValue) iter2.next();
0991: inner = makeCons(currInt.car(), inner);
0992: }
0993: outp = makeCons(inner.nreverse(), outp);
0994: }
0995: return outp.nreverse();
0996: }
0997:
0998: /**
0999: * Not sure why parseVarNames has such a complicated structure.
1000: * This one expects variables of the form ((A . 7) (B . 13) (C . (foo)))
1001: * the CAR of each pair is the variable and the CDR of each pair is the value.
1002: */
1003: private LispValue parseVarNames_new(final LispValue vars) {
1004: LispValue outp = NIL;
1005: if (vars.basic_null())
1006: return outp;
1007:
1008: for (final Iterator iter = vars.iterator(); iter.hasNext();) {
1009: final LispValue current = (LispValue) iter.next();
1010: outp = makeCons(current.car(), outp);
1011: }
1012: return outp.nreverse();
1013: }
1014:
1015: /**
1016: * Not sure why parseVarNames has such a complicated structure.
1017: * This one expects variables of the form ((A . 7) (B . 13) (C . (foo)))
1018: * the CAR of each pair is the variable and the CDR of each pair is the value.
1019: */
1020: private LispValue parseVarValues_new(final LispValue vars) {
1021: LispValue outp = NIL;
1022: if (vars.basic_null())
1023: return outp;
1024:
1025: for (final Iterator iter = vars.iterator(); iter.hasNext();) {
1026: final LispValue current = (LispValue) iter.next();
1027: outp = makeCons(current.cdr(), outp);
1028: }
1029: return outp.nreverse();
1030: }
1031:
1032: /**
1033: * Expects a list with this format (((A 13) (C 7))((X "Zeta"))) and returns a list with this format ((13 7)("Zeta"))
1034: */
1035: private LispValue parseVarValues(final LispValue vars) {
1036: LispValue outp = NIL;
1037: if (vars.basic_null())
1038: return outp;
1039:
1040: for (final Iterator iter = vars.iterator(); iter.hasNext();) {
1041: final LispValue current = (LispValue) iter.next();
1042: LispValue inner = NIL;
1043: for (final Iterator iter2 = current.iterator(); iter2
1044: .hasNext();) {
1045: final LispValue currInt = (LispValue) iter2.next();
1046: inner = makeCons(currInt.cdr(), inner);
1047: }
1048: outp = makeCons(inner.nreverse(), outp);
1049: }
1050: return outp.nreverse();
1051: }
1052:
1053: void readEvalPrintLoop() {
1054: LispValue input, code, value, prompt;
1055: LispValue STAR, STARSTAR, STARSTARSTAR;
1056: boolean validInput;
1057: LispValue oldPackageSymbolValue = PACKAGE_SYMBOL.symbol_value();
1058:
1059: // Need to allow *TOP-LEVEL-PROMPT* to change this.
1060: prompt = makeString("Jatha "
1061: + PACKAGE_SYMBOL.symbol_value().toString() + "> ");
1062:
1063: STAR = EVAL.intern("*");
1064: STARSTAR = EVAL.intern("**");
1065: STARSTARSTAR = EVAL.intern("***");
1066:
1067: STAR.setf_symbol_value(NIL);
1068: STARSTAR.setf_symbol_value(NIL);
1069: STARSTARSTAR.setf_symbol_value(NIL);
1070:
1071: System.out.println("Run (EXIT) to stop.");
1072:
1073: input = NIL;
1074:
1075: while (true) {
1076: if (oldPackageSymbolValue != PACKAGE_SYMBOL.symbol_value()) {
1077: prompt = makeString("Jatha "
1078: + PACKAGE_SYMBOL.symbol_value().toString()
1079: + "> ");
1080: oldPackageSymbolValue = PACKAGE_SYMBOL.symbol_value();
1081: }
1082:
1083: System.out.println();
1084: prompt.princ();
1085: System.out.flush();
1086:
1087: // READ
1088: validInput = true;
1089: try {
1090: input = PARSER.parse();
1091: } catch (EOFException e) {
1092: validInput = false;
1093: System.err.println("Incomplete input.");
1094: }
1095:
1096: if (validInput) {
1097: try {
1098: code = COMPILER.compile(MACHINE, input, NIL); // No globals for now
1099: } catch (Exception e) {
1100: System.out.println("Unable to compile " + input
1101: + "\n " + e);
1102: continue;
1103: }
1104:
1105: // EVAL
1106:
1107: try {
1108: value = MACHINE.Execute(code, NIL);
1109: } catch (Exception e2) {
1110: System.out.println("Unable to evaluate " + input
1111: + "\n " + e2);
1112: continue;
1113: }
1114:
1115: // useful variable management
1116: STARSTARSTAR.setf_symbol_value(STARSTAR.symbol_value());
1117: STARSTAR.setf_symbol_value(STAR.symbol_value());
1118: STAR.setf_symbol_value(value);
1119:
1120: // PRINT
1121: value.prin1();
1122: }
1123: }
1124: }
1125:
1126: /**
1127: * Returns the LISP compiler used by this instance of Jatha.
1128: */
1129: public LispCompiler getCompiler() {
1130: return COMPILER;
1131: }
1132:
1133: /**
1134: * Returns the LISP Parser used by this instance of Jatha.
1135: */
1136: public LispParser getParser() {
1137: return PARSER;
1138: }
1139:
1140: /**
1141: * Returns the LISP evaluator used by this instance of Jatha.
1142: */
1143: public LispEvaluator getEval() {
1144: return EVAL;
1145: }
1146:
1147: /**
1148: * Returns the Symbol Table used by this instance of Jatha.
1149: */
1150: public SymbolTable getSymbolTable() {
1151: return SYMTAB;
1152: }
1153:
1154: /**
1155: * Parses a string and returns the first form in the string.
1156: * <br>caseSensitivity:
1157: * <ul>
1158: * <li>LispParser.UPCASE (the default)</li>
1159: * <li>LispParser.DOWNCASE</li>
1160: * <li>LispParser.PRESERVE</li>
1161: * </ul>
1162: */
1163: public LispValue parse(String s, int caseSensitivity)
1164: throws EOFException {
1165: return new LispParser(this , s, caseSensitivity).parse();
1166: }
1167:
1168: /**
1169: * Parses a string and returns the first form in the string.
1170: */
1171: public LispValue parse(String s) throws EOFException {
1172: return parse(s, LispParser.UPCASE);
1173: }
1174:
1175: /**
1176: * Loads the contents of a Reader (stream).
1177: * Useful for loading from a jar file.
1178: * Contributed by Stephen Starkey.
1179: */
1180: public LispValue load(Reader in) throws IOException,
1181: CompilerException {
1182: boolean verbose = LOAD_VERBOSE.symbol_value() != NIL;
1183: return load(in, verbose);
1184: }
1185:
1186: /**
1187: * Loads the contents of a Reader (stream).
1188: * Useful for loading from a jar file.
1189: * Contributed by Stephen Starkey.
1190: */
1191: public LispValue load(Reader in, boolean verbose)
1192: throws IOException, CompilerException {
1193: // System.err.println("Loading: verbose is " + verbose);
1194:
1195: BufferedReader buff = new BufferedReader(in);
1196:
1197: LispParser fileparser = new LispParser(this , buff);
1198: LispValue input, code;
1199: boolean atLeastOneResult = false;
1200:
1201: LispPackage oldPackage = (LispPackage) PACKAGE_SYMBOL
1202: .symbol_value();
1203: // Read and Eval stream until EOF.
1204: try {
1205: while (true) {
1206: input = fileparser.parse();
1207:
1208: code = COMPILER.compile(MACHINE, input, NIL);
1209:
1210: LispValue value = MACHINE.Execute(code, NIL);
1211: atLeastOneResult = true;
1212:
1213: if (verbose) {
1214: if (useGUI)
1215: LISTENER.message(value, false);
1216: else
1217: System.out.println(value.toString());
1218: }
1219: }
1220: } catch (IOException ioe) {
1221: try {
1222: in.close();
1223: } catch (IOException e2) {
1224: return T;
1225: }
1226: } finally {
1227: PACKAGE_SYMBOL.setf_symbol_value(oldPackage);
1228: }
1229:
1230: if (atLeastOneResult)
1231: return T;
1232: else
1233: return NIL;
1234: }
1235:
1236: /** Loads a file.
1237: * Argument is guaranteed to be a LispString.
1238: */
1239: public LispValue load(LispValue filenameVal) {
1240: String filename = ((LispString) filenameVal).getValue();
1241:
1242: try {
1243: return load(new FileReader(filename));
1244: } catch (FileNotFoundException e) {
1245: if (useGUI)
1246: LISTENER.message(";; *** File not found: " + filename);
1247: else
1248: System.err
1249: .println(";; *** File not found: " + filename);
1250: return NIL;
1251: } catch (IOException e) {
1252: if (useGUI)
1253: LISTENER.message(";; *** Error closing file: "
1254: + filename);
1255: else
1256: System.err.println("Error closing file " + filename);
1257: return T;
1258: } catch (CompilerException ce) {
1259: if (useGUI)
1260: LISTENER.message(";; *** Error while reading file: "
1261: + filename + "\n" + ce.getMessage());
1262: else
1263: System.err.println("Error while reading file "
1264: + filename + ":\n" + ce.toString());
1265: }
1266: return NIL;
1267: }
1268:
1269: /**
1270: * Creates a reader from the input string and passes it to load(Reader).
1271: * Verbose is false.
1272: */
1273: public LispValue load(String string) {
1274: return load(string, false);
1275: }
1276:
1277: /**
1278: * Creates a reader from the input string and passes it to load(Reader).
1279: */
1280: public LispValue load(String string, boolean verbose) {
1281: try {
1282: return load(new StringReader(string), verbose);
1283: } catch (IOException e) {
1284: if (useGUI)
1285: LISTENER.message(";; *** Error handling input string.");
1286: else
1287: System.err.println("Error handling input string.");
1288: return T;
1289: } catch (CompilerException ce) {
1290: if (useGUI)
1291: LISTENER.message(";; *** Error in input: "
1292: + ce.getMessage());
1293: else
1294: System.err.println("Error in input: " + ce.toString());
1295: }
1296: return NIL;
1297: }
1298:
1299: // ---------- LISP-related methods -----------------
1300:
1301: // @author Micheal S. Hewett hewett@cs.stanford.edu
1302: // @date Fri May 9 22:30:22 1997
1303: /**
1304: * Looks up the package on the packages list.
1305: * Input should be a string, symbol or package. All
1306: * names and nicknames are searched.
1307: *
1308: * @param packageName a LISP string or keyword
1309: * @return LispValue the package, or NIL
1310: */
1311: public LispValue findPackage(LispValue packageName) {
1312: if (packageName instanceof LispPackage)
1313: return packageName;
1314:
1315: if (packageName.symbolp() == T)
1316: packageName = packageName.symbol_name();
1317:
1318: return findPackage(((LispString) (packageName)).getValue());
1319: }
1320:
1321: public LispValue findPackage(String packageNameStr) {
1322: if (packages == null)
1323: return NIL;
1324:
1325: LispValue pList = packages;
1326: LispValue nickNameList;
1327: LispPackage pkg;
1328:
1329: while (pList != NIL) {
1330: pkg = (LispPackage) (pList.car());
1331:
1332: // Try to match the package name
1333: if (packageNameStr.equalsIgnoreCase(pkg.getName()
1334: .getValue()))
1335: return pkg;
1336:
1337: // Try to match the nicknames
1338: nickNameList = pkg.getNicknames();
1339: while (nickNameList != NIL) {
1340: if (packageNameStr
1341: .equalsIgnoreCase(((LispString) (nickNameList
1342: .car())).getValue()))
1343: return pkg;
1344: nickNameList = nickNameList.cdr();
1345: }
1346:
1347: // Try the next package.
1348: pList = pList.cdr();
1349: }
1350:
1351: return NIL;
1352: }
1353:
1354: public LispValue allPackages() {
1355: return packages;
1356: }
1357:
1358: // @author Micheal S. Hewett hewett@cs.stanford.edu
1359: // @date Wed May 14 18:45:22 1997
1360: /**
1361: * Prints out all symbols in the given package, or in
1362: * all packages (if pkg is NIL) that match the given string.
1363: * Matching is *NOT* case-sensitive and the string may
1364: * match a portion of the symbol name.
1365: *
1366: * @param str - a LispString to match
1367: * @param pkg - either NIL or a package
1368: */
1369: public LispValue apropos(LispValue str, LispValue pkg) {
1370: // Write to a string and return it.
1371: StringWriter sout = new StringWriter();
1372: PrintWriter out = new PrintWriter(sout);
1373:
1374: out.println();
1375:
1376: if (pkg == NIL)
1377: pkg = allPackages();
1378: else if (pkg instanceof LispPackage)
1379: pkg = makeList(pkg);
1380:
1381: // Loop through the packages, printing all symbols that match.
1382: // The symbols come out unsorted, but oh well.
1383:
1384: String matchStr = ((LispString) (str)).getValue().toUpperCase();
1385: Iterator iter;
1386: LispValue symb;
1387: LispString sname;
1388: String symbstr;
1389:
1390: while (pkg != NIL) {
1391: iter = ((LispPackage) (pkg.car())).getSymbolTable()
1392: .values().iterator();
1393:
1394: while (iter.hasNext()) {
1395: symb = ((LispValue) (iter.next()));
1396: sname = (LispString) (symb.symbol_name());
1397: symbstr = sname.getValue().toUpperCase();
1398:
1399: if (symbstr.indexOf(matchStr) >= 0)
1400: symb.apropos_print(out);
1401: }
1402: pkg = pkg.cdr();
1403: }
1404:
1405: out.flush();
1406: return new StandardLispString(this , sout.toString());
1407: }
1408:
1409: // @author Micheal S. Hewett hewett@cs.stanford.edu
1410: // @date Thu Feb 6 09:31:49 1997
1411: /**
1412: * This method prints out information on the amount of
1413: * memory free in the Java space. It optionally takes
1414: * an PrintStream as an argument, but defaults to
1415: * System.out.
1416: * @see java.lang.Runtime
1417: * @return void
1418: */
1419: public long free() {
1420: return free(System.out);
1421: }
1422:
1423: public long free(PrintStream out) {
1424: long free = SYSTEM_INFO.freeMemory();
1425: long total = SYSTEM_INFO.totalMemory();
1426:
1427: out.println(";; " + free + "/" + total + "bytes ("
1428: + (long) (100.0 * ((double) free / (double) total))
1429: + "%) of memory free.");
1430: return free;
1431: }
1432:
1433: // @author Micheal S. Hewett hewett@cs.stanford.edu
1434: // @date Thu Feb 6 09:31:49 1997
1435: /**
1436: * This method turns Java method tracing on.
1437: * Right now, this doesn't seem to do anything, but
1438: * perhaps we need to compile with debugging turned on.
1439: * @see java.lang.Runtime
1440: * @param on
1441: */
1442: public void javaTrace(boolean on) {
1443: SYSTEM_INFO.traceMethodCalls(on); // traceInstructions(on) is also available
1444: }
1445:
1446: // @author Micheal S. Hewett hewett@cs.stanford.edu
1447: // @date Thu Feb 6 09:31:49 1997
1448: /**
1449: * This method causes the Java runtime to performs a GC.
1450: * @see java.lang.Runtime
1451: */
1452: public void gc() {
1453: if (useConsole) {
1454: System.out.print("\n;; GC...");
1455: System.out.flush();
1456: }
1457: SYSTEM_INFO.gc();
1458: if (useConsole) {
1459: System.out.println("done");
1460: System.out.flush();
1461: }
1462: }
1463:
1464: // @author Micheal S. Hewett hewett@cs.stanford.edu
1465: // @date Thu Feb 6 09:31:49 1997
1466: /**
1467: * This method causes the Java runtime to performs
1468: * a GC. It calls the runFinalization() method
1469: * first, in order to reclaim as much memory as
1470: * possible.
1471: * @see java.lang.Runtime
1472: */
1473: public void gc_full() {
1474: String msg = "\n;; GC Full...";
1475: if (useConsole) {
1476: System.out.print(msg);
1477: System.out.flush();
1478: } else if (useGUI)
1479: LISTENER.message(msg);
1480:
1481: System.runFinalization();
1482: System.gc();
1483: if (useConsole) {
1484: System.out.println("done");
1485: }
1486: free();
1487: }
1488:
1489: // ---------------- PACKAGE stuff -----------------------
1490: /**
1491: * This is not yet implemented. Returns the current value of Jatha.PACKAGE.
1492: * @param args is not used
1493: * @return Jatha.PACKAGE
1494: */
1495: public LispPackage defpackage(LispValue args) {
1496: return PACKAGE;
1497: }
1498:
1499: /**
1500: * Creates a package and returns it. If it already exists, a cerror is reported.
1501: *
1502: * @param name the name of the package. may be a string or a symbol
1503: * @param nickNames a list of nicknames. the content must be strings or symbols
1504: * @param use a list of package names to use. may be strings or symbols.
1505: * @return Jatha.PACKAGE
1506: */
1507: public LispValue makePackage(final LispValue name,
1508: final LispValue nickNames, final LispValue use) {
1509: LispValue firstPkg = findPackage(name);
1510: if (NIL != firstPkg) {
1511: throw new LispAlreadyDefinedPackageException(
1512: ((LispString) name.string()).getValue());
1513: }
1514: firstPkg = new StandardLispPackage(this , name, nickNames, use);
1515: packages = makeCons(firstPkg, packages);
1516: return firstPkg;
1517: }
1518:
1519: // ----- ActionListener interface ------------------
1520: /**
1521: * Invoked when an action occurs.
1522: */
1523: public void actionPerformed(ActionEvent event) {
1524: // don't do anything for now.
1525: }
1526:
1527: // --------------------- methods formerly in LispValueFactory ------------------
1528: //* @author Micheal S. Hewett hewett@cs.stanford.edu
1529: //* @date Thu Feb 20 12:08:32 1997
1530: /**
1531: * makeCons(a,b) creates a new Cons cell, initialized with
1532: * the values a and b as the CAR and CDR respectively.
1533: *
1534: * @see LispCons
1535: * @param theCar
1536: * @param theCdr
1537: * @return LispValue
1538: *
1539: */
1540: public LispCons makeCons(LispValue theCar, LispValue theCdr) {
1541: return new StandardLispCons(this , theCar, theCdr);
1542: }
1543:
1544: //* @author Micheal S. Hewett hewett@cs.stanford.edu
1545: //* @date Thu Feb 20 12:10:00 1997
1546: /**
1547: * Creates a LISP list from the elements of the Collection.
1548: * which must be LispValue types.
1549: *
1550: * @see LispValue
1551: *
1552: */
1553: public LispConsOrNil makeList(Collection elements) {
1554: // Use array so as to iterate from the end to the beginning.
1555: Object[] elArray = elements.toArray();
1556: LispConsOrNil result = NIL;
1557:
1558: for (int i = elArray.length - 1; i >= 0; i--)
1559: result = new StandardLispCons(this ,
1560: (LispValue) (elArray[i]), result);
1561:
1562: return result;
1563: }
1564:
1565: // Removed previous versions of this method that had 1, 2, 3 or 4 parameters.
1566: // (mh) 22 Feb 2007 also changed return type to LispConsOrNil from LispCons.
1567: /**
1568: * This is a Java 5-compatible version of makeList that
1569: * accepts any number of arguments.
1570: * Returns NIL if no arguments are passed.
1571: * makeList(NIL) returns (NIL) - a list containing NIL.
1572: */
1573: public LispConsOrNil makeList(LispValue... parts) {
1574: LispConsOrNil result = NIL;
1575: for (int i = parts.length - 1; i >= 0; i--)
1576: result = new StandardLispCons(this , parts[i], result);
1577:
1578: return result;
1579: }
1580:
1581: /**
1582: * Each element of the collection should be a LispConsOrNil.
1583: * The elements will be non-destructively appended to each other.
1584: * The result is one list.
1585: * Note that this operation is expensive in terms of storage.
1586: */
1587:
1588: public LispConsOrNil makeAppendList(Collection elements) {
1589: if (elements.size() == 0)
1590: return NIL;
1591:
1592: LispValue result = NIL;
1593: for (Iterator iterator = elements.iterator(); iterator
1594: .hasNext();) {
1595: LispValue o = (LispValue) iterator.next();
1596: result = result.append(o);
1597: }
1598:
1599: return (LispConsOrNil) result;
1600: }
1601:
1602: /**
1603: * Each element of the collection should be a LispConsOrNil.
1604: * The elements will be destructively appended to each other.
1605: * The result is one list.
1606: */
1607:
1608: public LispConsOrNil makeNconcList(Collection elements) {
1609: if (elements.size() == 0)
1610: return NIL;
1611:
1612: LispValue result = NIL;
1613: for (Iterator iterator = elements.iterator(); iterator
1614: .hasNext();) {
1615: LispValue o = (LispValue) iterator.next();
1616: result = result.nconc(o);
1617: }
1618:
1619: return (LispConsOrNil) result;
1620: }
1621:
1622: //* @author Micheal S. Hewett hewett@cs.stanford.edu
1623: //* @date Thu Feb 20 12:16:21 1997
1624: /**
1625: * Creates a LispInteger type initialized with the value
1626: * provided and returns it.
1627: * @see LispInteger
1628: * @see LispValue
1629: * @return LispInteger
1630: *
1631: */
1632: public LispInteger makeInteger(Long value) {
1633: return new StandardLispInteger(this , value.longValue());
1634: }
1635:
1636: public LispInteger makeInteger(long value) {
1637: return new StandardLispInteger(this , value);
1638: }
1639:
1640: public LispInteger makeInteger(Integer value) {
1641: return new StandardLispInteger(this , value.longValue());
1642: }
1643:
1644: public LispInteger makeInteger(int value) {
1645: return new StandardLispInteger(this , (long) value);
1646: }
1647:
1648: public LispInteger makeInteger() {
1649: return new StandardLispInteger(this , 0);
1650: }
1651:
1652: //* @author Micheal S. Hewett hewett@cs.stanford.edu
1653: //* @date Tue May 20 23:09:54 1997
1654: /**
1655: * Creates a LispBignum type initialized with the value provided.
1656: * @see LispBignum
1657: * @see java.math.BigInteger
1658: */
1659: public LispBignum makeBignum(BigInteger value) {
1660: return new StandardLispBignum(this , value);
1661: }
1662:
1663: public LispBignum makeBignum(LispInteger value) {
1664: return new StandardLispBignum(this , BigInteger.valueOf(value
1665: .getLongValue()));
1666: }
1667:
1668: public LispBignum makeBignum(double value) {
1669: return new StandardLispBignum(this , BigInteger
1670: .valueOf((long) value));
1671: }
1672:
1673: public LispBignum makeBignum(long value) {
1674: return new StandardLispBignum(this , BigInteger.valueOf(value));
1675: }
1676:
1677: //* @author Micheal S. Hewett hewett@cs.stanford.edu
1678: //* @date Thu Feb 20 12:19:15 1997
1679: /**
1680: * Creates an instance of LispReal initialized with
1681: * the given value.
1682: * @see LispInteger
1683: * @see LispValue
1684: * @return LispReal
1685: */
1686: public LispReal makeReal(Double value) {
1687: return new StandardLispReal(this , value.doubleValue());
1688: }
1689:
1690: public LispReal makeReal(double value) {
1691: return new StandardLispReal(this , value);
1692: }
1693:
1694: public LispReal makeReal(Float value) {
1695: return new StandardLispReal(this , value.doubleValue());
1696: }
1697:
1698: public LispReal makeReal(float value) {
1699: return new StandardLispReal(this , (double) value);
1700: }
1701:
1702: public LispReal makeReal() {
1703: return new StandardLispReal(this , 0.0);
1704: }
1705:
1706: //* @author Micheal S. Hewett hewett@cs.stanford.edu
1707: //* @date Thu Feb 20 12:20:13 1997
1708: /**
1709: * Creates a LispString from a Java string.
1710: *
1711: * @see LispString
1712: * @see LispValue
1713: * @return LispString
1714: */
1715: public LispString makeString(String str) {
1716: return new StandardLispString(this , str);
1717: }
1718:
1719: //* @author Micheal S. Hewett hewett@cs.stanford.edu
1720: //* @date Thu Feb 20 12:20:57 1997
1721: /**
1722: * Creates a LispSymbol from a string or LispString.
1723: * This method does <b>not</b> intern the symbol.
1724: *
1725: * @see LispSymbol
1726: * @see LispValue
1727: * @return LispSymbol
1728: */
1729: public LispSymbol makeSymbol(String symbolName) {
1730: return new StandardLispSymbol(this , symbolName);
1731: }
1732:
1733: public LispSymbol makeSymbol(LispString symbolName) {
1734: return new StandardLispSymbol(this , symbolName);
1735: }
1736:
1737: //* @author Micheal S. Hewett hewett@cs.stanford.edu
1738: //* @date Thu Feb 20 12:20:57 1997
1739: /**
1740: * Creates a LispConstant (a type of Symbol whose value
1741: * can not be changed). This method does <b>not</b>
1742: * intern the symbol.
1743: *
1744: * @see LispConstant
1745: * @see LispSymbol
1746: * @see LispValue
1747: * @return LispSymbol
1748: */
1749: public LispSymbol makeConstant(String symbolName) {
1750: return new StandardLispConstant(this , symbolName);
1751: }
1752:
1753: public LispSymbol makeConstant(LispString symbolName) {
1754: return new StandardLispConstant(this , symbolName);
1755: }
1756:
1757: //* @author Micheal S. Hewett hewett@cs.stanford.edu
1758: //* @date Thu Feb 20 12:20:57 1997
1759: /**
1760: * Creates a LispKeyword (a type of Symbol that evaluates
1761: * to itself). This method does <b>not</b> intern the symbol.
1762: *
1763: * @see LispKeyword
1764: * @see LispConstant
1765: * @see LispSymbol
1766: * @see LispValue
1767: * @return LispSymbol
1768: */
1769: public LispSymbol makeKeyword(String symbolName) {
1770: return new StandardLispKeyword(this , symbolName);
1771: }
1772:
1773: public LispSymbol makeKeyword(LispString symbolName) {
1774: return new StandardLispKeyword(this , symbolName);
1775: }
1776:
1777: //* @author Micheal S. Hewett hewett@cs.stanford.edu
1778: //* @date Thu Feb 20 12:20:57 1997
1779: /**
1780: * Creates a LispNil (the funny symbol/cons that is the LISP NIL).
1781: * This method does <b>not</b> intern the symbol.
1782: *
1783: * @see LispNil
1784: * @see LispCons
1785: * @see LispSymbol
1786: * @see LispValue
1787: * @return LispSymbol
1788: */
1789: public LispNil makeNIL(String symbolName) {
1790: return new StandardLispNIL(this , symbolName);
1791: }
1792:
1793: public LispNil makeNIL(LispString symbolName) {
1794: return new StandardLispNIL(this , symbolName);
1795: }
1796:
1797: /**
1798: * Turns a Java object into a LISP object.
1799: *
1800: * @param obj
1801: */
1802: public LispValue toLisp(Object obj) // TODO: Is this where we use dynatype.LispForeignObject?
1803: {
1804: if (obj == null)
1805: return NIL;
1806:
1807: if (obj instanceof LispValue)
1808: return (LispValue) obj;
1809:
1810: if (obj instanceof Integer)
1811: return new StandardLispInteger(this , ((Integer) obj)
1812: .intValue());
1813:
1814: else if (obj instanceof Long)
1815: return new StandardLispInteger(this , ((Long) obj)
1816: .longValue());
1817:
1818: else if (obj instanceof Double)
1819: return new StandardLispReal(this , ((Double) obj)
1820: .doubleValue());
1821:
1822: else if (obj instanceof Float)
1823: return new StandardLispReal(this , ((Float) obj)
1824: .doubleValue());
1825:
1826: else if (obj instanceof String)
1827: return new StandardLispString(this , (String) obj);
1828:
1829: try {
1830: return (new LispParser(this , obj.toString(),
1831: LispParser.PRESERVE)).parse();
1832: } catch (Exception e) {
1833: System.err.println("Error in Jatha.toLisp(" + obj + ")");
1834: }
1835: return NIL;
1836: }
1837:
1838: // --- SYSTEM PACKAGE functions ---
1839:
1840: /**
1841: * This is used by f-backquote when expanding a macro.
1842: */
1843: public LispValue combineExprs(LispValue left, LispValue right,
1844: LispValue expr) {
1845: if (left.basic_constantp() && (right.basic_constantp()))
1846: return makeList(QUOTE, expr);
1847: else if (right.basic_null())
1848: return makeList(LIST, left);
1849: else if (right.basic_consp()
1850: && (!right.car().equal(LIST).basic_null()))
1851: ;
1852: return makeList(CONS, left, right);
1853: }
1854:
1855: /**
1856: * This is used to expand a macro
1857: */
1858: public LispValue backquote(LispValue expr) {
1859: if (expr.basic_null())
1860: return NIL;
1861: else if (expr.basic_atom())
1862: return makeList(QUOTE, expr);
1863: else if (!expr.car().eq(COMMA_FN).basic_null())
1864: return expr.second();
1865: else if (expr.car().basic_consp()
1866: && (!expr.car().car().eq(COMMA_ATSIGN_FN).basic_null()))
1867: return makeList(APPEND, expr.car().second(), backquote(expr
1868: .cdr()));
1869: else
1870: return combineExprs(backquote(expr.car()), backquote(expr
1871: .cdr()), expr);
1872: }
1873:
1874: /**
1875: * Use this to exit Jatha.
1876: */
1877: public void exit() {
1878: System.exit(0);
1879: }
1880: }
|