001: /*
002: * Do.java
003: *
004: * Copyright (C) 2003-2004 Peter Graves
005: * $Id: Do.java,v 1.10 2004/09/19 17:12:01 asimon 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 Do extends Lisp {
025: // ### do
026: private static final SpecialOperator DO = new SpecialOperator("do",
027: "varlist endlist &body body") {
028: public LispObject execute(LispObject args, Environment env)
029: throws ConditionThrowable {
030: return _do(args, env, false);
031: }
032: };
033:
034: // ### do*
035: private static final SpecialOperator DO_ = new SpecialOperator(
036: "do*", "varlist endlist &body body") {
037: public LispObject execute(LispObject args, Environment env)
038: throws ConditionThrowable {
039: return _do(args, env, true);
040: }
041: };
042:
043: private static final LispObject _do(LispObject args,
044: Environment env, boolean sequential)
045: throws ConditionThrowable {
046: LispObject varList = args.car();
047: LispObject second = args.cadr();
048: LispObject endTestForm = second.car();
049: LispObject resultForms = second.cdr();
050: LispObject body = args.cddr();
051: // Process variable specifications.
052: int length = varList.length();
053: Symbol[] variables = new Symbol[length];
054: LispObject[] initials = new LispObject[length];
055: LispObject[] updates = new LispObject[length];
056: for (int i = 0; i < length; i++) {
057: LispObject obj = varList.car();
058: if (obj instanceof Cons) {
059: variables[i] = checkSymbol(obj.car());
060: initials[i] = obj.cadr();
061: // Is there a step form?
062: if (obj.cdr().cdr() != NIL)
063: updates[i] = obj.cdr().cdr().car();
064: } else {
065: // Not a cons, must be a symbol.
066: variables[i] = checkSymbol(obj);
067: initials[i] = NIL;
068: }
069: varList = varList.cdr();
070: }
071: final LispThread thread = LispThread.currentThread();
072: Environment oldDynEnv = thread.getDynamicEnvironment();
073: // Process declarations.
074: LispObject specials = NIL;
075: while (body != NIL) {
076: LispObject obj = body.car();
077: if (obj instanceof Cons && obj.car() == Symbol.DECLARE) {
078: LispObject decls = obj.cdr();
079: while (decls != NIL) {
080: LispObject decl = decls.car();
081: if (decl instanceof Cons
082: && decl.car() == Symbol.SPECIAL) {
083: LispObject vars = decl.cdr();
084: while (vars != NIL) {
085: specials = new Cons(vars.car(), specials);
086: vars = vars.cdr();
087: }
088: }
089: decls = decls.cdr();
090: }
091: body = body.cdr();
092: } else
093: break;
094: }
095: final Environment ext = new Environment(env);
096: for (int i = 0; i < length; i++) {
097: Symbol symbol = variables[i];
098: LispObject value = eval(initials[i], (sequential ? ext
099: : env), thread);
100: if (specials != NIL && memq(symbol, specials)) {
101: thread.bindSpecial(symbol, value);
102: ext.declareSpecial(symbol);
103: } else if (symbol.isSpecialVariable()) {
104: thread.bindSpecial(symbol, value);
105: } else
106: ext.bind(symbol, value);
107: }
108: final LispObject stack = thread.getStack();
109: // Look for tags.
110: LispObject remaining = body;
111: while (remaining != NIL) {
112: LispObject current = remaining.car();
113: remaining = remaining.cdr();
114: if (current instanceof Cons)
115: continue;
116: // It's a tag.
117: ext.addTagBinding(current, remaining);
118: }
119: try {
120: // Implicit block.
121: ext.addBlock(NIL, new LispObject());
122: while (true) {
123: // Execute body.
124: // Test for termination.
125: if (eval(endTestForm, ext, thread) != NIL)
126: break;
127: remaining = body;
128: while (remaining != NIL) {
129: LispObject current = remaining.car();
130: if (current instanceof Cons) {
131: try {
132: // Handle GO inline if possible.
133: if (current.car() == Symbol.GO) {
134: LispObject tag = current.cadr();
135: Binding binding = ext
136: .getTagBinding(tag);
137: if (binding != null
138: && binding.value != null) {
139: remaining = binding.value;
140: continue;
141: }
142: throw new Go(tag);
143: }
144: eval(current, ext, thread);
145: } catch (Go go) {
146: LispObject tag = go.getTag();
147: Binding binding = ext.getTagBinding(tag);
148: if (binding != null
149: && binding.value != null) {
150: remaining = binding.value;
151: thread.setStack(stack);
152: continue;
153: }
154: throw go;
155: }
156: }
157: remaining = remaining.cdr();
158: }
159: // Update variables.
160: if (sequential) {
161: for (int i = 0; i < length; i++) {
162: LispObject update = updates[i];
163: if (update != null) {
164: Symbol symbol = variables[i];
165: LispObject value = eval(update, ext, thread);
166: if (specials != NIL
167: && memq(symbol, specials)) {
168: thread.getDynamicEnvironment().rebind(
169: symbol, value);
170: } else if (symbol.isSpecialVariable()) {
171: thread.getDynamicEnvironment().rebind(
172: symbol, value);
173: } else
174: ext.rebind(symbol, value);
175: }
176: }
177: } else {
178: // Evaluate step forms.
179: LispObject results[] = new LispObject[length];
180: for (int i = 0; i < length; i++) {
181: LispObject update = updates[i];
182: if (update != null) {
183: LispObject result = eval(update, ext,
184: thread);
185: results[i] = result;
186: }
187: }
188: // Update variables.
189: for (int i = 0; i < length; i++) {
190: if (results[i] != null) {
191: Symbol symbol = variables[i];
192: LispObject value = results[i];
193: if (specials != NIL
194: && memq(symbol, specials)) {
195: thread.getDynamicEnvironment().rebind(
196: symbol, value);
197: } else if (symbol.isSpecialVariable()) {
198: thread.getDynamicEnvironment().rebind(
199: symbol, value);
200: } else
201: ext.rebind(symbol, value);
202: }
203: }
204: }
205: if (interrupted)
206: handleInterrupt();
207: }
208: LispObject result = progn(resultForms, ext, thread);
209: return result;
210: } catch (Return ret) {
211: if (ret.getTag() == NIL) {
212: thread.setStack(stack);
213: return ret.getResult();
214: }
215: throw ret;
216: } finally {
217: thread.setDynamicEnvironment(oldDynEnv);
218: }
219: }
220: }
|