001: /*
002: * dolist.java
003: *
004: * Copyright (C) 2003 Peter Graves
005: * $Id: dolist.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: // ### dolist
025: public final class dolist extends SpecialOperator {
026: private dolist() {
027: super ("dolist");
028: }
029:
030: public LispObject execute(LispObject args, Environment env)
031: throws ConditionThrowable {
032: LispObject bodyForm = args.cdr();
033: args = args.car();
034: Symbol var = checkSymbol(args.car());
035: LispObject listForm = args.cadr();
036: final LispThread thread = LispThread.currentThread();
037: LispObject resultForm = args.cdr().cdr().car();
038: Environment oldDynEnv = thread.getDynamicEnvironment();
039: int depth = thread.getStackDepth();
040: try {
041: LispObject list = checkList(eval(listForm, env, thread));
042: // Look for tags.
043: Binding tags = null;
044: LispObject remaining = bodyForm;
045: while (remaining != NIL) {
046: LispObject current = remaining.car();
047: remaining = remaining.cdr();
048: if (current instanceof Cons)
049: continue;
050: // It's a tag.
051: tags = new Binding(current, remaining, tags);
052: }
053: while (list != NIL) {
054: Environment ext = new Environment(env);
055: bind(var, list.car(), ext);
056: LispObject body = bodyForm;
057: while (body != NIL) {
058: LispObject current = body.car();
059: if (current instanceof Cons) {
060: try {
061: // Handle GO inline if possible.
062: if (current.car() == Symbol.GO) {
063: LispObject code = null;
064: LispObject tag = current.cadr();
065: for (Binding binding = tags; binding != null; binding = binding.next) {
066: if (binding.symbol.eql(tag)) {
067: code = binding.value;
068: break;
069: }
070: }
071: if (code != null) {
072: body = code;
073: continue;
074: }
075: throw new Go(tag);
076: }
077: eval(current, ext, thread);
078: } catch (Go go) {
079: LispObject code = null;
080: LispObject tag = go.getTag();
081: for (Binding binding = tags; binding != null; binding = binding.next) {
082: if (binding.symbol.eql(tag)) {
083: code = binding.value;
084: break;
085: }
086: }
087: if (code != null) {
088: body = code;
089: thread.setStackDepth(depth);
090: continue;
091: }
092: throw go;
093: }
094: }
095: body = body.cdr();
096: }
097: list = list.cdr();
098: }
099: Environment ext = new Environment(env);
100: bind(var, NIL, ext);
101: LispObject result = eval(resultForm, ext, thread);
102: return result;
103: } catch (Return ret) {
104: if (ret.getTag() == NIL) {
105: thread.setStackDepth(depth);
106: return ret.getResult();
107: }
108: throw ret;
109: } finally {
110: thread.setDynamicEnvironment(oldDynEnv);
111: }
112: }
113:
114: private static final dolist DOLIST = new dolist();
115: }
|