001: /*
002: * Jatha - a Common LISP-compatible LISP library in Java.
003: * Copyright (C) 1997-2005 Micheal Scott Hewett
004: *
005: * This library is free software; you can redistribute it and/or
006: * modify it under the terms of the GNU Lesser General Public
007: * License as published by the Free Software Foundation; either
008: * version 2.1 of the License, or (at your option) any later version.
009: *
010: * This library is distributed in the hope that it will be useful,
011: * but WITHOUT ANY WARRANTY; without even the implied warranty of
012: * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
013: * Lesser General Public License for more details.
014: *
015: * You should have received a copy of the GNU Lesser General Public
016: * License along with this library; if not, write to the Free Software
017: * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
018: *
019: *
020: * For further information, please contact Micheal Hewett at
021: * hewett@cs.stanford.edu
022: *
023: */
024:
025: package org.jatha.eval;
026:
027: import org.jatha.Jatha;
028: import org.jatha.dynatype.LispPackage;
029: import org.jatha.dynatype.LispString;
030: import org.jatha.dynatype.LispValue;
031: import org.jatha.dynatype.StandardLispInteger;
032: import org.jatha.dynatype.StandardLispString;
033:
034: /**
035: * A LISP eval mechanism based on the SECD abstract
036: * machine described in "The Architecture of Symbolic
037: * Computers" by Peter Kogge. ISBN 0-07-035596-7
038: *
039: * 25 Jan 1997 (mh)
040: */
041: public class LispEvaluator {
042: private Jatha f_lisp = null;
043:
044: // -------- CONSTRUCTORS -------------
045:
046: public LispEvaluator(Jatha lisp) {
047: super ();
048:
049: f_lisp = lisp;
050: }
051:
052: // -------- non-LISP methods -------------
053:
054: // init() should only be called once for each LISP session.
055: // it creates the initial list of global variables, and
056: // builds the
057:
058: public void init() {
059: setf_symbol_value(intern("*"), f_lisp.NIL);
060: setf_symbol_value(intern("**"), f_lisp.NIL);
061: setf_symbol_value(intern("***"), f_lisp.NIL);
062: setf_symbol_value(intern("*LISP-TRACE*"), f_lisp.NIL);
063: setf_symbol_value(intern("*COMP-NATIVE-FUNCTIONS*"), f_lisp.NIL);
064: setf_symbol_value(intern("*COMP-SPECIAL-FUNCTIONS*"),
065: f_lisp.NIL);
066:
067: // Declare *PACKAGE* as a global variable.
068: setf_symbol_value(intern("*PACKAGE*"), f_lisp.PACKAGE);
069: intern("*PACKAGE*").set_special(true);
070:
071: // ** obsolete
072: // globalVars = f_lisp.NIL;
073: // globalVarValues = cons(f_lisp.NIL, f_lisp.NIL);
074: }
075:
076: // -------- LISP methods (alphabetical) -------------
077:
078: public LispValue cons(LispValue theCar, LispValue theCdr) {
079: return f_lisp.makeCons(theCar, theCdr);
080: }
081:
082: public LispValue intern(LispString symbolString) {
083: if (f_lisp.COLON.eql(symbolString.basic_elt(0)) != f_lisp.NIL)
084: return intern((LispString) (symbolString
085: .substring(new StandardLispInteger(f_lisp, 1))),
086: (LispPackage) (f_lisp.findPackage("KEYWORD")));
087: else
088: return intern(symbolString, f_lisp.PACKAGE);
089: }
090:
091: public LispValue intern(LispString symbolString, LispPackage pkg) {
092: LispValue newSymbol;
093:
094: // First, check to see whether one exists already.
095: newSymbol = pkg.getSymbol(symbolString);
096:
097: if (newSymbol != f_lisp.NIL) // Already there, don't add it again.
098: {
099: // System.out.println("Package " + pkg + " already owns " + newSymbol);
100: return newSymbol;
101: } else {
102: if (pkg == f_lisp.findPackage("KEYWORD")) {
103: String newString = symbolString.toStringSimple()
104: .toUpperCase();
105: // Symbols must be uppercase
106: newSymbol = f_lisp.makeKeyword(new StandardLispString(
107: f_lisp, newString));
108: } else
109: newSymbol = f_lisp.makeSymbol(symbolString);
110:
111: return intern(symbolString, newSymbol, pkg);
112: }
113: }
114:
115: // We need this for the startup when we create f_lisp.NIL and LispValue.T.
116: // Actually, LispValue is always a LispSymbol, but because of NIL's strange
117: // properties, we must make the type be LispValue.
118: public LispValue intern(LispString symbolString, LispValue symbol) {
119: return intern(symbolString, symbol, f_lisp.PACKAGE);
120: }
121:
122: // We need this for the startup when we create f_lisp.NIL and LispValue.T.
123: // Actually, LispValue is always a LispSymbol, but because of NIL's strange
124: // properties, we must make the type be LispValue.
125: public LispValue intern(LispString symbolString, LispValue symbol,
126: LispPackage pkg) {
127: if (pkg == null) // uninterned symbol
128: return symbol;
129: else {
130: symbol.setPackage(pkg);
131: return pkg.addSymbol(symbolString, symbol);
132: }
133: }
134:
135: public LispValue intern(String str) {
136: return intern(f_lisp.makeString(str));
137: }
138:
139: public LispValue intern(String str, LispPackage pkg) {
140: return intern(f_lisp.makeString(str), pkg);
141: }
142:
143: /* ------------------ ------------------------------ */
144:
145: public LispValue nreverse(LispValue thing) {
146: return thing.nreverse();
147: }
148:
149: public LispValue reverse(LispValue thing) {
150: return thing.reverse();
151: }
152:
153: public LispValue setf_symbol_function(LispValue symbol,
154: LispValue value) {
155: return symbol.setf_symbol_function(value);
156: }
157:
158: public LispValue setf_symbol_plist(LispValue symbol, LispValue value) {
159: return symbol.setf_symbol_plist(value);
160: }
161:
162: public LispValue setf_symbol_value(LispValue symbol, LispValue value) {
163: return symbol.setf_symbol_value(value);
164: }
165:
166: }
|