1 21 22 package org.armedbear.lisp; 23 24 public final class Do extends Lisp 25 { 26 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 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 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 if (obj.cdr().cdr() != NIL) 67 updates[i] = obj.cdr().cdr().car(); 68 } else { 69 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 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 LispObject remaining = body; 114 while (remaining != NIL) { 115 LispObject current = remaining.car(); 116 remaining = remaining.cdr(); 117 if (current instanceof Cons) 118 continue; 119 ext.addTagBinding(current, remaining); 121 } 122 try { 123 ext.addBlock(NIL, new LispObject()); 125 while (true) { 126 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 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 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 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 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 |