KickJava   Java API By Example, From Geeks To Geeks.

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


1 /*
2  * Do.java
3  *
4  * Copyright (C) 2003-2004 Peter Graves
5  * $Id: Do.java,v 1.10 2004/09/19 17:12:01 asimon 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 public final class Do extends Lisp
25 {
26     // ### do
27
private static final SpecialOperator DO = new SpecialOperator("do", "varlist endlist &body body")
28     {
29         public LispObject execute(LispObject args, Environment env)
30             throws ConditionThrowable
31         {
32             return _do(args, env, false);
33         }
34     };
35
36     // ### do*
37
private static final SpecialOperator DO_ = new SpecialOperator("do*", "varlist endlist &body body")
38     {
39         public LispObject execute(LispObject args, Environment env)
40             throws ConditionThrowable
41         {
42             return _do(args, env, true);
43         }
44     };
45
46     private static final LispObject _do(LispObject args, Environment env,
47                                         boolean sequential)
48         throws ConditionThrowable
49     {
50         LispObject varList = args.car();
51         LispObject second = args.cadr();
52         LispObject endTestForm = second.car();
53         LispObject resultForms = second.cdr();
54         LispObject body = args.cddr();
55         // Process variable specifications.
56
int length = varList.length();
57         Symbol[] variables = new Symbol[length];
58         LispObject[] initials = new LispObject[length];
59         LispObject[] updates = new LispObject[length];
60         for (int i = 0; i < length; i++) {
61             LispObject obj = varList.car();
62             if (obj instanceof Cons) {
63                 variables[i] = checkSymbol(obj.car());
64                 initials[i] = obj.cadr();
65                 // Is there a step form?
66
if (obj.cdr().cdr() != NIL)
67                     updates[i] = obj.cdr().cdr().car();
68             } else {
69                 // Not a cons, must be a symbol.
70
variables[i] = checkSymbol(obj);
71                 initials[i] = NIL;
72             }
73             varList = varList.cdr();
74         }
75         final LispThread thread = LispThread.currentThread();
76         Environment oldDynEnv = thread.getDynamicEnvironment();
77         // Process declarations.
78
LispObject specials = NIL;
79         while (body != NIL) {
80             LispObject obj = body.car();
81             if (obj instanceof Cons && obj.car() == Symbol.DECLARE) {
82                 LispObject decls = obj.cdr();
83                 while (decls != NIL) {
84                     LispObject decl = decls.car();
85                     if (decl instanceof Cons && decl.car() == Symbol.SPECIAL) {
86                         LispObject vars = decl.cdr();
87                         while (vars != NIL) {
88                             specials = new Cons(vars.car(), specials);
89                             vars = vars.cdr();
90                         }
91                     }
92                     decls = decls.cdr();
93                 }
94                 body = body.cdr();
95             } else
96                 break;
97         }
98         final Environment ext = new Environment(env);
99         for (int i = 0; i < length; i++) {
100             Symbol symbol = variables[i];
101             LispObject value =
102                 eval(initials[i], (sequential ? ext : env), thread);
103             if (specials != NIL && memq(symbol, specials)) {
104                 thread.bindSpecial(symbol, value);
105                 ext.declareSpecial(symbol);
106             } else if (symbol.isSpecialVariable()) {
107                 thread.bindSpecial(symbol, value);
108             } else
109                 ext.bind(symbol, value);
110         }
111         final LispObject stack = thread.getStack();
112         // Look for tags.
113
LispObject remaining = body;
114         while (remaining != NIL) {
115             LispObject current = remaining.car();
116             remaining = remaining.cdr();
117             if (current instanceof Cons)
118                 continue;
119             // It's a tag.
120
ext.addTagBinding(current, remaining);
121         }
122         try {
123             // Implicit block.
124
ext.addBlock(NIL, new LispObject());
125             while (true) {
126                 // Execute body.
127
// Test for termination.
128
if (eval(endTestForm, ext, thread) != NIL)
129                     break;
130                 remaining = body;
131                 while (remaining != NIL) {
132                     LispObject current = remaining.car();
133                     if (current instanceof Cons) {
134                         try {
135                             // Handle GO inline if possible.
136
if (current.car() == Symbol.GO) {
137                                 LispObject tag = current.cadr();
138                                 Binding binding = ext.getTagBinding(tag);
139                                 if (binding != null && binding.value != null) {
140                                     remaining = binding.value;
141                                     continue;
142                                 }
143                                 throw new Go(tag);
144                             }
145                             eval(current, ext, thread);
146                         }
147                         catch (Go go) {
148                             LispObject tag = go.getTag();
149                             Binding binding = ext.getTagBinding(tag);
150                             if (binding != null && binding.value != null) {
151                                 remaining = binding.value;
152                                 thread.setStack(stack);
153                                 continue;
154                             }
155                             throw go;
156                         }
157                     }
158                     remaining = remaining.cdr();
159                 }
160                 // Update variables.
161
if (sequential) {
162                     for (int i = 0; i < length; i++) {
163                         LispObject update = updates[i];
164                         if (update != null) {
165                             Symbol symbol = variables[i];
166                             LispObject value = eval(update, ext, thread);
167                             if (specials != NIL && memq(symbol, specials)) {
168                                 thread.getDynamicEnvironment().rebind(symbol, value);
169                             } else if (symbol.isSpecialVariable()) {
170                                 thread.getDynamicEnvironment().rebind(symbol, value);
171                             } else
172                                 ext.rebind(symbol, value);
173                         }
174                     }
175                 } else {
176                     // Evaluate step forms.
177
LispObject results[] = new LispObject[length];
178                     for (int i = 0; i < length; i++) {
179                         LispObject update = updates[i];
180                         if (update != null) {
181                             LispObject result = eval(update, ext, thread);
182                             results[i] = result;
183                         }
184                     }
185                     // Update variables.
186
for (int i = 0; i < length; i++) {
187                         if (results[i] != null) {
188                             Symbol symbol = variables[i];
189                             LispObject value = results[i];
190                             if (specials != NIL && memq(symbol, specials)) {
191                                 thread.getDynamicEnvironment().rebind(symbol, value);
192                             } else if (symbol.isSpecialVariable()) {
193                                 thread.getDynamicEnvironment().rebind(symbol, value);
194                             } else
195                                 ext.rebind(symbol, value);
196                         }
197                     }
198                 }
199                 if (interrupted)
200                     handleInterrupt();
201             }
202             LispObject result = progn(resultForms, ext, thread);
203             return result;
204         }
205         catch (Return ret) {
206             if (ret.getTag() == NIL) {
207                 thread.setStack(stack);
208                 return ret.getResult();
209             }
210             throw ret;
211         }
212         finally {
213             thread.setDynamicEnvironment(oldDynEnv);
214         }
215     }
216 }
217
Popular Tags