|
1
21
22 package org.armedbear.lisp;
23
24 import java.util.ArrayList  ;
25
26 public class Closure extends Function
27 {
28 private static final int REQUIRED = 0;
30 private static final int OPTIONAL = 1;
31 private static final int KEYWORD = 2;
32 private static final int REST = 3;
33 private static final int AUX = 4;
34
35 private static final int STATE_REQUIRED = 0;
37 private static final int STATE_OPTIONAL = 1;
38 private static final int STATE_KEYWORD = 2;
39 private static final int STATE_REST = 3;
40 private static final int STATE_AUX = 4;
41
42 private final LispObject lambdaList;
43 private final Parameter[] requiredParameters;
44 private final Parameter[] optionalParameters;
45 private final Parameter[] keywordParameters;
46 private final Parameter[] auxVars;
47 private final LispObject body;
48 private final Environment environment;
49 private final boolean andKey;
50 private final boolean allowOtherKeys;
51 private Symbol restVar;
52 private Symbol envVar;
53 private int arity;
54
55 private int minArgs;
56 private int maxArgs;
57
58 private final Symbol[] variables;
59 private final Symbol[] specials;
60
61 private boolean bindInitForms;
62
63 public Closure(LispObject lambdaList, LispObject body, Environment env)
64 throws ConditionThrowable
65 {
66 this(null, lambdaList, body, env);
67 }
68
69 public Closure(Symbol symbol, LispObject lambdaList, LispObject body,
70 Environment env)
71 throws ConditionThrowable
72 {
73 super(symbol);
74 this.lambdaList = lambdaList;
75 Debug.assertTrue(lambdaList == NIL || lambdaList instanceof Cons);
76 boolean andKey = false;
77 boolean allowOtherKeys = false;
78 if (lambdaList instanceof Cons) {
79 final int length = lambdaList.length();
80 ArrayList required = null;
81 ArrayList optional = null;
82 ArrayList keywords = null;
83 ArrayList aux = null;
84 int state = STATE_REQUIRED;
85 LispObject remaining = lambdaList;
86 while (remaining != NIL) {
87 LispObject obj = remaining.car();
88 if (obj instanceof Symbol) {
89 if (state == STATE_AUX) {
90 if (aux == null)
91 aux = new ArrayList ();
92 aux.add(new Parameter((Symbol)obj, NIL, AUX));
93 } else if (obj == Symbol.AND_OPTIONAL) {
94 state = STATE_OPTIONAL;
95 arity = -1;
96 } else if (obj == Symbol.AND_REST || obj == Symbol.AND_BODY) {
97 state = STATE_REST;
98 arity = -1;
99 maxArgs = -1;
100 remaining = remaining.cdr();
101 if (remaining == NIL) {
102 signal(new LispError(
103 "&REST/&BODY must be followed by a variable."));
104 }
105 Debug.assertTrue(restVar == null);
106 try {
107 restVar = (Symbol) remaining.car();
108 }
109 catch (ClassCastException e) {
110 signal(new LispError(
111 "&REST/&BODY must be followed by a variable."));
112 }
113 } else if (obj == Symbol.AND_ENVIRONMENT) {
114 remaining = remaining.cdr();
115 envVar = (Symbol) remaining.car();
116 arity = -1; } else if (obj == Symbol.AND_KEY) {
118 state = STATE_KEYWORD;
119 andKey = true;
120 arity = -1;
121 } else if (obj == Symbol.AND_ALLOW_OTHER_KEYS) {
122 allowOtherKeys = true;
123 maxArgs = -1;
124 } else if (obj == Symbol.AND_AUX) {
125 state = STATE_AUX;
127 arity = -1; } else {
129 if (state == STATE_OPTIONAL) {
130 if (optional == null)
131 optional = new ArrayList ();
132 optional.add(new Parameter((Symbol)obj, NIL, OPTIONAL));
133 if (maxArgs >= 0)
134 ++maxArgs;
135 } else if (state == STATE_KEYWORD) {
136 if (keywords == null)
137 keywords = new ArrayList ();
138 keywords.add(new Parameter((Symbol)obj, NIL, KEYWORD));
139 if (maxArgs >= 0)
140 maxArgs += 2;
141 } else {
142 Debug.assertTrue(state == STATE_REQUIRED);
143 if (required == null)
144 required = new ArrayList ();
145 required.add(new Parameter((Symbol)obj));
146 if (maxArgs >= 0)
147 ++maxArgs;
148 }
149 }
150 } else if (obj instanceof Cons) {
151 if (state == STATE_AUX) {
152 Symbol sym = checkSymbol(obj.car());
153 LispObject initForm = obj.cadr();
154 Debug.assertTrue(initForm != null);
155 if (aux == null)
156 aux = new ArrayList ();
157 aux.add(new Parameter(sym, initForm, AUX));
158 } else if (state == STATE_OPTIONAL) {
159 Symbol sym = checkSymbol(obj.car());
160 LispObject initForm = obj.cadr();
161 LispObject svar = obj.cdr().cdr().car();
162 if (optional == null)
163 optional = new ArrayList ();
164 optional.add(new Parameter(sym, initForm, svar, OPTIONAL));
165 if (maxArgs >= 0)
166 ++maxArgs;
167 } else if (state == STATE_KEYWORD) {
168 Symbol keyword;
169 Symbol var;
170 LispObject initForm = NIL;
171 LispObject svar = NIL;
172 LispObject first = obj.car();
173 if (first instanceof Cons) {
174 keyword = checkSymbol(first.car());
175 var = checkSymbol(first.cadr());
176 } else {
177 var = checkSymbol(first);
178 keyword =
179 PACKAGE_KEYWORD.intern(var.getName());
180 }
181 obj = obj.cdr();
182 if (obj != NIL) {
183 initForm = obj.car();
184 obj = obj.cdr();
185 if (obj != NIL)
186 svar = obj.car();
187 }
188 if (keywords == null)
189 keywords = new ArrayList ();
190 keywords.add(new Parameter(keyword, var, initForm, svar));
191 if (maxArgs >= 0)
192 maxArgs += 2;
193 } else
194 invalidParameter(obj);
195 } else
196 invalidParameter(obj);
197 remaining = remaining.cdr();
198 }
199 if (arity == 0)
200 arity = length;
201 if (required != null) {
202 requiredParameters = new Parameter[required.size()];
203 required.toArray(requiredParameters);
204 } else
205 requiredParameters = null;
206 if (optional != null) {
207 optionalParameters = new Parameter[optional.size()];
208 optional.toArray(optionalParameters);
209 } else
210 optionalParameters = null;
211 if (keywords != null) {
212 keywordParameters = new Parameter[keywords.size()];
213 keywords.toArray(keywordParameters);
214 } else
215 keywordParameters = null;
216 if (aux != null) {
217 auxVars = new Parameter[aux.size()];
218 aux.toArray(auxVars);
219 } else
220 auxVars = null;
221 } else {
222 Debug.assertTrue(lambdaList == NIL);
224 requiredParameters = null;
225 optionalParameters = null;
226 keywordParameters = null;
227 auxVars = null;
228 arity = 0;
229 minArgs = maxArgs = 0;
230 }
231 this.body = body;
232 this.environment = env;
233 this.andKey = andKey;
234 this.allowOtherKeys = allowOtherKeys;
235 minArgs = requiredParameters != null ? requiredParameters.length : 0;
236 if (arity >= 0)
237 Debug.assertTrue(arity == minArgs);
238 variables = processVariables();
239 specials = processDeclarations();
240 }
241
242 private final Symbol[] processVariables()
244 {
245 ArrayList vars = new ArrayList ();
246 if (requiredParameters != null) {
247 for (int i = 0; i < requiredParameters.length; i++)
248 vars.add(requiredParameters[i].var);
249 }
250 if (optionalParameters != null) {
251 for (int i = 0; i < optionalParameters.length; i++) {
252 vars.add(optionalParameters[i].var);
253 if (optionalParameters[i].svar != NIL)
254 vars.add(optionalParameters[i].svar);
255 if (!bindInitForms)
256 if (!optionalParameters[i].initForm.constantp())
257 bindInitForms = true;
258 }
259 }
260 if (restVar != null) {
261 vars.add(restVar);
262 }
263 if (keywordParameters != null) {
264 for (int i = 0; i < keywordParameters.length; i++) {
265 vars.add(keywordParameters[i].var);
266 if (keywordParameters[i].svar != NIL)
267 vars.add(keywordParameters[i].svar);
268 if (!bindInitForms)
269 if (!keywordParameters[i].initForm.constantp())
270 bindInitForms = true;
271 }
272 }
273 Symbol[] array = new Symbol[vars.size()];
274 vars.toArray(array);
275 return array;
276 }
277
278 private final Symbol[] processDeclarations() throws ConditionThrowable
279 {
280 ArrayList specials = null;
281 LispObject forms = body;
282 while (forms != NIL) {
283 LispObject obj = forms.car();
284 if (obj instanceof Cons && obj.car() == Symbol.DECLARE) {
285 LispObject decls = obj.cdr();
286 while (decls != NIL) {
287 LispObject decl = decls.car();
288 if (decl instanceof Cons && decl.car() == Symbol.SPECIAL) {
289 LispObject vars = decl.cdr();
290 while (vars != NIL) {
291 Symbol var = checkSymbol(vars.car());
292 if (specials == null)
293 specials = new ArrayList ();
294 specials.add(var);
295 vars = vars.cdr();
296 }
297 }
298 decls = decls.cdr();
299 }
300 forms = forms.cdr();
301 } else
302 break;
303 }
304 if (specials == null)
305 return null;
306 Symbol[] array = new Symbol[specials.size()];
307 specials.toArray(array);
308 return array;
309 }
310
311 private static final void invalidParameter(LispObject obj)
312 throws ConditionThrowable
313 {
314 signal(new LispError(obj.writeToString() +
315 " may not be used as a variable in a lambda list."));
316 }
317
318 public LispObject typep(LispObject typeSpecifier) throws ConditionThrowable
319 {
320 if (typeSpecifier == Symbol.COMPILED_FUNCTION)
321 return NIL;
322 return super.typep(typeSpecifier);
323 }
324
325 public final LispObject getParameterList()
326 {
327 return lambdaList;
328 }
329
330 public final LispObject getVariableList()
331 {
332 LispObject result = NIL;
333 if (variables != null) {
334 for (int i = variables.length; i-- > 0;)
335 result = new Cons(variables[i], result);
336 }
337 return result;
338 }
339
340 public final LispObject getBody()
342 {
343 return body;
344 }
345
346 public final Environment getEnvironment()
347 {
348 return environment;
349 }
350
351 public LispObject execute() throws ConditionThrowable
352 {
353 if (arity == 0) {
354 final LispThread thread = LispThread.currentThread();
355 LispObject result = NIL;
356 LispObject prog = body;
357 while (prog != NIL) {
358 result = eval(prog.car(), environment, thread);
359 prog = prog.cdr();
360 }
361 return result;
362 } else
363 return execute(new LispObject[0]);
364 }
365
366 public LispObject execute(LispObject arg) throws ConditionThrowable
367 {
368 if (minArgs == 1) {
369 final LispThread thread = LispThread.currentThread();
370 Environment oldDynEnv = thread.getDynamicEnvironment();
371 Environment ext = new Environment(environment);
372 if (specials != null) {
373 for (int i = 0; i < specials.length; i++)
374 ext.declareSpecial(specials[i]);
375 }
376 bind(requiredParameters[0].var, arg, ext);
377 if (arity != 1) {
378 if (optionalParameters != null)
379 bindOptionalParameterDefaults(ext, thread);
380 if (restVar != null)
381 bind(restVar, NIL, ext);
382 if (keywordParameters != null)
383 bindKeywordParameterDefaults(ext, thread);
384 }
385 if (auxVars != null)
386 bindAuxVars(ext, thread);
387 LispObject result = NIL;
388 LispObject prog = body;
389 try {
390 while (prog != NIL) {
391 result = eval(prog.car(), ext, thread);
392 prog = prog.cdr();
393 }
394 }
395 finally {
396 thread.setDynamicEnvironment(oldDynEnv);
397 }
398 return result;
399 } else {
400 LispObject[] args = new LispObject[1];
401 args[0] = arg;
402 return execute(args);
403 }
404 }
405
406 public LispObject execute(LispObject first, LispObject second)
407 throws ConditionThrowable
408 {
409 if (minArgs == 2) {
410 final LispThread thread = LispThread.currentThread();
411 Environment oldDynEnv = thread.getDynamicEnvironment();
412 Environment ext = new Environment(environment);
413 if (specials != null) {
414 for (int i = 0; i < specials.length; i++)
415 ext.declareSpecial(specials[i]);
416 }
417 bind(requiredParameters[0].var, first, ext);
418 bind(requiredParameters[1].var, second, ext);
419 if (arity != 2) {
420 if (optionalParameters != null)
421 bindOptionalParameterDefaults(ext, thread);
422 if (restVar != null)
423 bind(restVar, NIL, ext);
424 if (keywordParameters != null)
425 bindKeywordParameterDefaults(ext, thread);
426 }
427 if (auxVars != null)
428 bindAuxVars(ext, thread);
429 LispObject result = NIL;
430 LispObject prog = body;
431 try {
432 while (prog != NIL) {
433 result = eval(prog.car(), ext, thread);
434 prog = prog.cdr();
435 }
436 }
437 finally {
438 thread.setDynamicEnvironment(oldDynEnv);
439 }
440 return result;
441 } else {
442 LispObject[] args = new LispObject[2];
443 args[0] = first;
444 args[1] = second;
445 return execute(args);
446 }
447 }
448
449 public LispObject execute(LispObject first, LispObject second,
450 LispObject third)
451 throws ConditionThrowable
452 {
453 if (minArgs == 3) {
454 final LispThread thread = LispThread.currentThread();
455 Environment oldDynEnv = thread.getDynamicEnvironment();
456 Environment ext = new Environment(environment);
457 if (specials != null) {
458 for (int i = 0; i < specials.length; i++)
459 ext.declareSpecial(specials[i]);
460 }
461 bind(requiredParameters[0].var, first, ext);
462 bind(requiredParameters[1].var, second, ext);
463 bind(requiredParameters[2].var, third, ext);
464 if (arity != 3) {
465 if (optionalParameters != null)
466 bindOptionalParameterDefaults(ext, thread);
467 if (restVar != null)
468 bind(restVar, NIL, ext);
469 if (keywordParameters != null)
470 bindKeywordParameterDefaults(ext, thread);
471 }
472 if (auxVars != null)
473 bindAuxVars(ext, thread);
474 LispObject result = NIL;
475 LispObject prog = body;
476 try {
477 while (prog != NIL) {
478 result = eval(prog.car(), ext, thread);
479 prog = prog.cdr();
480 }
481 }
482 finally {
483 thread.setDynamicEnvironment(oldDynEnv);
484 }
485 return result;
486 } else {
487 LispObject[] args = new LispObject[3];
488 args[0] = first;
489 args[1] = second;
490 args[2] = third;
491 return execute(args);
492 }
493 }
494
495 public LispObject execute(LispObject first, LispObject second,
496 LispObject third, LispObject fourth)
497 throws ConditionThrowable
498 {
499 if (minArgs == 4) {
500 final LispThread thread = LispThread.currentThread();
501 Environment oldDynEnv = thread.getDynamicEnvironment();
502 Environment ext = new Environment(environment);
503 if (specials != null) {
504 for (int i = 0; i < specials.length; i++)
505 ext.declareSpecial(specials[i]);
506 }
507 bind(requiredParameters[0].var, first, ext);
508 bind(requiredParameters[1].var, second, ext);
509 bind(requiredParameters[2].var, third, ext);
510 bind(requiredParameters[3].var, fourth, ext);
511 if (arity != 4) {
512 if (optionalParameters != null)
513 bindOptionalParameterDefaults(ext, thread);
514 if (restVar != null)
515 bind(restVar, NIL, ext);
516 if (keywordParameters != null)
517 bindKeywordParameterDefaults(ext, thread);
518 }
519 if (auxVars != null)
520 bindAuxVars(ext, thread);
521 LispObject result = NIL;
522 LispObject prog = body;
523 try {
524 while (prog != NIL) {
525 result = eval(prog.car(), ext, thread);
526 prog = prog.cdr();
527 }
528 }
529 finally {
530 thread.setDynamicEnvironment(oldDynEnv);
531 }
532 return result;
533 } else {
534 LispObject[] args = new LispObject[4];
535 args[0] = first;
536 args[1] = second;
537 args[2] = third;
538 args[3] = fourth;
539 return execute(args);
540 }
541 }
542
543 public LispObject execute(LispObject[] args) throws ConditionThrowable
544 {
545 final LispThread thread = LispThread.currentThread();
546 Environment oldDynEnv = thread.getDynamicEnvironment();
547 Environment ext = new Environment(environment);
548 if (specials != null) {
549 for (int i = 0; i < specials.length; i++)
550 ext.declareSpecial(specials[i]);
551 }
552 args = processArgs(args, 0);
553 Debug.assertTrue(args.length == variables.length);
554 for (int i = 0; i < variables.length; i++) {
555 Symbol sym = variables[i];
556 if (isSpecial(sym))
557 thread.bindSpecial(sym, args[i]);
558 else
559 ext.bind(sym, args[i]);
560 }
561 if (auxVars != null)
562 bindAuxVars(ext, thread);
563 LispObject result = NIL;
564 LispObject prog = body;
565 try {
566 while (prog != NIL) {
567 result = eval(prog.car(), ext, thread);
568 prog = prog.cdr();
569 }
570 }
571 finally {
572 thread.setDynamicEnvironment(oldDynEnv);
573 }
574 return result;
575 }
576
577 private final boolean isSpecial(Symbol sym)
578 {
579 if (sym.isSpecialVariable())
580 return true;
581 if (specials != null) {
582 for (int i = specials.length; i-- > 0;) {
583 if (sym == specials[i])
584 return true;
585 }
586 }
587 return false;
588 }
589
590 protected final LispObject[] processArgs(LispObject[] args, int extra)
591 throws ConditionThrowable
592 {
593 final int argsLength = args.length;
594 if (arity >= 0) {
595 if (argsLength != arity)
597 signal(new WrongNumberOfArgumentsException(this));
598 if (extra == 0)
599 return args;
600 }
601 if (argsLength < minArgs)
603 signal(new WrongNumberOfArgumentsException(this));
604 final LispThread thread = LispThread.currentThread();
605 final LispObject[] array = new LispObject[variables.length + extra];
606 int index = 0;
607 Environment oldDynEnv = thread.getDynamicEnvironment();
611 Environment ext = new Environment(environment);
612 if (bindInitForms)
615 if (envVar != null)
616 bind(envVar, environment, ext);
617 if (requiredParameters != null) {
619 for (int i = 0; i < minArgs; i++) {
620 if (bindInitForms)
621 bind(requiredParameters[i].var, args[i], ext);
622 array[index++] = args[i];
623 }
624 }
625 int i = minArgs;
626 int argsUsed = minArgs;
627 if (optionalParameters != null) {
629 for (int j = 0; j < optionalParameters.length; j++) {
630 Parameter parameter = optionalParameters[j];
631 if (i < argsLength) {
632 if (bindInitForms)
633 bind(parameter.var, args[i], ext);
634 array[index++] = args[i];
635 ++argsUsed;
636 if (parameter.svar != NIL) {
637 if (bindInitForms)
638 bind((Symbol)parameter.svar, T, ext);
639 array[index++] = T;
640 }
641 } else {
642 LispObject value;
644 if (parameter.initVal != null)
645 value = parameter.initVal;
646 else
647 value = eval(parameter.initForm, ext, thread);
648 if (bindInitForms)
649 bind(parameter.var, value, ext);
650 array[index++] = value;
651 if (parameter.svar != NIL) {
652 if (bindInitForms)
653 bind((Symbol)parameter.svar, NIL, ext);
654 array[index++] = NIL;
655 }
656 }
657 ++i;
658 }
659 }
660 if (restVar != null) {
662 LispObject rest = NIL;
663 for (int j = argsLength; j-- > argsUsed;)
664 rest = new Cons(args[j], rest);
665 if (bindInitForms)
666 bind(restVar, rest, ext);
667 array[index++] = rest;
668 }
669 if (keywordParameters != null) {
671 int argsLeft = argsLength - argsUsed;
672 if (argsLeft == 0) {
673 for (int k = 0; k < keywordParameters.length; k++) {
676 Parameter parameter = keywordParameters[k];
677 LispObject initForm = parameter.initForm;
678 LispObject value;
679 if (parameter.initVal != null)
680 value = parameter.initVal;
681 else
682 value = eval(parameter.initForm, ext, thread);
683 if (bindInitForms)
684 bind(parameter.var, value, ext);
685 array[index++] = value;
686 if (parameter.svar != NIL) {
687 if (bindInitForms)
688 bind((Symbol)parameter.svar, NIL, ext);
689 array[index++] = NIL;
690 }
691 }
692 } else {
693 if ((argsLeft % 2) != 0)
694 signal(new ProgramError("Odd number of keyword arguments."));
695 LispObject allowOtherKeysValue = null;
696 for (int k = 0; k < keywordParameters.length; k++) {
697 Parameter parameter = keywordParameters[k];
698 Symbol keyword = parameter.keyword;
699 LispObject value = null;
700 boolean unbound = true;
701 for (int j = argsUsed; j < argsLength; j += 2) {
702 if (args[j] == keyword) {
703 if (bindInitForms)
704 bind(parameter.var, args[j+1], ext);
705 value = array[index++] = args[j+1];
706 if (parameter.svar != NIL) {
707 if (bindInitForms)
708 bind((Symbol)parameter.svar, T, ext);
709 array[index++] = T;
710 }
711 args[j] = null;
712 args[j+1] = null;
713 unbound = false;
714 break;
715 }
716 }
717 if (unbound) {
718 if (parameter.initVal != null)
719 value = parameter.initVal;
720 else
721 value = eval(parameter.initForm, ext, thread);
722 if (bindInitForms)
723 bind(parameter.var, value, ext);
724 array[index++] = value;
725 if (parameter.svar != NIL) {
726 if (bindInitForms)
727 bind((Symbol)parameter.svar, NIL, ext);
728 array[index++] = NIL;
729 }
730 }
731 if (keyword == Keyword.ALLOW_OTHER_KEYS) {
732 if (allowOtherKeysValue == null)
733 allowOtherKeysValue = value;
734 }
735 }
736 if (!allowOtherKeys) {
737 if (allowOtherKeysValue == null || allowOtherKeysValue == NIL) {
738 LispObject unrecognizedKeyword = null;
739 for (int j = argsUsed; j < argsLength; j += 2) {
740 LispObject keyword = args[j];
741 if (keyword == null)
742 continue;
743 if (keyword == Keyword.ALLOW_OTHER_KEYS) {
744 if (allowOtherKeysValue == null) {
745 allowOtherKeysValue = args[j+1];
746 if (allowOtherKeysValue != NIL)
747 break;
748 }
749 continue;
750 }
751 boolean ok = false;
753 for (int k = keywordParameters.length; k-- > 0;) {
754 if (keywordParameters[k].keyword == keyword) {
755 ok = true;
757 break;
758 }
759 }
760 if (ok)
761 continue;
762 if (unrecognizedKeyword == null)
764 unrecognizedKeyword = keyword;
765 }
766 if (unrecognizedKeyword != null) {
767 if (!allowOtherKeys &&
768 (allowOtherKeysValue == null || allowOtherKeysValue == NIL))
769 signal(new ProgramError("Unrecognized keyword argument " +
770 unrecognizedKeyword.writeToString() +
771 "."));
772 }
773 }
774 }
775 }
776 } else if (argsUsed < argsLength) {
777 if (argsUsed + 2 <= argsLength) {
779 LispObject allowOtherKeysValue = NIL;
781 int n = argsUsed;
782 while (n < argsLength) {
783 LispObject keyword = args[n];
784 if (keyword == Keyword.ALLOW_OTHER_KEYS) {
785 allowOtherKeysValue = args[n+1];
786 break;
787 }
788 n += 2;
789 }
790 if (allowOtherKeys || allowOtherKeysValue != NIL) {
791 while (argsUsed + 2 <= argsLength)
793 argsUsed += 2;
794 } else if (andKey) {
795 LispObject keyword = args[argsUsed];
796 if (keyword == Keyword.ALLOW_OTHER_KEYS) {
797 argsUsed += 2;
802 }
803 }
804 }
805 if (argsUsed < argsLength) {
806 if (restVar == null)
807 signal(new WrongNumberOfArgumentsException(this));
808 }
809 }
810 thread.setDynamicEnvironment(oldDynEnv);
811 return array;
812 }
813
814 private final void bindOptionalParameterDefaults(Environment env,
815 LispThread thread)
816 throws ConditionThrowable
817 {
818 for (int i = 0; i < optionalParameters.length; i++) {
819 Parameter parameter = optionalParameters[i];
820 LispObject value;
821 if (parameter.initVal != null)
822 value = parameter.initVal;
823 else
824 value = eval(parameter.initForm, env, thread);
825 bind(parameter.var, value, env);
826 if (parameter.svar != NIL)
827 bind((Symbol)parameter.svar, NIL, env);
828 }
829 }
830
831 private final void bindKeywordParameterDefaults(Environment env,
832 LispThread thread)
833 throws ConditionThrowable
834 {
835 for (int i = 0; i < keywordParameters.length; i++) {
836 Parameter parameter = keywordParameters[i];
837 LispObject value;
838 if (parameter.initVal != null)
839 value = parameter.initVal;
840 else
841 value = eval(parameter.initForm, env, thread);
842 bind(parameter.var, value, env);
843 if (parameter.svar != NIL)
844 bind((Symbol)parameter.svar, NIL, env);
845 }
846 }
847
848 private final void bindAuxVars(Environment env, LispThread thread)
849 throws ConditionThrowable
850 {
851 for (int i = 0; i < auxVars.length; i++) {
853 Parameter parameter = auxVars[i];
854 Symbol sym = parameter.var;
855 LispObject value;
856 if (parameter.initVal != null)
857 value = parameter.initVal;
858 else
859 value = eval(parameter.initForm, env, thread);
860 bind(sym, value, env);
861 }
862 }
863
864 private static final Primitive1 CLOSURE_ENVIRONMENT =
866 new Primitive1("closure-environment", PACKAGE_SYS, false, "closure")
867 {
868 public LispObject execute(LispObject arg) throws ConditionThrowable
869 {
870 if (arg instanceof Closure) {
871 Closure closure = (Closure) arg;
872 if (closure.environment != null)
873 return closure.environment;
874 return NIL;
875 }
876 return signal(new TypeError(arg, "closure"));
877 }
878 };
879
880 private static class Parameter
881 {
882 private final Symbol var;
883 private final LispObject initForm;
884 private final LispObject initVal;
885 private final LispObject svar;
886 private final int type;
887 private final Symbol keyword;
888
889 public Parameter(Symbol var)
890 {
891 this.var = var;
892 this.initForm = null;
893 this.initVal = null;
894 this.svar = NIL;
895 this.type = REQUIRED;
896 this.keyword = null;
897 }
898
899 public Parameter(Symbol var, LispObject initForm, int type)
900 throws ConditionThrowable
901 {
902 this.var = var;
903 this.initForm = initForm;
904 this.initVal = processInitForm(initForm);
905 this.svar = NIL;
906 this.type = type;
907 keyword =
908 type == KEYWORD ? PACKAGE_KEYWORD.intern(var.getName()) : null;
909 }
910
911 public Parameter(Symbol var, LispObject initForm, LispObject svar,
912 int type)
913 throws ConditionThrowable
914 {
915 this.var = var;
916 this.initForm = initForm;
917 this.initVal = processInitForm(initForm);
918 this.svar = (svar != NIL) ? checkSymbol(svar) : NIL;
919 this.type = type;
920 keyword =
921 type == KEYWORD ? PACKAGE_KEYWORD.intern(var.getName()) : null;
922 }
923
924 public Parameter(Symbol keyword, Symbol var, LispObject initForm,
925 LispObject svar)
926 throws ConditionThrowable
927 {
928 this.var = var;
929 this.initForm = initForm;
930 this.initVal = processInitForm(initForm);
931 this.svar = (svar != NIL) ? checkSymbol(svar) : NIL;
932 type = KEYWORD;
933 this.keyword = keyword;
934 }
935
936 public String toString()
937 {
938 if (type == REQUIRED)
939 return var.toString();
940 StringBuffer sb = new StringBuffer ();
941 if (keyword != null) {
942 sb.append(keyword);
943 sb.append(' ');
944 }
945 sb.append(var.toString());
946 sb.append(' ');
947 sb.append(initForm);
948 sb.append(' ');
949 sb.append(type);
950 return sb.toString();
951 }
952
953 private static final LispObject processInitForm(LispObject initForm)
954 throws ConditionThrowable
955 {
956 if (initForm.constantp()) {
957 if (initForm instanceof Symbol)
958 return initForm.getSymbolValue();
959 if (initForm instanceof Cons) {
960 Debug.assertTrue(initForm.car() == Symbol.QUOTE);
961 return initForm.cadr();
962 }
963 return initForm;
964 }
965 return null;
966 }
967 }
968 }
969 |
Popular Tags |
Java API By Example, From Geeks To Geeks.