001: /*
002: * dotimes.java
003: *
004: * Copyright (C) 2003-2004 Peter Graves
005: * $Id: dotimes.java,v 1.12 2004/08/09 18:45:35 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 dotimes extends SpecialOperator {
025: private dotimes() {
026: super ("dotimes");
027: }
028:
029: public LispObject execute(LispObject args, Environment env)
030: throws ConditionThrowable {
031: LispObject bodyForm = args.cdr();
032: args = args.car();
033: Symbol var = checkSymbol(args.car());
034: LispObject countForm = args.cadr();
035: final LispThread thread = LispThread.currentThread();
036: LispObject resultForm = args.cdr().cdr().car();
037: Environment oldDynEnv = thread.getDynamicEnvironment();
038: final LispObject stack = thread.getStack();
039: // Process declarations.
040: LispObject specials = NIL;
041: while (bodyForm != NIL) {
042: LispObject obj = bodyForm.car();
043: if (obj instanceof Cons && obj.car() == Symbol.DECLARE) {
044: LispObject decls = obj.cdr();
045: while (decls != NIL) {
046: LispObject decl = decls.car();
047: if (decl instanceof Cons
048: && decl.car() == Symbol.SPECIAL) {
049: LispObject vars = decl.cdr();
050: while (vars != NIL) {
051: specials = new Cons(vars.car(), specials);
052: vars = vars.cdr();
053: }
054: }
055: decls = decls.cdr();
056: }
057: bodyForm = bodyForm.cdr();
058: } else
059: break;
060: }
061: try {
062: LispObject limit = eval(countForm, env, thread);
063: Environment ext = new Environment(env);
064: LispObject localTags = NIL; // Tags that are local to this TAGBODY.
065: // Look for tags.
066: LispObject remaining = bodyForm;
067: while (remaining != NIL) {
068: LispObject current = remaining.car();
069: remaining = remaining.cdr();
070: if (current instanceof Cons)
071: continue;
072: // It's a tag.
073: ext.addTagBinding(current, remaining);
074: localTags = new Cons(current, localTags);
075: }
076: // Implicit block.
077: ext.addBlock(NIL, new LispObject());
078: LispObject result;
079: // Establish a reusable binding.
080: final Binding binding;
081: if (specials != NIL && memq(var, specials)) {
082: thread.bindSpecial(var, null);
083: binding = thread.getDynamicEnvironment()
084: .getBinding(var);
085: ext.declareSpecial(var);
086: } else if (var.isSpecialVariable()) {
087: thread.bindSpecial(var, null);
088: binding = thread.getDynamicEnvironment()
089: .getBinding(var);
090: } else {
091: ext.bind(var, null);
092: binding = ext.getBinding(var);
093: }
094: if (limit instanceof Fixnum) {
095: int count = ((Fixnum) limit).value;
096: int i;
097: for (i = 0; i < count; i++) {
098: binding.value = new Fixnum(i);
099: LispObject body = bodyForm;
100: while (body != NIL) {
101: LispObject current = body.car();
102: if (current instanceof Cons) {
103: try {
104: // Handle GO inline if possible.
105: if (current.car() == Symbol.GO) {
106: LispObject tag = current.cadr();
107: if (memql(tag, localTags)) {
108: Binding b = ext
109: .getTagBinding(tag);
110: if (b != null
111: && b.value != null) {
112: body = b.value;
113: continue;
114: }
115: }
116: throw new Go(tag);
117: }
118: eval(current, ext, thread);
119: } catch (Go go) {
120: LispObject tag = go.getTag();
121: if (memql(tag, localTags)) {
122: Binding b = ext.getTagBinding(tag);
123: if (b != null && b.value != null) {
124: body = b.value;
125: thread.setStack(stack);
126: continue;
127: }
128: }
129: throw go;
130: }
131: }
132: body = body.cdr();
133: }
134: if (interrupted)
135: handleInterrupt();
136: }
137: binding.value = new Fixnum(i);
138: result = eval(resultForm, ext, thread);
139: } else if (limit instanceof Bignum) {
140: LispObject i = Fixnum.ZERO;
141: while (i.isLessThan(limit)) {
142: binding.value = i;
143: LispObject body = bodyForm;
144: while (body != NIL) {
145: LispObject current = body.car();
146: if (current instanceof Cons) {
147: try {
148: // Handle GO inline if possible.
149: if (current.car() == Symbol.GO) {
150: LispObject tag = current.cadr();
151: if (memql(tag, localTags)) {
152: Binding b = ext
153: .getTagBinding(tag);
154: if (b != null
155: && b.value != null) {
156: body = b.value;
157: continue;
158: }
159: }
160: throw new Go(tag);
161: }
162: eval(current, ext, thread);
163: } catch (Go go) {
164: LispObject code = null;
165: LispObject tag = go.getTag();
166: if (memql(tag, localTags)) {
167: Binding b = ext.getTagBinding(tag);
168: if (b != null && b.value != null) {
169: body = b.value;
170: thread.setStack(stack);
171: continue;
172: }
173: }
174: throw go;
175: }
176: }
177: body = body.cdr();
178: }
179: i = i.incr();
180: if (interrupted)
181: handleInterrupt();
182: }
183: binding.value = i;
184: result = eval(resultForm, ext, thread);
185: } else
186: return signal(new TypeError(limit, Symbol.INTEGER));
187: return result;
188: } catch (Return ret) {
189: if (ret.getTag() == NIL) {
190: thread.setStack(stack);
191: return ret.getResult();
192: }
193: throw ret;
194: } finally {
195: thread.setDynamicEnvironment(oldDynEnv);
196: }
197: }
198:
199: private static final dotimes DOTIMES = new dotimes();
200: }
|