01: /*
02: * Jatha - a Common LISP-compatible LISP library in Java.
03: * Copyright (C) 1997-2005 Micheal Scott Hewett
04: *
05: * This library is free software; you can redistribute it and/or
06: * modify it under the terms of the GNU Lesser General Public
07: * License as published by the Free Software Foundation; either
08: * version 2.1 of the License, or (at your option) any later version.
09: *
10: * This library is distributed in the hope that it will be useful,
11: * but WITHOUT ANY WARRANTY; without even the implied warranty of
12: * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
13: * Lesser General Public License for more details.
14: *
15: * You should have received a copy of the GNU Lesser General Public
16: * License along with this library; if not, write to the Free Software
17: * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
18: *
19: *
20: * For further information, please contact Micheal Hewett at
21: * hewett@cs.stanford.edu
22: *
23: */
24:
25: package org.jatha.compile;
26:
27: import org.jatha.Jatha;
28: import org.jatha.dynatype.*;
29: import org.jatha.machine.*;
30:
31: // Funcall creates a new expression and calls EVAL on it.
32: public class FuncallPrimitive extends LispPrimitive {
33: public FuncallPrimitive(Jatha lisp) {
34: super (lisp, "FUNCALL", 1, Long.MAX_VALUE);
35: }
36:
37: public void Execute(SECDMachine machine) {
38: // The args list is an expression to be evaluated.
39: // Need to quote the argument(s) because they have already been evaluated.
40: // The EVAL will evaluate them again.
41: LispValue args = machine.S.pop();
42: LispValue fn = args.car();
43: LispValue fnArgs = args.cdr();
44:
45: machine.S.push(f_lisp.makeCons(fn, f_lisp.COMPILER
46: .quoteList(fnArgs)));
47:
48: // (mh) 4 Sep 2004
49: // This seems like a kludge, but I don't know how to get around it.
50: // if the fn is a user-defined function, we have to move the arguments to the E register.
51: if ((fn instanceof LispFunction)
52: && (!((LispFunction) fn).isBuiltin())) {
53: machine.S.pop();
54: machine.S.push(f_lisp.makeList(fn));
55: machine.E.push(fnArgs);
56: }
57:
58: machine.C.pop();
59: machine.C.push(new EvalPrimitive(f_lisp));
60: }
61:
62: // Evaluate only the first arg.
63: public LispValue CompileArgs(LispCompiler compiler,
64: SECDMachine machine, LispValue args, LispValue valueList,
65: LispValue code) throws CompilerException {
66: return compiler.compileArgsLeftToRight(args, valueList, f_lisp
67: .makeCons(machine.LIS, f_lisp.makeCons(args.length(),
68: code)));
69: /*
70: compiler.compileArgsLeftToRight(
71: f_lisp.makeCons(args.car(), f_lisp.NIL),
72: valueList,
73: compiler.compileConstantArgsLeftToRight(machine, args.cdr(), valueList,
74: f_lisp.makeCons(machine.LIS,
75: f_lisp.makeCons( args.length(), code))));
76: */
77: }
78: }
|