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: public class SetqPrimitive extends LispPrimitive {
32: public SetqPrimitive(Jatha lisp) {
33: super (lisp, "SETQ", 2);
34: }
35:
36: public void Execute(SECDMachine machine) {
37: LispValue val = machine.S.pop();
38: LispValue sym = machine.S.pop();
39:
40: if (sym.basic_listp()) // local variable
41: machine.LD.setComponentAt(sym, machine.E.value(), val);
42:
43: else if (sym.specialP()) // special variable
44: machine.special_set(sym, val);
45:
46: else
47: // global variable
48: sym.setf_symbol_value(val);
49:
50: machine.S.push(val);
51: machine.C.pop();
52: }
53:
54: public LispValue CompileArgs(LispCompiler compiler,
55: SECDMachine machine, LispValue args, LispValue valueList,
56: LispValue code) throws CompilerException {
57:
58: // 13 Dec 2005 (mh)
59: // SETQ is not compiling correctly (noticed by Ola Bini).
60: // Also, SET is not compiling correctly. They are always modifying the
61: // global value of the symbol, not the local value. Fixed it by passing in
62: // the index instead of the symbol name if it is known to have a binding.
63:
64: LispValue lookupVal = compiler.indexAndAttribute(args.first(),
65: valueList);
66:
67: if (lookupVal.second().basic_null()) // SETQ of a global var
68: return f_lisp.makeCons(machine.LDC, f_lisp.makeCons(args
69: .first(), compiler.compile(args.second(),
70: valueList, code)));
71:
72: else
73: // SETQ of a local var, inside a LET or something like that.
74: return f_lisp.makeCons(machine.LDC, f_lisp.makeCons(
75: lookupVal.second(), compiler.compile(args.second(),
76: valueList, code)));
77: }
78: }
|