001: /*
002: * dolist.java
003: *
004: * Copyright (C) 2003-2004 Peter Graves
005: * $Id: dolist.java,v 1.9 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: // ### 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: final LispObject stack = thread.getStack();
040: // Process declarations.
041: LispObject specials = NIL;
042: while (bodyForm != NIL) {
043: LispObject obj = bodyForm.car();
044: if (obj instanceof Cons && obj.car() == Symbol.DECLARE) {
045: LispObject decls = obj.cdr();
046: while (decls != NIL) {
047: LispObject decl = decls.car();
048: if (decl instanceof Cons
049: && decl.car() == Symbol.SPECIAL) {
050: LispObject vars = decl.cdr();
051: while (vars != NIL) {
052: specials = new Cons(vars.car(), specials);
053: vars = vars.cdr();
054: }
055: }
056: decls = decls.cdr();
057: }
058: bodyForm = bodyForm.cdr();
059: } else
060: break;
061: }
062: try {
063: LispObject list = checkList(eval(listForm, env, thread));
064: final Environment ext = new Environment(env);
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: }
075: // Implicit block.
076: ext.addBlock(NIL, new LispObject());
077: // Establish a reusable binding.
078: final Binding binding;
079: if (var.isSpecialVariable()
080: || (specials != NIL && memq(var, specials))) {
081: thread.bindSpecial(var, null);
082: binding = thread.getDynamicEnvironment()
083: .getBinding(var);
084: ext.declareSpecial(var);
085: } else if (var.isSpecialVariable()) {
086: thread.bindSpecial(var, null);
087: binding = thread.getDynamicEnvironment()
088: .getBinding(var);
089: } else {
090: ext.bind(var, null);
091: binding = ext.getBinding(var);
092: }
093: while (list != NIL) {
094: binding.value = list.car();
095: LispObject body = bodyForm;
096: while (body != NIL) {
097: LispObject current = body.car();
098: if (current instanceof Cons) {
099: try {
100: // Handle GO inline if possible.
101: if (current.car() == Symbol.GO) {
102: LispObject tag = current.cadr();
103: Binding b = ext.getTagBinding(tag);
104: if (b != null && b.value != null) {
105: body = b.value;
106: continue;
107: }
108: throw new Go(tag);
109: }
110: eval(current, ext, thread);
111: } catch (Go go) {
112: LispObject tag = go.getTag();
113: Binding b = ext.getTagBinding(tag);
114: if (b != null && b.value != null) {
115: body = b.value;
116: thread.setStack(stack);
117: continue;
118: }
119: throw go;
120: }
121: }
122: body = body.cdr();
123: }
124: list = list.cdr();
125: if (interrupted)
126: handleInterrupt();
127: }
128: binding.value = NIL;
129: LispObject result = eval(resultForm, ext, thread);
130: return result;
131: } catch (Return ret) {
132: if (ret.getTag() == NIL) {
133: thread.setStack(stack);
134: return ret.getResult();
135: }
136: throw ret;
137: } finally {
138: thread.setDynamicEnvironment(oldDynEnv);
139: }
140: }
141:
142: private static final dolist DOLIST = new dolist();
143: }
|