KickJava   Java API By Example, From Geeks To Geeks.

Java > Open Source Codes > org > armedbear > lisp > dolist


1 /*
2  * dolist.java
3  *
4  * Copyright (C) 2003-2004 Peter Graves
5  * $Id: dolist.java,v 1.9 2004/08/09 18:45:35 piso Exp $
6  *
7  * This program is free software; you can redistribute it and/or
8  * modify it under the terms of the GNU General Public License
9  * as published by the Free Software Foundation; either version 2
10  * of the License, or (at your option) any later version.
11  *
12  * This program is distributed in the hope that it will be useful,
13  * but WITHOUT ANY WARRANTY; without even the implied warranty of
14  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15  * GNU General Public License for more details.
16  *
17  * You should have received a copy of the GNU General Public License
18  * along with this program; if not, write to the Free Software
19  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
20  */

21
22 package org.armedbear.lisp;
23
24 // ### dolist
25
public final class dolist extends SpecialOperator
26 {
27     private dolist()
28     {
29         super("dolist");
30     }
31
32     public LispObject execute(LispObject args, Environment env)
33         throws ConditionThrowable
34     {
35         LispObject bodyForm = args.cdr();
36         args = args.car();
37         Symbol var = checkSymbol(args.car());
38         LispObject listForm = args.cadr();
39         final LispThread thread = LispThread.currentThread();
40         LispObject resultForm = args.cdr().cdr().car();
41         Environment oldDynEnv = thread.getDynamicEnvironment();
42         final LispObject stack = thread.getStack();
43         // Process declarations.
44
LispObject specials = NIL;
45         while (bodyForm != NIL) {
46             LispObject obj = bodyForm.car();
47             if (obj instanceof Cons && obj.car() == Symbol.DECLARE) {
48                 LispObject decls = obj.cdr();
49                 while (decls != NIL) {
50                     LispObject decl = decls.car();
51                     if (decl instanceof Cons && decl.car() == Symbol.SPECIAL) {
52                         LispObject vars = decl.cdr();
53                         while (vars != NIL) {
54                             specials = new Cons(vars.car(), specials);
55                             vars = vars.cdr();
56                         }
57                     }
58                     decls = decls.cdr();
59                 }
60                 bodyForm = bodyForm.cdr();
61             } else
62                 break;
63         }
64         try {
65             LispObject list = checkList(eval(listForm, env, thread));
66             final Environment ext = new Environment(env);
67             // Look for tags.
68
LispObject remaining = bodyForm;
69             while (remaining != NIL) {
70                 LispObject current = remaining.car();
71                 remaining = remaining.cdr();
72                 if (current instanceof Cons)
73                     continue;
74                 // It's a tag.
75
ext.addTagBinding(current, remaining);
76             }
77             // Implicit block.
78
ext.addBlock(NIL, new LispObject());
79             // Establish a reusable binding.
80
final Binding binding;
81             if (var.isSpecialVariable() || (specials != NIL && memq(var, specials))) {
82                 thread.bindSpecial(var, null);
83                 binding = thread.getDynamicEnvironment().getBinding(var);
84                 ext.declareSpecial(var);
85             } else if (var.isSpecialVariable()) {
86                 thread.bindSpecial(var, null);
87                 binding = thread.getDynamicEnvironment().getBinding(var);
88             } else {
89                 ext.bind(var, null);
90                 binding = ext.getBinding(var);
91             }
92             while (list != NIL) {
93                 binding.value = list.car();
94                 LispObject body = bodyForm;
95                 while (body != NIL) {
96                     LispObject current = body.car();
97                     if (current instanceof Cons) {
98                         try {
99                             // Handle GO inline if possible.
100
if (current.car() == Symbol.GO) {
101                                 LispObject tag = current.cadr();
102                                 Binding b = ext.getTagBinding(tag);
103                                 if (b != null && b.value != null) {
104                                     body = b.value;
105                                     continue;
106                                 }
107                                 throw new Go(tag);
108                             }
109                             eval(current, ext, thread);
110                         }
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         }
132         catch (Return ret) {
133             if (ret.getTag() == NIL) {
134                 thread.setStack(stack);
135                 return ret.getResult();
136             }
137             throw ret;
138         }
139         finally {
140             thread.setDynamicEnvironment(oldDynEnv);
141         }
142     }
143
144     private static final dolist DOLIST = new dolist();
145 }
146
Popular Tags