001: /*
002: * dotimes.java
003: *
004: * Copyright (C) 2003 Peter Graves
005: * $Id: dotimes.java,v 1.6 2003/11/15 11:03:33 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 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: int depth = thread.getStackDepth();
039: try {
040: LispObject limit = eval(countForm, env, thread);
041: // Look for tags.
042: Binding tags = null;
043: LispObject remaining = bodyForm;
044: while (remaining != NIL) {
045: LispObject current = remaining.car();
046: remaining = remaining.cdr();
047: if (current instanceof Cons)
048: continue;
049: // It's a tag.
050: tags = new Binding(current, remaining, tags);
051: }
052: LispObject result;
053: if (limit instanceof Fixnum) {
054: int count = ((Fixnum) limit).getValue();
055: int i;
056: for (i = 0; i < count; i++) {
057: Environment ext = new Environment(env);
058: bind(var, new Fixnum(i), ext);
059: LispObject body = bodyForm;
060: while (body != NIL) {
061: LispObject current = body.car();
062: if (current instanceof Cons) {
063: try {
064: // Handle GO inline if possible.
065: if (current.car() == Symbol.GO) {
066: LispObject code = null;
067: LispObject tag = current.cadr();
068: for (Binding binding = tags; binding != null; binding = binding.next) {
069: if (binding.symbol.eql(tag)) {
070: code = binding.value;
071: break;
072: }
073: }
074: if (code != null) {
075: body = code;
076: continue;
077: }
078: throw new Go(tag);
079: }
080: eval(current, ext, thread);
081: } catch (Go go) {
082: LispObject code = null;
083: LispObject tag = go.getTag();
084: for (Binding binding = tags; binding != null; binding = binding.next) {
085: if (binding.symbol.eql(tag)) {
086: code = binding.value;
087: break;
088: }
089: }
090: if (code != null) {
091: body = code;
092: thread.setStackDepth(depth);
093: continue;
094: }
095: throw go;
096: }
097: }
098: body = body.cdr();
099: }
100: }
101: Environment ext = new Environment(env);
102: bind(var, new Fixnum(i), ext);
103: result = eval(resultForm, ext, thread);
104: } else if (limit instanceof Bignum) {
105: LispObject i = Fixnum.ZERO;
106: while (i.isLessThan(limit)) {
107: Environment ext = new Environment(env);
108: bind(var, i, ext);
109: LispObject body = bodyForm;
110: while (body != NIL) {
111: LispObject current = body.car();
112: if (current instanceof Cons) {
113: try {
114: // Handle GO inline if possible.
115: if (current.car() == Symbol.GO) {
116: LispObject code = null;
117: LispObject tag = current.cadr();
118: for (Binding binding = tags; binding != null; binding = binding.next) {
119: if (binding.symbol.eql(tag)) {
120: code = binding.value;
121: break;
122: }
123: }
124: if (code != null) {
125: body = code;
126: continue;
127: }
128: throw new Go(tag);
129: }
130: eval(current, ext, thread);
131: } catch (Go go) {
132: LispObject code = null;
133: LispObject tag = go.getTag();
134: for (Binding binding = tags; binding != null; binding = binding.next) {
135: if (binding.symbol.eql(tag)) {
136: code = binding.value;
137: break;
138: }
139: }
140: if (code != null) {
141: body = code;
142: thread.setStackDepth(depth);
143: continue;
144: }
145: throw go;
146: }
147: }
148: body = body.cdr();
149: }
150: i = i.incr();
151: }
152: Environment ext = new Environment(env);
153: bind(var, i, ext);
154: result = eval(resultForm, ext, thread);
155: } else
156: throw new ConditionThrowable(new TypeError(limit,
157: "integer"));
158: return result;
159: } catch (Return ret) {
160: if (ret.getTag() == NIL) {
161: thread.setStackDepth(depth);
162: return ret.getResult();
163: }
164: throw ret;
165: } finally {
166: thread.setDynamicEnvironment(oldDynEnv);
167: }
168: }
169:
170: private static final dotimes DOTIMES = new dotimes();
171: }
|