001: /*
002: * Environment.java
003: *
004: * Copyright (C) 2002-2004 Peter Graves
005: * $Id: Environment.java,v 1.16 2004/08/19 18:14:46 piso Exp $
006: *
007: * This program is free software; you can redistribute it and/or
008: * modify it under the terms of the GNU General Public License
009: * as published by the Free Software Foundation; either version 2
010: * of the License, or (at your option) any later version.
011: *
012: * This program is distributed in the hope that it will be useful,
013: * but WITHOUT ANY WARRANTY; without even the implied warranty of
014: * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
015: * GNU General Public License for more details.
016: *
017: * You should have received a copy of the GNU General Public License
018: * along with this program; if not, write to the Free Software
019: * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
020: */
021:
022: package org.armedbear.lisp;
023:
024: public final class Environment extends LispObject {
025: private Binding vars;
026: private Binding functions;
027: private Binding blocks;
028: private Binding tags;
029:
030: public Environment() {
031: }
032:
033: public Environment(Environment parent) {
034: if (parent != null) {
035: vars = parent.vars;
036: functions = parent.functions;
037: blocks = parent.blocks;
038: tags = parent.tags;
039: }
040: }
041:
042: // Construct a new Environment extending parent with the specified symbol-
043: // value binding.
044: public Environment(Environment parent, Symbol symbol,
045: LispObject value) {
046: if (parent != null) {
047: vars = parent.vars;
048: functions = parent.functions;
049: blocks = parent.blocks;
050: tags = parent.tags;
051: }
052: vars = new Binding(symbol, value, vars);
053: }
054:
055: public boolean isEmpty() {
056: if (functions != null)
057: return false;
058: if (vars != null) {
059: for (Binding binding = vars; binding != null; binding = binding.next)
060: if (!binding.specialp)
061: return false;
062: }
063: return true;
064: }
065:
066: public void bind(Symbol symbol, LispObject value) {
067: vars = new Binding(symbol, value, vars);
068: }
069:
070: public void rebind(Symbol symbol, LispObject value) {
071: Binding binding = getBinding(symbol);
072: binding.value = value;
073: }
074:
075: public LispObject lookup(LispObject symbol) {
076: Binding binding = vars;
077: while (binding != null) {
078: if (binding.symbol == symbol)
079: return binding.value;
080: binding = binding.next;
081: }
082: return null;
083: }
084:
085: public Binding getBinding(LispObject symbol) {
086: Binding binding = vars;
087: while (binding != null) {
088: if (binding.symbol == symbol)
089: return binding;
090: binding = binding.next;
091: }
092: return null;
093: }
094:
095: // Functional bindings.
096: public void bindFunctional(LispObject name, LispObject value) {
097: functions = new Binding(name, value, functions);
098: }
099:
100: public LispObject lookupFunctional(LispObject name)
101: throws ConditionThrowable {
102: Binding binding = functions;
103: if (name instanceof Symbol) {
104: while (binding != null) {
105: if (binding.symbol == name)
106: return binding.value;
107: binding = binding.next;
108: }
109: // Not found in environment.
110: return name.getSymbolFunction();
111: }
112: if (name instanceof Cons) {
113: while (binding != null) {
114: if (binding.symbol.equal(name))
115: return binding.value;
116: binding = binding.next;
117: }
118: }
119: return null;
120: }
121:
122: public void addBlock(LispObject tag, LispObject block) {
123: blocks = new Binding(tag, block, blocks);
124: }
125:
126: public LispObject lookupBlock(LispObject symbol) {
127: Binding binding = blocks;
128: while (binding != null) {
129: if (binding.symbol == symbol)
130: return binding.value;
131: binding = binding.next;
132: }
133: return null;
134: }
135:
136: public void addTagBinding(LispObject tag, LispObject code) {
137: tags = new Binding(tag, code, tags);
138: }
139:
140: public Binding getTagBinding(LispObject tag) {
141: Binding binding = tags;
142: while (binding != null) {
143: if (binding.symbol.eql(tag))
144: return binding;
145: binding = binding.next;
146: }
147: return null;
148: }
149:
150: // Returns body with declarations removed.
151: public LispObject processDeclarations(LispObject body)
152: throws ConditionThrowable {
153: while (body != NIL) {
154: LispObject obj = body.car();
155: if (obj instanceof Cons && obj.car() == Symbol.DECLARE) {
156: LispObject decls = obj.cdr();
157: while (decls != NIL) {
158: LispObject decl = decls.car();
159: if (decl instanceof Cons
160: && decl.car() == Symbol.SPECIAL) {
161: LispObject vars = decl.cdr();
162: while (vars != NIL) {
163: Symbol var = checkSymbol(vars.car());
164: declareSpecial(var);
165: vars = vars.cdr();
166: }
167: }
168: decls = decls.cdr();
169: }
170: body = body.cdr();
171: } else
172: break;
173: }
174: return body;
175: }
176:
177: public void declareSpecial(Symbol var) {
178: vars = new Binding(var, null, vars);
179: vars.specialp = true;
180: }
181:
182: public boolean isDeclaredSpecial(Symbol var) {
183: Binding binding = getBinding(var);
184: return binding != null ? binding.specialp : false;
185: }
186:
187: public String writeToString() {
188: return unreadableString("ENVIRONMENT");
189: }
190:
191: // ### empty-environment-p
192: private static final Primitive1 EMPTY_ENVIRONMENT_P = new Primitive1(
193: "empty-environment-p", PACKAGE_SYS, false, "environment") {
194: public LispObject execute(LispObject arg)
195: throws ConditionThrowable {
196: try {
197: return ((Environment) arg).isEmpty() ? T : NIL;
198: } catch (ClassCastException e) {
199: return signal(new TypeError(arg.writeToString()
200: + " is not an environment."));
201: }
202: }
203: };
204:
205: // ### environment-vars
206: private static final Primitive1 ENVIRONMENT_VARS = new Primitive1(
207: "environment-vars", PACKAGE_SYS, false, "environment") {
208: public LispObject execute(LispObject arg)
209: throws ConditionThrowable {
210: try {
211: Environment env = (Environment) arg;
212: LispObject result = NIL;
213: for (Binding binding = env.vars; binding != null; binding = binding.next)
214: if (!binding.specialp)
215: result = new Cons(binding.symbol, result);
216: return result;
217: } catch (ClassCastException e) {
218: return signal(new TypeError(arg.writeToString()
219: + " is not an environment."));
220: }
221: }
222: };
223: }
|