001: /*
002: * Do.java
003: *
004: * Copyright (C) 2003 Peter Graves
005: * $Id: Do.java,v 1.6 2003/11/15 11:03:31 beedlem 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: public LispObject execute(LispObject args, Environment env)
028: throws ConditionThrowable {
029: return _do(args, env, false);
030: }
031: };
032:
033: // ### do*
034: private static final SpecialOperator DO_ = new SpecialOperator(
035: "do*") {
036: public LispObject execute(LispObject args, Environment env)
037: throws ConditionThrowable {
038: return _do(args, env, true);
039: }
040: };
041:
042: private static final LispObject _do(LispObject args,
043: Environment env, boolean sequential)
044: throws ConditionThrowable {
045: // Process variable specifications.
046: LispObject first = args.car();
047: args = args.cdr();
048: int length = first.length();
049: Symbol[] variables = new Symbol[length];
050: LispObject[] initials = new LispObject[length];
051: LispObject[] updates = new LispObject[length];
052: for (int i = 0; i < length; i++) {
053: LispObject obj = first.car();
054: if (obj instanceof Cons) {
055: variables[i] = checkSymbol(obj.car());
056: initials[i] = obj.cadr();
057: // Is there a step form?
058: if (obj.cdr().cdr() != NIL)
059: updates[i] = obj.cdr().cdr().car();
060: } else {
061: // Not a cons, must be a symbol.
062: variables[i] = checkSymbol(obj);
063: initials[i] = NIL;
064: }
065: first = first.cdr();
066: }
067: final LispThread thread = LispThread.currentThread();
068: Environment oldDynEnv = thread.getDynamicEnvironment();
069: Environment ext = new Environment(env);
070: for (int i = 0; i < length; i++) {
071: Symbol symbol = variables[i];
072: LispObject value = eval(initials[i], (sequential ? ext
073: : env), thread);
074: bind(symbol, value, ext);
075: }
076: LispObject second = args.car();
077: LispObject test = second.car();
078: LispObject resultForms = second.cdr();
079: LispObject body = args.cdr();
080: final int depth = thread.getStackDepth();
081: // Look for tags.
082: Binding tags = null;
083: LispObject remaining = body;
084: while (remaining != NIL) {
085: LispObject current = remaining.car();
086: remaining = remaining.cdr();
087: if (current instanceof Cons)
088: continue;
089: // It's a tag.
090: tags = new Binding(current, remaining, tags);
091: }
092: try {
093: // Implicit block.
094: while (true) {
095: // Execute body.
096: // Test for termination.
097: if (eval(test, ext, thread) != NIL)
098: break;
099: remaining = body;
100: while (remaining != NIL) {
101: LispObject current = remaining.car();
102: if (current instanceof Cons) {
103: try {
104: // Handle GO inline if possible.
105: if (current.car() == Symbol.GO) {
106: LispObject code = null;
107: LispObject tag = current.cadr();
108: for (Binding binding = tags; binding != null; binding = binding.next) {
109: if (binding.symbol.eql(tag)) {
110: code = binding.value;
111: break;
112: }
113: }
114: if (code != null) {
115: remaining = code;
116: continue;
117: }
118: throw new Go(tag);
119: }
120: eval(current, ext, thread);
121: } catch (Go go) {
122: LispObject code = null;
123: LispObject tag = go.getTag();
124: for (Binding binding = tags; binding != null; binding = binding.next) {
125: if (binding.symbol.eql(tag)) {
126: code = binding.value;
127: break;
128: }
129: }
130: if (code != null) {
131: remaining = code;
132: thread.setStackDepth(depth);
133: continue;
134: }
135: throw go;
136: }
137: }
138: remaining = remaining.cdr();
139: }
140: // Update variables.
141: if (sequential) {
142: for (int i = 0; i < length; i++) {
143: LispObject update = updates[i];
144: if (update != null)
145: rebind(variables[i], eval(update, ext,
146: thread), ext);
147: }
148: } else {
149: // Evaluate step forms.
150: LispObject results[] = new LispObject[length];
151: for (int i = 0; i < length; i++) {
152: LispObject update = updates[i];
153: if (update != null) {
154: LispObject result = eval(update, ext,
155: thread);
156: results[i] = result;
157: }
158: }
159: // Update variables.
160: for (int i = 0; i < length; i++) {
161: if (results[i] != null) {
162: Symbol symbol = variables[i];
163: rebind(symbol, results[i], ext);
164: }
165: }
166: }
167: }
168: LispObject result = progn(resultForms, ext, thread);
169: return result;
170: } catch (Return ret) {
171: if (ret.getTag() == NIL) {
172: thread.setStackDepth(depth);
173: return ret.getResult();
174: }
175: throw ret;
176: } finally {
177: thread.setDynamicEnvironment(oldDynEnv);
178: }
179: }
180: }
|