Changeset 11772
- Timestamp:
- 04/20/09 20:21:37 (15 years ago)
- Location:
- trunk/abcl/src/org/armedbear/lisp
- Files:
-
- 8 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/abcl/src/org/armedbear/lisp/Closure.java
r11771 r11772 63 63 private Parameter[] auxVars = emptyParameterArray; 64 64 private final LispObject body; 65 private final LispObject executionBody; 65 66 private final Environment environment; 66 67 private final boolean andKey; … … 79 80 } 80 81 private Symbol[] variables = emptySymbolArray; 81 private Symbol[] specials = emptySymbolArray;82 private LispObject specials = NIL; 82 83 83 84 private boolean bindInitForms; … … 293 294 } 294 295 this.body = lambdaExpression.cddr(); 296 LispObject bodyAndDecls = parseBody(this.body, false); 297 this.executionBody = bodyAndDecls.car(); 298 this.specials = parseSpecials(bodyAndDecls.NTH(1)); 299 295 300 this.environment = env; 296 301 this.andKey = _andKey; … … 300 305 Debug.assertTrue(arity == minArgs); 301 306 variables = processVariables(); 302 specials = processDeclarations();303 307 } 304 308 … … 334 338 } 335 339 336 private final Symbol[] processDeclarations() throws ConditionThrowable337 {338 ArrayList<Symbol> arrayList = null;339 LispObject forms = body;340 while (forms != NIL)341 {342 LispObject obj = forms.car();343 if (obj instanceof Cons && obj.car() == Symbol.DECLARE)344 {345 LispObject decls = obj.cdr();346 while (decls != NIL)347 {348 LispObject decl = decls.car();349 if (decl instanceof Cons && decl.car() == Symbol.SPECIAL)350 {351 LispObject vars = decl.cdr();352 while (vars != NIL)353 {354 Symbol var = checkSymbol(vars.car());355 if (arrayList == null)356 arrayList = new ArrayList<Symbol>();357 arrayList.add(var);358 vars = vars.cdr();359 }360 }361 decls = decls.cdr();362 }363 forms = forms.cdr();364 }365 else366 break;367 }368 if (arrayList == null)369 return emptySymbolArray;370 Symbol[] array = new Symbol[arrayList.size()];371 arrayList.toArray(array);372 return array;373 }374 375 340 private static final void invalidParameter(LispObject obj) 376 341 throws ConditionThrowable … … 412 377 if (arity == 0) 413 378 { 414 return progn( body, environment,379 return progn(executionBody, environment, 415 380 LispThread.currentThread()); 416 381 } … … 436 401 try 437 402 { 438 return progn( body, ext, thread);403 return progn(executionBody, ext, thread); 439 404 } 440 405 finally … … 615 580 } 616 581 bindAuxVars(ext, thread); 582 LispObject s = specials; 617 583 special: 618 for (Symbol special : specials) { 584 while (s != NIL) { 585 Symbol special = (Symbol)s.car(); 586 s = s.cdr(); 619 587 for (Symbol var : variables) 620 588 if (special == var) … … 627 595 try 628 596 { 629 return progn( body, ext, thread);597 return progn(executionBody, ext, thread); 630 598 } 631 599 finally -
trunk/abcl/src/org/armedbear/lisp/Do.java
r11488 r11772 97 97 final SpecialBinding lastSpecialBinding = thread.lastSpecialBinding; 98 98 // Process declarations. 99 LispObject specials = NIL; 100 while (body != NIL) 101 { 102 LispObject obj = body.car(); 103 if (obj instanceof Cons && obj.car() == Symbol.DECLARE) 104 { 105 LispObject decls = obj.cdr(); 106 while (decls != NIL) 107 { 108 LispObject decl = decls.car(); 109 if (decl instanceof Cons && decl.car() == Symbol.SPECIAL) 110 { 111 LispObject names = decl.cdr(); 112 while (names != NIL) 113 { 114 specials = new Cons(names.car(), specials); 115 names = names.cdr(); 116 } 117 } 118 decls = decls.cdr(); 119 } 120 body = body.cdr(); 121 } 122 else 123 break; 124 } 99 100 final LispObject bodyAndDecls = parseBody(body, false); 101 LispObject specials = parseSpecials(bodyAndDecls.NTH(1)); 102 body = bodyAndDecls.car(); 103 125 104 final Environment ext = new Environment(env); 126 105 for (int i = 0; i < numvars; i++) -
trunk/abcl/src/org/armedbear/lisp/Environment.java
r11770 r11772 204 204 throws ConditionThrowable 205 205 { 206 while (body != NIL) 207 { 208 LispObject obj = body.car(); 209 if (obj instanceof Cons && ((Cons)obj).car == Symbol.DECLARE) 210 { 211 LispObject decls = ((Cons)obj).cdr; 212 while (decls != NIL) 213 { 214 LispObject decl = decls.car(); 215 if (decl instanceof Cons && ((Cons)decl).car == Symbol.SPECIAL) 216 { 217 LispObject names = ((Cons)decl).cdr; 218 while (names != NIL) 219 { 220 Symbol var = checkSymbol(names.car()); 221 declareSpecial(var); 222 names = ((Cons)names).cdr; 223 } 224 } 225 decls = ((Cons)decls).cdr; 226 } 227 body = ((Cons)body).cdr; 228 } 229 else 230 break; 231 } 232 return body; 206 LispObject bodyAndDecls = parseBody(body, false); 207 LispObject specials = parseSpecials(bodyAndDecls.NTH(1)); 208 for (; specials != NIL; specials = specials.cdr()) 209 declareSpecial(checkSymbol(specials.car())); 210 211 return bodyAndDecls.car(); 233 212 } 234 213 -
trunk/abcl/src/org/armedbear/lisp/Lisp.java
r11760 r11772 547 547 } 548 548 549 public static final LispObject parseBody(LispObject body, 550 boolean documentationAllowed) 551 throws ConditionThrowable 552 { 553 LispObject decls = NIL; 554 LispObject doc = NIL; 555 556 while (body != NIL) { 557 LispObject form = body.car(); 558 if (documentationAllowed && form instanceof AbstractString 559 && body.cdr() != NIL) { 560 doc = body.car(); 561 documentationAllowed = false; 562 } else if (form instanceof Cons && form.car() == Symbol.DECLARE) 563 decls = new Cons(form, decls); 564 else 565 break; 566 567 body = body.cdr(); 568 } 569 return list(body, decls.nreverse(), doc); 570 } 571 572 public static final LispObject parseSpecials(LispObject forms) 573 throws ConditionThrowable 574 { 575 LispObject specials = NIL; 576 while (forms != NIL) { 577 LispObject decls = forms.car(); 578 579 Debug.assertTrue(decls instanceof Cons); 580 Debug.assertTrue(decls.car() == Symbol.DECLARE); 581 decls = decls.cdr(); 582 while (decls != NIL) { 583 LispObject decl = decls.car(); 584 585 if (decl instanceof Cons && decl.car() == Symbol.SPECIAL) { 586 decl = decl.cdr(); 587 while (decl != NIL) { 588 specials = new Cons(checkSymbol(decl.car()), specials); 589 decl = decl.cdr(); 590 } 591 } 592 593 decls = decls.cdr(); 594 } 595 596 forms = forms.cdr(); 597 } 598 599 return specials; 600 } 601 549 602 public static final LispObject progn(LispObject body, Environment env, 550 603 LispThread thread) … … 561 614 562 615 // Environment wrappers. 563 private static final boolean isSpecial(Symbol sym, Symbol[]ownSpecials,616 private static final boolean isSpecial(Symbol sym, LispObject ownSpecials, 564 617 Environment env) 618 throws ConditionThrowable 565 619 { 566 620 if (ownSpecials != null) … … 568 622 if (sym.isSpecialVariable()) 569 623 return true; 570 for ( Symbol special : ownSpecials)571 { 572 if (sym == special)624 for (; ownSpecials != NIL; ownSpecials = ownSpecials.cdr()) 625 { 626 if (sym == ownSpecials.car()) 573 627 return true; 574 628 } … … 576 630 return false; 577 631 } 578 protected static final void bindArg(Symbol[] ownSpecials, 632 633 protected static final void bindArg(LispObject ownSpecials, 579 634 Symbol sym, LispObject value, 580 635 Environment env, LispThread thread) -
trunk/abcl/src/org/armedbear/lisp/Primitives.java
r11754 r11772 3747 3747 } 3748 3748 // Process declarations. 3749 LispObject specials = NIL; 3750 while (body != NIL) 3751 { 3752 LispObject obj = body.car(); 3753 if (obj instanceof Cons && ((Cons)obj).car == Symbol.DECLARE) 3754 { 3755 LispObject decls = ((Cons)obj).cdr; 3756 while (decls != NIL) 3757 { 3758 LispObject decl = decls.car(); 3759 if (decl instanceof Cons && ((Cons)decl).car == Symbol.SPECIAL) 3760 { 3761 LispObject declvars = ((Cons)decl).cdr; 3762 while (declvars != NIL) 3763 { 3764 specials = new Cons(declvars.car(), specials); 3765 declvars = ((Cons)declvars).cdr; 3766 } 3767 } 3768 decls = ((Cons)decls).cdr; 3769 } 3770 body = ((Cons)body).cdr; 3771 } 3772 else 3773 break; 3774 } 3749 LispObject bodyAndDecls = parseBody(body, false); 3750 LispObject specials = parseSpecials(bodyAndDecls.NTH(1)); 3751 body = bodyAndDecls.car(); 3752 3775 3753 final SpecialBinding lastSpecialBinding = thread.lastSpecialBinding; 3776 3754 final Environment ext = new Environment(env); -
trunk/abcl/src/org/armedbear/lisp/SpecialOperators.java
r11769 r11772 119 119 { 120 120 LispObject varList = checkList(args.car()); 121 LispObject body = args.cdr(); 122 // Process declarations. 123 ArrayList<Symbol> specials = new ArrayList<Symbol>(); 124 while (body != NIL) 125 { 126 LispObject obj = body.car(); 127 if (obj instanceof Cons && ((Cons)obj).car == Symbol.DECLARE) 128 { 129 LispObject decls = ((Cons)obj).cdr; 130 while (decls != NIL) 131 { 132 LispObject decl = decls.car(); 133 if (decl instanceof Cons && ((Cons)decl).car == Symbol.SPECIAL) 134 { 135 LispObject vars = ((Cons)decl).cdr; 136 while (vars != NIL) 137 { 138 specials.add(0, (Symbol) vars.car()); 139 vars = ((Cons)vars).cdr; 140 } 141 } 142 decls = ((Cons)decls).cdr; 143 } 144 body = ((Cons)body).cdr; 145 } 146 else 147 break; 148 } 121 LispObject bodyAndDecls = parseBody(args.cdr(), false); 122 LispObject specials = parseSpecials(bodyAndDecls.NTH(1)); 123 LispObject body = bodyAndDecls.car(); 124 149 125 Environment ext = new Environment(env); 150 126 LinkedList<Cons> nonSequentialVars = new LinkedList<Cons>(); 151 Symbol[] arrayToUseForSpecials = new Symbol[0];152 127 while (varList != NIL) 153 128 { … … 170 145 } 171 146 if (sequential) 172 bindArg(specials.toArray(arrayToUseForSpecials), 173 symbol, value, ext, thread); 147 bindArg(specials, symbol, value, ext, thread); 174 148 else 175 149 nonSequentialVars.add(new Cons(symbol, value)); … … 177 151 } 178 152 if (!sequential) 179 { 180 for (Cons x : nonSequentialVars) 181 { 182 bindArg(specials.toArray(arrayToUseForSpecials), 183 (Symbol)x.car(), x.cdr(), ext, thread); 184 } 185 } 153 for (Cons x : nonSequentialVars) 154 bindArg(specials, (Symbol)x.car(), x.cdr(), ext, thread); 155 186 156 // Make sure free special declarations are visible in the body. 187 157 // "The scope of free declarations specifically does not include 188 158 // initialization forms for bindings established by the form 189 159 // containing the declarations." (3.3.4) 190 for (Symbol symbol : specials) 191 { 192 ext.declareSpecial(symbol); 193 } 160 for (; specials != NIL; specials = specials.cdr()) 161 ext.declareSpecial((Symbol)specials.car()); 162 194 163 return progn(body, ext, thread); 195 164 } -
trunk/abcl/src/org/armedbear/lisp/dolist.java
r11488 r11772 55 55 final LispObject stack = thread.getStack(); 56 56 // Process declarations. 57 LispObject specials = NIL; 58 while (bodyForm != NIL) 59 { 60 LispObject obj = bodyForm.car(); 61 if (obj instanceof Cons && obj.car() == Symbol.DECLARE) 62 { 63 LispObject decls = obj.cdr(); 64 while (decls != NIL) 65 { 66 LispObject decl = decls.car(); 67 if (decl instanceof Cons && decl.car() == Symbol.SPECIAL) 68 { 69 LispObject vars = decl.cdr(); 70 while (vars != NIL) 71 { 72 specials = new Cons(vars.car(), specials); 73 vars = vars.cdr(); 74 } 75 } 76 decls = decls.cdr(); 77 } 78 bodyForm = bodyForm.cdr(); 79 } 80 else 81 break; 82 } 57 LispObject bodyAndDecls = parseBody(bodyForm, false); 58 LispObject specials = parseSpecials(bodyAndDecls.NTH(1)); 59 bodyForm = bodyAndDecls.car(); 60 83 61 try 84 62 { -
trunk/abcl/src/org/armedbear/lisp/dotimes.java
r11714 r11772 53 53 SpecialBinding lastSpecialBinding = thread.lastSpecialBinding; 54 54 final LispObject stack = thread.getStack(); 55 // Process declarations. 56 LispObject specials = NIL; 57 while (bodyForm != NIL) 58 { 59 LispObject obj = bodyForm.car(); 60 if (obj instanceof Cons && obj.car() == Symbol.DECLARE) 61 { 62 LispObject decls = obj.cdr(); 63 while (decls != NIL) 64 { 65 LispObject decl = decls.car(); 66 if (decl instanceof Cons && decl.car() == Symbol.SPECIAL) 67 { 68 LispObject vars = decl.cdr(); 69 while (vars != NIL) 70 { 71 specials = new Cons(vars.car(), specials); 72 vars = vars.cdr(); 73 } 74 } 75 decls = decls.cdr(); 76 } 77 bodyForm = bodyForm.cdr(); 78 } 79 else 80 break; 81 } 55 56 LispObject bodyAndDecls = parseBody(bodyForm, false); 57 LispObject specials = parseSpecials(bodyAndDecls.NTH(1)); 58 bodyForm = bodyAndDecls.car(); 59 82 60 try 83 61 {
Note: See TracChangeset
for help on using the changeset viewer.