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.compile;
026:
027: import java.io.*;
028:
029: import org.jatha.Jatha;
030: import org.jatha.dynatype.*;
031: import org.jatha.machine.*;
032:
033: // @date Fri Jan 31 17:31:40 1997
034: /**
035: * The LispPrimitive class makes the
036: * transition from LISP code to Java code. There
037: * is a LispPrimitive for each builtin LISP function.
038: *
039: * 1) Create the new LISP primitive as an instance of
040: * this class. It must have several methods as
041: * described below.
042: * 2) Register the new primitive with the compiler.
043: *
044: * Each primitive must implement one method:
045: *
046: * public void Execute(SECDMachine machine)
047: *
048: * @see org.jatha.compile.LispCompiler
049: * @author Micheal S. Hewett hewett@cs.stanford.edu
050: */
051: public abstract class LispPrimitive extends StandardLispValue {
052: // Fields
053: protected long minNumberOfArgs;
054: protected long maxNumberOfArgs;
055:
056: /**
057: * Set inlineP to true if the function effectively evaluates itself
058: * simply by compiling its argument list. This is true for
059: * functions like LIST, LIST*, and QUOTE. This inhibits putting
060: * the function call on the stack, thus saving a millisecond of time.
061: *
062: * @see org.jatha.compile.LispPrimitive
063: */
064: public boolean inlineP = false;
065:
066: /**
067: * the <tt>functionName</tt> is part of the string that
068: * gets printed when the instruction appears in a printed list.
069: */
070: protected String functionName;
071: protected LispValue functionNameSymbol;
072:
073: /**
074: * The output of this function is printed when the
075: * instruction needs to be printed.
076: */
077: public String toString() {
078: return "#<function " + functionName + " "
079: + parameterCountString() + ">";
080: }
081:
082: public boolean basic_functionp() {
083: return true;
084: }
085:
086: /* ------------------ PRINT FUNCTION ------------------------------ */
087:
088: /**
089: * printCode prints a list of compiled code in a nice manner.
090: * Calls the 'grindef' function on each primitive.
091: * Grindef is an historical LISP function not found in Common LISP.
092: *
093: * Example:
094: * <pre>
095: * printCode(compiled-function, 2);
096: * </pre>
097: * @see LispPrimitive
098: * @param code the code to be printed, with indent 2.
099: */
100: public void printCode(LispValue code) {
101: printCode(code, 2);
102: }
103:
104: public void printCode(LispValue code, int indentAmount) {
105: while (code != f_lisp.NIL) {
106: code = ((LispPrimitive) (code.second())).grindef(code,
107: indentAmount);
108: }
109: }
110:
111: public LispValue grindef(LispValue code, int indentAmount) {
112: indent(indentAmount);
113: System.out.print(functionName);
114: f_lisp.NEWLINE.internal_princ(System.out);
115:
116: return code.cdr();
117: }
118:
119: public void indent(int amount) {
120: for (int i = 0; i < amount; ++i)
121: f_lisp.SPACE.internal_princ(System.out);
122: }
123:
124: /* ------------------ CONSTRUCTORS ------------------------------ */
125:
126: /**
127: * The constructor for the LispPrimitive class.
128: * @see org.jatha.compile.LispCompiler
129: * @param fnName The LISP function name being implemented.
130: * @param minArgs The minimum number of Arguments to this function.
131: * @param maxArgs The maximum number of Arguments to this function.
132: */
133: public LispPrimitive(Jatha lisp, String fnName, long minArgs,
134: long maxArgs) {
135: super (lisp);
136: minNumberOfArgs = minArgs;
137: maxNumberOfArgs = maxArgs;
138: functionName = fnName;
139: functionNameSymbol = new StandardLispSymbol(f_lisp, fnName);
140: }
141:
142: public LispPrimitive(Jatha lisp, String fnName, long minArgs) {
143: super (lisp);
144: minNumberOfArgs = minArgs;
145: maxNumberOfArgs = minArgs; // default value
146: functionName = fnName;
147: functionNameSymbol = new StandardLispSymbol(f_lisp, fnName);
148: }
149:
150: public LispPrimitive(Jatha lisp, String fnName) // Abstract machine ops have no args
151: {
152: super (lisp);
153: minNumberOfArgs = 0; // default value
154: maxNumberOfArgs = 0; // default value
155: functionName = fnName;
156: functionNameSymbol = new StandardLispSymbol(f_lisp, fnName);
157: }
158:
159: public String LispFunctionNameString() {
160: return functionName;
161: }
162:
163: public LispValue LispFunctionNameSymbol() {
164: return functionNameSymbol;
165: }
166:
167: public void internal_princ(PrintStream os) {
168: os.print(toString());
169: }
170:
171: public void internal_prin1(PrintStream os) {
172: os.print(toString());
173: }
174:
175: public void internal_print(PrintStream os) {
176: os.print(toString());
177: }
178:
179: /**
180: * This method returns <code>true</code> if
181: * the list of arguments satisfies the length restrictions
182: * posed by the function, and <code>false</code> otherwise.
183: * @see LispPrimitive
184: * @param numberOfArguments usually the result of args.length()
185: * @return boolean
186: */
187: boolean validArgumentLength(LispValue numberOfArguments) {
188: long numArgs = ((LispInteger) numberOfArguments).getLongValue();
189:
190: return ((minNumberOfArgs <= numArgs) && (numArgs <= maxNumberOfArgs));
191: }
192:
193: /**
194: * This method returns <code>true</code> if
195: * the list of arguments satisfies the length and format restrictions
196: * posed by the function, and <code>false</code> otherwise.
197: * It calls <code>validArgumentLength</code>, so the programmer
198: * doesn't need to call it.
199: * <p>
200: * This method is called by the compiler.
201: *
202: * @see LispPrimitive
203: * @see LispCompiler
204: * @param args the list of arguments.
205: * @return boolean
206: */
207: public boolean validArgumentList(LispValue args) {
208: // ?? Need to check keywords, etc. here.
209: return (validArgumentLength(args.length()));
210: }
211:
212: /**
213: * This method returns a Java string denoting the length of
214: * the expected argument list in some readable form.
215: * <p>
216: * This method is called by the compiler when an argument count
217: * exception is generated.
218: *
219: * @see LispPrimitive
220: * @see LispCompiler
221: * @return a Java string denoting the length of the expected argument list.
222: */
223: public String parameterCountString() {
224: String result = Long.toString(minNumberOfArgs);
225:
226: if (maxNumberOfArgs == Long.MAX_VALUE)
227: result += "...";
228: else if (maxNumberOfArgs != minNumberOfArgs)
229: result += " " + maxNumberOfArgs;
230:
231: return result;
232: }
233:
234: /**
235: * Execute performs the operation using the abstract machine
236: * registers. Arguments are found on the S register stack,
237: * in reverse order. UNLIMITED argument lists are collected
238: * into a list which is the top element on the stack.
239: *
240: * The implementation should pop an appropriate number of arguments
241: * from the stack, perform a computation, then push a result
242: * back on the S stack. The instruction should then be popped from
243: * the C (code) register. A LispValueFactory objects is available
244: * in the static variable <code>LispValueFactory</code>.
245: *
246: * Example implementations:
247: * <pre>
248: * <code>FIRST</code>
249: * class FirstPrimitive extends LispPrimitive
250: * {
251: * public First()
252: * {
253: * super("FIRST", 1); // 1 argument
254: * }
255: *
256: * public void Execute(SECDMachine machine)
257: * {
258: * LispValue arg = machine.S.pop();
259: *
260: * machine.S.push(my_first(arg));
261: * machine.C.pop();
262: * }
263: * }
264: * </pre>
265: *
266: * A multi-argument function must pop the arguments in reverse order.
267: * <pre>
268: * public void Execute(SECDMachine machine)
269: * {
270: * LispValue arg2 = machine.S.pop();
271: * LispValue arg1 = machine.S.pop();
272: *
273: * machine.S.push(my_new_function(arg1, arg2));
274: * machine.C.pop();
275: * }
276: * }
277: * </pre>
278: *
279: * To register the new primitive, call:
280: * <pre>
281: * Jatha.COMPILER.Register(new FirstPrimitive());
282: * </pre>
283: * @see org.jatha.compile.LispCompiler
284: * @param machine The abstract machine instance.
285: */
286: public abstract void Execute(SECDMachine machine)
287: throws CompilerException;
288:
289: // Called only on Builtin Functions
290: LispValue BuiltinFunctionCode(LispValue fn) {
291: return ((LispFunction) fn).getCode().second();
292: }
293:
294: /**
295: * The CompileArgs method turns the arguments of the function call
296: * into SECD abstract machine code. Most functions won't need to
297: * override the default code generation, but ones that do funny
298: * things with argument lists will need to.
299: *
300: * @see LispCompiler
301: * @param compiler
302: * @param args
303: * @param valueList
304: * @param code
305: * @return LispValue The code generated and cons'ed onto the front of the incoming code.
306: */
307: public LispValue CompileArgs(LispCompiler compiler,
308: SECDMachine machine, LispValue args, LispValue valueList,
309: LispValue code) throws CompilerException {
310: return compiler.compileArgsLeftToRight(args, valueList, code);
311: }
312:
313: // Todo: PROGN compiles right-to-left, but executes left-to-right, thus recursive calls are not correctly compiled
314:
315: public LispValue CompileArgs(LispCompiler compiler,
316: SECDMachine machine, LispValue function, LispValue args,
317: LispValue valueList, LispValue code)
318: throws CompilerException {
319: if (this .inlineP)
320: return CompileArgs(compiler, machine, args, valueList, code);
321: else {
322: if (!(function instanceof LispFunction))
323: function = function.symbol_function();
324:
325: LispValue fncode = ((LispFunction) function).getCode()
326: .second();
327:
328: return CompileArgs(compiler, machine, args, valueList,
329: f_lisp.makeCons(fncode, code));
330: }
331: }
332:
333: }
|