1 21 22 package org.armedbear.lisp; 23 24 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 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 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 } 77 ext.addBlock(NIL, new LispObject()); 79 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 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 |