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 org.jatha.Jatha;
028: import org.jatha.dynatype.LispFunction;
029: import org.jatha.dynatype.LispValue;
030: import org.jatha.machine.SECDMachine;
031:
032: // @date Tue Feb 4 13:30:53 1997
033: /**
034: * (APPLY fn args...)
035: * @see org.jatha.machine.SECDMachine
036: * @see LispCompiler
037: * @see LispPrimitive
038: * @author Micheal S. Hewett hewett@cs.stanford.edu
039: */
040: public class ApplyPrimitive extends LispPrimitive {
041: public ApplyPrimitive(Jatha lisp) {
042: super (lisp, "APPLY", 2, Long.MAX_VALUE);
043: }
044:
045: // Apply is routed through EVAL after the args are parsed.
046: public void Execute(SECDMachine machine) throws CompilerException {
047: LispValue args = machine.S.pop();
048: LispValue fn = args.car();
049: LispValue fnArgs = args.cdr();
050:
051: // The last arg must be a list.
052: if (!validArgumentList(args))
053: throw new WrongArgumentTypeException("APPLY",
054: "a CONS in the last argument", "a "
055: + fnArgs.last().car().type_of().toString());
056: machine.S.push(f_lisp.makeCons(fn, f_lisp.COMPILER
057: .quoteList(constructArgList(fnArgs))));
058:
059: // (mh) 4 Sep 2004
060: // This seems like a kludge, but I don't know how to get around it.
061: // if the fn is a user-defined function, we have to move the arguments to the E register.
062: if ((fn instanceof LispFunction)
063: && (!((LispFunction) fn).isBuiltin())) {
064: machine.S.pop();
065: machine.S.push(f_lisp.makeList(fn));
066: machine.E.push(fnArgs);
067: }
068:
069: // The args list is an expression to be evaluated.
070: machine.C.pop();
071: machine.C.push(new EvalPrimitive(f_lisp));
072:
073: System.out.println("APPLY: fn = " + fn + ", args = " + fnArgs);
074: System.out.println("S: " + machine.S.value());
075: System.out.println("E: " + machine.E.value());
076: System.out.println("C: " + machine.C.value());
077: }
078:
079: // Unlimited number of evaluated args.
080: public LispValue CompileArgs(LispCompiler compiler,
081: SECDMachine machine, LispValue args, LispValue valueList,
082: LispValue code) throws CompilerException {
083: return compiler.compileArgsLeftToRight(args, valueList, f_lisp
084: .makeCons(machine.LIS, f_lisp.makeCons(args.length(),
085: code)));
086: }
087:
088: // The last arg is a list. We need to cons the
089: // rest onto the front of the list.
090: LispValue constructArgList(LispValue args) {
091: // The last argument is a list, and we need to quote
092: // the values in that list.
093: if (args.cdr() == f_lisp.NIL)
094: return args.car();
095: else
096: return f_lisp.makeCons(args.car(), constructArgList(args
097: .cdr()));
098: }
099:
100: public boolean validArgumentList(LispValue args) {
101: // The last argument must be a CONS
102: if (args.last().car().basic_consp()
103: || args.last().car() == f_lisp.NIL)
104: return super .validArgumentList(args);
105: else {
106: System.err
107: .println(";; *ERROR*: Last argument to APPLY must be a CONS.");
108: return false;
109: }
110: }
111: }
|