1 21 22 package org.armedbear.lisp; 23 24 public final class dotimes extends SpecialOperator 25 { 26 private dotimes() 27 { 28 super("dotimes"); 29 } 30 31 public LispObject execute(LispObject args, Environment env) 32 throws ConditionThrowable 33 { 34 LispObject bodyForm = args.cdr(); 35 args = args.car(); 36 Symbol var = checkSymbol(args.car()); 37 LispObject countForm = args.cadr(); 38 final LispThread thread = LispThread.currentThread(); 39 LispObject resultForm = args.cdr().cdr().car(); 40 Environment oldDynEnv = thread.getDynamicEnvironment(); 41 final LispObject stack = thread.getStack(); 42 LispObject specials = NIL; 44 while (bodyForm != NIL) { 45 LispObject obj = bodyForm.car(); 46 if (obj instanceof Cons && obj.car() == Symbol.DECLARE) { 47 LispObject decls = obj.cdr(); 48 while (decls != NIL) { 49 LispObject decl = decls.car(); 50 if (decl instanceof Cons && decl.car() == Symbol.SPECIAL) { 51 LispObject vars = decl.cdr(); 52 while (vars != NIL) { 53 specials = new Cons(vars.car(), specials); 54 vars = vars.cdr(); 55 } 56 } 57 decls = decls.cdr(); 58 } 59 bodyForm = bodyForm.cdr(); 60 } else 61 break; 62 } 63 try { 64 LispObject limit = eval(countForm, env, thread); 65 Environment ext = new Environment(env); 66 LispObject localTags = NIL; LispObject remaining = bodyForm; 69 while (remaining != NIL) { 70 LispObject current = remaining.car(); 71 remaining = remaining.cdr(); 72 if (current instanceof Cons) 73 continue; 74 ext.addTagBinding(current, remaining); 76 localTags = new Cons(current, localTags); 77 } 78 ext.addBlock(NIL, new LispObject()); 80 LispObject result; 81 final Binding binding; 83 if (specials != NIL && memq(var, specials)) { 84 thread.bindSpecial(var, null); 85 binding = thread.getDynamicEnvironment().getBinding(var); 86 ext.declareSpecial(var); 87 } else if (var.isSpecialVariable()) { 88 thread.bindSpecial(var, null); 89 binding = thread.getDynamicEnvironment().getBinding(var); 90 } else { 91 ext.bind(var, null); 92 binding = ext.getBinding(var); 93 } 94 if (limit instanceof Fixnum) { 95 int count = ((Fixnum)limit).value; 96 int i; 97 for (i = 0; i < count; i++) { 98 binding.value = new Fixnum(i); 99 LispObject body = bodyForm; 100 while (body != NIL) { 101 LispObject current = body.car(); 102 if (current instanceof Cons) { 103 try { 104 if (current.car() == Symbol.GO) { 106 LispObject tag = current.cadr(); 107 if (memql(tag, localTags)) { 108 Binding b = ext.getTagBinding(tag); 109 if (b != null && b.value != null) { 110 body = b.value; 111 continue; 112 } 113 } 114 throw new Go(tag); 115 } 116 eval(current, ext, thread); 117 } 118 catch (Go go) { 119 LispObject tag = go.getTag(); 120 if (memql(tag, localTags)) { 121 Binding b = ext.getTagBinding(tag); 122 if (b != null && b.value != null) { 123 body = b.value; 124 thread.setStack(stack); 125 continue; 126 } 127 } 128 throw go; 129 } 130 } 131 body = body.cdr(); 132 } 133 if (interrupted) 134 handleInterrupt(); 135 } 136 binding.value = new Fixnum(i); 137 result = eval(resultForm, ext, thread); 138 } else if (limit instanceof Bignum) { 139 LispObject i = Fixnum.ZERO; 140 while (i.isLessThan(limit)) { 141 binding.value = i; 142 LispObject body = bodyForm; 143 while (body != NIL) { 144 LispObject current = body.car(); 145 if (current instanceof Cons) { 146 try { 147 if (current.car() == Symbol.GO) { 149 LispObject tag = current.cadr(); 150 if (memql(tag, localTags)) { 151 Binding b = ext.getTagBinding(tag); 152 if (b != null && b.value != null) { 153 body = b.value; 154 continue; 155 } 156 } 157 throw new Go(tag); 158 } 159 eval(current, ext, thread); 160 } 161 catch (Go go) { 162 LispObject code = null; 163 LispObject tag = go.getTag(); 164 if (memql(tag, localTags)) { 165 Binding b = ext.getTagBinding(tag); 166 if (b != null && b.value != null) { 167 body = b.value; 168 thread.setStack(stack); 169 continue; 170 } 171 } 172 throw go; 173 } 174 } 175 body = body.cdr(); 176 } 177 i = i.incr(); 178 if (interrupted) 179 handleInterrupt(); 180 } 181 binding.value = i; 182 result = eval(resultForm, ext, thread); 183 } else 184 return signal(new TypeError(limit, Symbol.INTEGER)); 185 return result; 186 } 187 catch (Return ret) { 188 if (ret.getTag() == NIL) { 189 thread.setStack(stack); 190 return ret.getResult(); 191 } 192 throw ret; 193 } 194 finally { 195 thread.setDynamicEnvironment(oldDynEnv); 196 } 197 } 198 199 private static final dotimes DOTIMES = new dotimes(); 200 } 201 | Popular Tags |