001: /*
002: * Closure.java
003: *
004: * Copyright (C) 2002-2004 Peter Graves
005: * $Id: Closure.java,v 1.83 2004/08/15 20:02:14 piso Exp $
006: *
007: * This program is free software; you can redistribute it and/or
008: * modify it under the terms of the GNU General Public License
009: * as published by the Free Software Foundation; either version 2
010: * of the License, or (at your option) any later version.
011: *
012: * This program is distributed in the hope that it will be useful,
013: * but WITHOUT ANY WARRANTY; without even the implied warranty of
014: * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
015: * GNU General Public License for more details.
016: *
017: * You should have received a copy of the GNU General Public License
018: * along with this program; if not, write to the Free Software
019: * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
020: */
021:
022: package org.armedbear.lisp;
023:
024: import java.util.ArrayList;
025:
026: public class Closure extends Function {
027: // Parameter types.
028: private static final int REQUIRED = 0;
029: private static final int OPTIONAL = 1;
030: private static final int KEYWORD = 2;
031: private static final int REST = 3;
032: private static final int AUX = 4;
033:
034: // States.
035: private static final int STATE_REQUIRED = 0;
036: private static final int STATE_OPTIONAL = 1;
037: private static final int STATE_KEYWORD = 2;
038: private static final int STATE_REST = 3;
039: private static final int STATE_AUX = 4;
040:
041: private final LispObject lambdaList;
042: private final Parameter[] requiredParameters;
043: private final Parameter[] optionalParameters;
044: private final Parameter[] keywordParameters;
045: private final Parameter[] auxVars;
046: private final LispObject body;
047: private final Environment environment;
048: private final boolean andKey;
049: private final boolean allowOtherKeys;
050: private Symbol restVar;
051: private Symbol envVar;
052: private int arity;
053:
054: private int minArgs;
055: private int maxArgs;
056:
057: private final Symbol[] variables;
058: private final Symbol[] specials;
059:
060: private boolean bindInitForms;
061:
062: public Closure(LispObject lambdaList, LispObject body,
063: Environment env) throws ConditionThrowable {
064: this (null, lambdaList, body, env);
065: }
066:
067: public Closure(Symbol symbol, LispObject lambdaList,
068: LispObject body, Environment env) throws ConditionThrowable {
069: super (symbol);
070: this .lambdaList = lambdaList;
071: Debug.assertTrue(lambdaList == NIL
072: || lambdaList instanceof Cons);
073: boolean andKey = false;
074: boolean allowOtherKeys = false;
075: if (lambdaList instanceof Cons) {
076: final int length = lambdaList.length();
077: ArrayList required = null;
078: ArrayList optional = null;
079: ArrayList keywords = null;
080: ArrayList aux = null;
081: int state = STATE_REQUIRED;
082: LispObject remaining = lambdaList;
083: while (remaining != NIL) {
084: LispObject obj = remaining.car();
085: if (obj instanceof Symbol) {
086: if (state == STATE_AUX) {
087: if (aux == null)
088: aux = new ArrayList();
089: aux.add(new Parameter((Symbol) obj, NIL, AUX));
090: } else if (obj == Symbol.AND_OPTIONAL) {
091: state = STATE_OPTIONAL;
092: arity = -1;
093: } else if (obj == Symbol.AND_REST
094: || obj == Symbol.AND_BODY) {
095: state = STATE_REST;
096: arity = -1;
097: maxArgs = -1;
098: remaining = remaining.cdr();
099: if (remaining == NIL) {
100: signal(new LispError(
101: "&REST/&BODY must be followed by a variable."));
102: }
103: Debug.assertTrue(restVar == null);
104: try {
105: restVar = (Symbol) remaining.car();
106: } catch (ClassCastException e) {
107: signal(new LispError(
108: "&REST/&BODY must be followed by a variable."));
109: }
110: } else if (obj == Symbol.AND_ENVIRONMENT) {
111: remaining = remaining.cdr();
112: envVar = (Symbol) remaining.car();
113: arity = -1; // FIXME
114: } else if (obj == Symbol.AND_KEY) {
115: state = STATE_KEYWORD;
116: andKey = true;
117: arity = -1;
118: } else if (obj == Symbol.AND_ALLOW_OTHER_KEYS) {
119: allowOtherKeys = true;
120: maxArgs = -1;
121: } else if (obj == Symbol.AND_AUX) {
122: // All remaining specifiers are aux variable specifiers.
123: state = STATE_AUX;
124: arity = -1; // FIXME
125: } else {
126: if (state == STATE_OPTIONAL) {
127: if (optional == null)
128: optional = new ArrayList();
129: optional.add(new Parameter((Symbol) obj,
130: NIL, OPTIONAL));
131: if (maxArgs >= 0)
132: ++maxArgs;
133: } else if (state == STATE_KEYWORD) {
134: if (keywords == null)
135: keywords = new ArrayList();
136: keywords.add(new Parameter((Symbol) obj,
137: NIL, KEYWORD));
138: if (maxArgs >= 0)
139: maxArgs += 2;
140: } else {
141: Debug.assertTrue(state == STATE_REQUIRED);
142: if (required == null)
143: required = new ArrayList();
144: required.add(new Parameter((Symbol) obj));
145: if (maxArgs >= 0)
146: ++maxArgs;
147: }
148: }
149: } else if (obj instanceof Cons) {
150: if (state == STATE_AUX) {
151: Symbol sym = checkSymbol(obj.car());
152: LispObject initForm = obj.cadr();
153: Debug.assertTrue(initForm != null);
154: if (aux == null)
155: aux = new ArrayList();
156: aux.add(new Parameter(sym, initForm, AUX));
157: } else if (state == STATE_OPTIONAL) {
158: Symbol sym = checkSymbol(obj.car());
159: LispObject initForm = obj.cadr();
160: LispObject svar = obj.cdr().cdr().car();
161: if (optional == null)
162: optional = new ArrayList();
163: optional.add(new Parameter(sym, initForm, svar,
164: 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 = PACKAGE_KEYWORD.intern(var
179: .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,
191: initForm, svar));
192: if (maxArgs >= 0)
193: maxArgs += 2;
194: } else
195: invalidParameter(obj);
196: } else
197: invalidParameter(obj);
198: remaining = remaining.cdr();
199: }
200: if (arity == 0)
201: arity = length;
202: if (required != null) {
203: requiredParameters = new Parameter[required.size()];
204: required.toArray(requiredParameters);
205: } else
206: requiredParameters = null;
207: if (optional != null) {
208: optionalParameters = new Parameter[optional.size()];
209: optional.toArray(optionalParameters);
210: } else
211: optionalParameters = null;
212: if (keywords != null) {
213: keywordParameters = new Parameter[keywords.size()];
214: keywords.toArray(keywordParameters);
215: } else
216: keywordParameters = null;
217: if (aux != null) {
218: auxVars = new Parameter[aux.size()];
219: aux.toArray(auxVars);
220: } else
221: auxVars = null;
222: } else {
223: // Lambda list is empty.
224: Debug.assertTrue(lambdaList == NIL);
225: requiredParameters = null;
226: optionalParameters = null;
227: keywordParameters = null;
228: auxVars = null;
229: arity = 0;
230: minArgs = maxArgs = 0;
231: }
232: this .body = body;
233: this .environment = env;
234: this .andKey = andKey;
235: this .allowOtherKeys = allowOtherKeys;
236: minArgs = requiredParameters != null ? requiredParameters.length
237: : 0;
238: if (arity >= 0)
239: Debug.assertTrue(arity == minArgs);
240: variables = processVariables();
241: specials = processDeclarations();
242: }
243:
244: // Also sets bindInitForms.
245: private final Symbol[] processVariables() {
246: ArrayList vars = new ArrayList();
247: if (requiredParameters != null) {
248: for (int i = 0; i < requiredParameters.length; i++)
249: vars.add(requiredParameters[i].var);
250: }
251: if (optionalParameters != null) {
252: for (int i = 0; i < optionalParameters.length; i++) {
253: vars.add(optionalParameters[i].var);
254: if (optionalParameters[i].svar != NIL)
255: vars.add(optionalParameters[i].svar);
256: if (!bindInitForms)
257: if (!optionalParameters[i].initForm.constantp())
258: bindInitForms = true;
259: }
260: }
261: if (restVar != null) {
262: vars.add(restVar);
263: }
264: if (keywordParameters != null) {
265: for (int i = 0; i < keywordParameters.length; i++) {
266: vars.add(keywordParameters[i].var);
267: if (keywordParameters[i].svar != NIL)
268: vars.add(keywordParameters[i].svar);
269: if (!bindInitForms)
270: if (!keywordParameters[i].initForm.constantp())
271: bindInitForms = true;
272: }
273: }
274: Symbol[] array = new Symbol[vars.size()];
275: vars.toArray(array);
276: return array;
277: }
278:
279: private final Symbol[] processDeclarations()
280: throws ConditionThrowable {
281: ArrayList specials = null;
282: LispObject forms = body;
283: while (forms != NIL) {
284: LispObject obj = forms.car();
285: if (obj instanceof Cons && obj.car() == Symbol.DECLARE) {
286: LispObject decls = obj.cdr();
287: while (decls != NIL) {
288: LispObject decl = decls.car();
289: if (decl instanceof Cons
290: && decl.car() == Symbol.SPECIAL) {
291: LispObject vars = decl.cdr();
292: while (vars != NIL) {
293: Symbol var = checkSymbol(vars.car());
294: if (specials == null)
295: specials = new ArrayList();
296: specials.add(var);
297: vars = vars.cdr();
298: }
299: }
300: decls = decls.cdr();
301: }
302: forms = forms.cdr();
303: } else
304: break;
305: }
306: if (specials == null)
307: return null;
308: Symbol[] array = new Symbol[specials.size()];
309: specials.toArray(array);
310: return array;
311: }
312:
313: private static final void invalidParameter(LispObject obj)
314: throws ConditionThrowable {
315: signal(new LispError(obj.writeToString()
316: + " may not be used as a variable in a lambda list."));
317: }
318:
319: public LispObject typep(LispObject typeSpecifier)
320: throws ConditionThrowable {
321: if (typeSpecifier == Symbol.COMPILED_FUNCTION)
322: return NIL;
323: return super .typep(typeSpecifier);
324: }
325:
326: public final LispObject getParameterList() {
327: return lambdaList;
328: }
329:
330: public final LispObject getVariableList() {
331: LispObject result = NIL;
332: if (variables != null) {
333: for (int i = variables.length; i-- > 0;)
334: result = new Cons(variables[i], result);
335: }
336: return result;
337: }
338:
339: // Returns body as a list.
340: public final LispObject getBody() {
341: return body;
342: }
343:
344: public final Environment getEnvironment() {
345: return environment;
346: }
347:
348: public LispObject execute() throws ConditionThrowable {
349: if (arity == 0) {
350: final LispThread thread = LispThread.currentThread();
351: LispObject result = NIL;
352: LispObject prog = body;
353: while (prog != NIL) {
354: result = eval(prog.car(), environment, thread);
355: prog = prog.cdr();
356: }
357: return result;
358: } else
359: return execute(new LispObject[0]);
360: }
361:
362: public LispObject execute(LispObject arg) throws ConditionThrowable {
363: if (minArgs == 1) {
364: final LispThread thread = LispThread.currentThread();
365: Environment oldDynEnv = thread.getDynamicEnvironment();
366: Environment ext = new Environment(environment);
367: if (specials != null) {
368: for (int i = 0; i < specials.length; i++)
369: ext.declareSpecial(specials[i]);
370: }
371: bind(requiredParameters[0].var, arg, ext);
372: if (arity != 1) {
373: if (optionalParameters != null)
374: bindOptionalParameterDefaults(ext, thread);
375: if (restVar != null)
376: bind(restVar, NIL, ext);
377: if (keywordParameters != null)
378: bindKeywordParameterDefaults(ext, thread);
379: }
380: if (auxVars != null)
381: bindAuxVars(ext, thread);
382: LispObject result = NIL;
383: LispObject prog = body;
384: try {
385: while (prog != NIL) {
386: result = eval(prog.car(), ext, thread);
387: prog = prog.cdr();
388: }
389: } finally {
390: thread.setDynamicEnvironment(oldDynEnv);
391: }
392: return result;
393: } else {
394: LispObject[] args = new LispObject[1];
395: args[0] = arg;
396: return execute(args);
397: }
398: }
399:
400: public LispObject execute(LispObject first, LispObject second)
401: throws ConditionThrowable {
402: if (minArgs == 2) {
403: final LispThread thread = LispThread.currentThread();
404: Environment oldDynEnv = thread.getDynamicEnvironment();
405: Environment ext = new Environment(environment);
406: if (specials != null) {
407: for (int i = 0; i < specials.length; i++)
408: ext.declareSpecial(specials[i]);
409: }
410: bind(requiredParameters[0].var, first, ext);
411: bind(requiredParameters[1].var, second, ext);
412: if (arity != 2) {
413: if (optionalParameters != null)
414: bindOptionalParameterDefaults(ext, thread);
415: if (restVar != null)
416: bind(restVar, NIL, ext);
417: if (keywordParameters != null)
418: bindKeywordParameterDefaults(ext, thread);
419: }
420: if (auxVars != null)
421: bindAuxVars(ext, thread);
422: LispObject result = NIL;
423: LispObject prog = body;
424: try {
425: while (prog != NIL) {
426: result = eval(prog.car(), ext, thread);
427: prog = prog.cdr();
428: }
429: } finally {
430: thread.setDynamicEnvironment(oldDynEnv);
431: }
432: return result;
433: } else {
434: LispObject[] args = new LispObject[2];
435: args[0] = first;
436: args[1] = second;
437: return execute(args);
438: }
439: }
440:
441: public LispObject execute(LispObject first, LispObject second,
442: LispObject third) throws ConditionThrowable {
443: if (minArgs == 3) {
444: final LispThread thread = LispThread.currentThread();
445: Environment oldDynEnv = thread.getDynamicEnvironment();
446: Environment ext = new Environment(environment);
447: if (specials != null) {
448: for (int i = 0; i < specials.length; i++)
449: ext.declareSpecial(specials[i]);
450: }
451: bind(requiredParameters[0].var, first, ext);
452: bind(requiredParameters[1].var, second, ext);
453: bind(requiredParameters[2].var, third, ext);
454: if (arity != 3) {
455: if (optionalParameters != null)
456: bindOptionalParameterDefaults(ext, thread);
457: if (restVar != null)
458: bind(restVar, NIL, ext);
459: if (keywordParameters != null)
460: bindKeywordParameterDefaults(ext, thread);
461: }
462: if (auxVars != null)
463: bindAuxVars(ext, thread);
464: LispObject result = NIL;
465: LispObject prog = body;
466: try {
467: while (prog != NIL) {
468: result = eval(prog.car(), ext, thread);
469: prog = prog.cdr();
470: }
471: } finally {
472: thread.setDynamicEnvironment(oldDynEnv);
473: }
474: return result;
475: } else {
476: LispObject[] args = new LispObject[3];
477: args[0] = first;
478: args[1] = second;
479: args[2] = third;
480: return execute(args);
481: }
482: }
483:
484: public LispObject execute(LispObject first, LispObject second,
485: LispObject third, LispObject fourth)
486: throws ConditionThrowable {
487: if (minArgs == 4) {
488: final LispThread thread = LispThread.currentThread();
489: Environment oldDynEnv = thread.getDynamicEnvironment();
490: Environment ext = new Environment(environment);
491: if (specials != null) {
492: for (int i = 0; i < specials.length; i++)
493: ext.declareSpecial(specials[i]);
494: }
495: bind(requiredParameters[0].var, first, ext);
496: bind(requiredParameters[1].var, second, ext);
497: bind(requiredParameters[2].var, third, ext);
498: bind(requiredParameters[3].var, fourth, ext);
499: if (arity != 4) {
500: if (optionalParameters != null)
501: bindOptionalParameterDefaults(ext, thread);
502: if (restVar != null)
503: bind(restVar, NIL, ext);
504: if (keywordParameters != null)
505: bindKeywordParameterDefaults(ext, thread);
506: }
507: if (auxVars != null)
508: bindAuxVars(ext, thread);
509: LispObject result = NIL;
510: LispObject prog = body;
511: try {
512: while (prog != NIL) {
513: result = eval(prog.car(), ext, thread);
514: prog = prog.cdr();
515: }
516: } finally {
517: thread.setDynamicEnvironment(oldDynEnv);
518: }
519: return result;
520: } else {
521: LispObject[] args = new LispObject[4];
522: args[0] = first;
523: args[1] = second;
524: args[2] = third;
525: args[3] = fourth;
526: return execute(args);
527: }
528: }
529:
530: public LispObject execute(LispObject[] args)
531: throws ConditionThrowable {
532: final LispThread thread = LispThread.currentThread();
533: Environment oldDynEnv = thread.getDynamicEnvironment();
534: Environment ext = new Environment(environment);
535: if (specials != null) {
536: for (int i = 0; i < specials.length; i++)
537: ext.declareSpecial(specials[i]);
538: }
539: args = processArgs(args, 0);
540: Debug.assertTrue(args.length == variables.length);
541: for (int i = 0; i < variables.length; i++) {
542: Symbol sym = variables[i];
543: if (isSpecial(sym))
544: thread.bindSpecial(sym, args[i]);
545: else
546: ext.bind(sym, args[i]);
547: }
548: if (auxVars != null)
549: bindAuxVars(ext, thread);
550: LispObject result = NIL;
551: LispObject prog = body;
552: try {
553: while (prog != NIL) {
554: result = eval(prog.car(), ext, thread);
555: prog = prog.cdr();
556: }
557: } finally {
558: thread.setDynamicEnvironment(oldDynEnv);
559: }
560: return result;
561: }
562:
563: private final boolean isSpecial(Symbol sym) {
564: if (sym.isSpecialVariable())
565: return true;
566: if (specials != null) {
567: for (int i = specials.length; i-- > 0;) {
568: if (sym == specials[i])
569: return true;
570: }
571: }
572: return false;
573: }
574:
575: protected final LispObject[] processArgs(LispObject[] args,
576: int extra) throws ConditionThrowable {
577: final int argsLength = args.length;
578: if (arity >= 0) {
579: // Fixed arity.
580: if (argsLength != arity)
581: signal(new WrongNumberOfArgumentsException(this ));
582: if (extra == 0)
583: return args;
584: }
585: // Not fixed arity, or extra != 0.
586: if (argsLength < minArgs)
587: signal(new WrongNumberOfArgumentsException(this ));
588: final LispThread thread = LispThread.currentThread();
589: final LispObject[] array = new LispObject[variables.length
590: + extra];
591: int index = 0;
592: // The bindings established here (if any) are lost when this function
593: // returns. They are used only in the evaluation of initforms for
594: // optional and keyword arguments.
595: Environment oldDynEnv = thread.getDynamicEnvironment();
596: Environment ext = new Environment(environment);
597: // Section 3.4.4: "...the &environment parameter is bound along with
598: // &whole before any other variables in the lambda list..."
599: if (bindInitForms)
600: if (envVar != null)
601: bind(envVar, environment, ext);
602: // Required parameters.
603: if (requiredParameters != null) {
604: for (int i = 0; i < minArgs; i++) {
605: if (bindInitForms)
606: bind(requiredParameters[i].var, args[i], ext);
607: array[index++] = args[i];
608: }
609: }
610: int i = minArgs;
611: int argsUsed = minArgs;
612: // Optional parameters.
613: if (optionalParameters != null) {
614: for (int j = 0; j < optionalParameters.length; j++) {
615: Parameter parameter = optionalParameters[j];
616: if (i < argsLength) {
617: if (bindInitForms)
618: bind(parameter.var, args[i], ext);
619: array[index++] = args[i];
620: ++argsUsed;
621: if (parameter.svar != NIL) {
622: if (bindInitForms)
623: bind((Symbol) parameter.svar, T, ext);
624: array[index++] = T;
625: }
626: } else {
627: // We've run out of arguments.
628: LispObject value;
629: if (parameter.initVal != null)
630: value = parameter.initVal;
631: else
632: value = eval(parameter.initForm, ext, thread);
633: if (bindInitForms)
634: bind(parameter.var, value, ext);
635: array[index++] = value;
636: if (parameter.svar != NIL) {
637: if (bindInitForms)
638: bind((Symbol) parameter.svar, NIL, ext);
639: array[index++] = NIL;
640: }
641: }
642: ++i;
643: }
644: }
645: // &rest parameter.
646: if (restVar != null) {
647: LispObject rest = NIL;
648: for (int j = argsLength; j-- > argsUsed;)
649: rest = new Cons(args[j], rest);
650: if (bindInitForms)
651: bind(restVar, rest, ext);
652: array[index++] = rest;
653: }
654: // Keyword parameters.
655: if (keywordParameters != null) {
656: int argsLeft = argsLength - argsUsed;
657: if (argsLeft == 0) {
658: // No keyword arguments were supplied.
659: // Bind all keyword parameters to their defaults.
660: for (int k = 0; k < keywordParameters.length; k++) {
661: Parameter parameter = keywordParameters[k];
662: LispObject initForm = parameter.initForm;
663: LispObject value;
664: if (parameter.initVal != null)
665: value = parameter.initVal;
666: else
667: value = eval(parameter.initForm, ext, thread);
668: if (bindInitForms)
669: bind(parameter.var, value, ext);
670: array[index++] = value;
671: if (parameter.svar != NIL) {
672: if (bindInitForms)
673: bind((Symbol) parameter.svar, NIL, ext);
674: array[index++] = NIL;
675: }
676: }
677: } else {
678: if ((argsLeft % 2) != 0)
679: signal(new ProgramError(
680: "Odd number of keyword arguments."));
681: LispObject allowOtherKeysValue = null;
682: for (int k = 0; k < keywordParameters.length; k++) {
683: Parameter parameter = keywordParameters[k];
684: Symbol keyword = parameter.keyword;
685: LispObject value = null;
686: boolean unbound = true;
687: for (int j = argsUsed; j < argsLength; j += 2) {
688: if (args[j] == keyword) {
689: if (bindInitForms)
690: bind(parameter.var, args[j + 1], ext);
691: value = array[index++] = args[j + 1];
692: if (parameter.svar != NIL) {
693: if (bindInitForms)
694: bind((Symbol) parameter.svar, T,
695: ext);
696: array[index++] = T;
697: }
698: args[j] = null;
699: args[j + 1] = null;
700: unbound = false;
701: break;
702: }
703: }
704: if (unbound) {
705: if (parameter.initVal != null)
706: value = parameter.initVal;
707: else
708: value = eval(parameter.initForm, ext,
709: thread);
710: if (bindInitForms)
711: bind(parameter.var, value, ext);
712: array[index++] = value;
713: if (parameter.svar != NIL) {
714: if (bindInitForms)
715: bind((Symbol) parameter.svar, NIL, ext);
716: array[index++] = NIL;
717: }
718: }
719: if (keyword == Keyword.ALLOW_OTHER_KEYS) {
720: if (allowOtherKeysValue == null)
721: allowOtherKeysValue = value;
722: }
723: }
724: if (!allowOtherKeys) {
725: if (allowOtherKeysValue == null
726: || allowOtherKeysValue == NIL) {
727: LispObject unrecognizedKeyword = null;
728: for (int j = argsUsed; j < argsLength; j += 2) {
729: LispObject keyword = args[j];
730: if (keyword == null)
731: continue;
732: if (keyword == Keyword.ALLOW_OTHER_KEYS) {
733: if (allowOtherKeysValue == null) {
734: allowOtherKeysValue = args[j + 1];
735: if (allowOtherKeysValue != NIL)
736: break;
737: }
738: continue;
739: }
740: // Unused keyword argument.
741: boolean ok = false;
742: for (int k = keywordParameters.length; k-- > 0;) {
743: if (keywordParameters[k].keyword == keyword) {
744: // Found it!
745: ok = true;
746: break;
747: }
748: }
749: if (ok)
750: continue;
751: // Unrecognized keyword argument.
752: if (unrecognizedKeyword == null)
753: unrecognizedKeyword = keyword;
754: }
755: if (unrecognizedKeyword != null) {
756: if (!allowOtherKeys
757: && (allowOtherKeysValue == null || allowOtherKeysValue == NIL))
758: signal(new ProgramError(
759: "Unrecognized keyword argument "
760: + unrecognizedKeyword
761: .writeToString()
762: + "."));
763: }
764: }
765: }
766: }
767: } else if (argsUsed < argsLength) {
768: // No keyword parameters.
769: if (argsUsed + 2 <= argsLength) {
770: // Check for :ALLOW-OTHER-KEYS.
771: LispObject allowOtherKeysValue = NIL;
772: int n = argsUsed;
773: while (n < argsLength) {
774: LispObject keyword = args[n];
775: if (keyword == Keyword.ALLOW_OTHER_KEYS) {
776: allowOtherKeysValue = args[n + 1];
777: break;
778: }
779: n += 2;
780: }
781: if (allowOtherKeys || allowOtherKeysValue != NIL) {
782: // Skip keyword/value pairs.
783: while (argsUsed + 2 <= argsLength)
784: argsUsed += 2;
785: } else if (andKey) {
786: LispObject keyword = args[argsUsed];
787: if (keyword == Keyword.ALLOW_OTHER_KEYS) {
788: // Section 3.4.1.4: "Note that if &key is present, a
789: // keyword argument of :allow-other-keys is always
790: // permitted---regardless of whether the associated
791: // value is true or false."
792: argsUsed += 2;
793: }
794: }
795: }
796: if (argsUsed < argsLength) {
797: if (restVar == null)
798: signal(new WrongNumberOfArgumentsException(this ));
799: }
800: }
801: thread.setDynamicEnvironment(oldDynEnv);
802: return array;
803: }
804:
805: private final void bindOptionalParameterDefaults(Environment env,
806: LispThread thread) throws ConditionThrowable {
807: for (int i = 0; i < optionalParameters.length; i++) {
808: Parameter parameter = optionalParameters[i];
809: LispObject value;
810: if (parameter.initVal != null)
811: value = parameter.initVal;
812: else
813: value = eval(parameter.initForm, env, thread);
814: bind(parameter.var, value, env);
815: if (parameter.svar != NIL)
816: bind((Symbol) parameter.svar, NIL, env);
817: }
818: }
819:
820: private final void bindKeywordParameterDefaults(Environment env,
821: LispThread thread) throws ConditionThrowable {
822: for (int i = 0; i < keywordParameters.length; i++) {
823: Parameter parameter = keywordParameters[i];
824: LispObject value;
825: if (parameter.initVal != null)
826: value = parameter.initVal;
827: else
828: value = eval(parameter.initForm, env, thread);
829: bind(parameter.var, value, env);
830: if (parameter.svar != NIL)
831: bind((Symbol) parameter.svar, NIL, env);
832: }
833: }
834:
835: private final void bindAuxVars(Environment env, LispThread thread)
836: throws ConditionThrowable {
837: // Aux variable processing is analogous to LET* processing.
838: for (int i = 0; i < auxVars.length; i++) {
839: Parameter parameter = auxVars[i];
840: Symbol sym = parameter.var;
841: LispObject value;
842: if (parameter.initVal != null)
843: value = parameter.initVal;
844: else
845: value = eval(parameter.initForm, env, thread);
846: bind(sym, value, env);
847: }
848: }
849:
850: // ### closure-environment closure => environment
851: private static final Primitive1 CLOSURE_ENVIRONMENT = new Primitive1(
852: "closure-environment", PACKAGE_SYS, false, "closure") {
853: public LispObject execute(LispObject arg)
854: throws ConditionThrowable {
855: if (arg instanceof Closure) {
856: Closure closure = (Closure) arg;
857: if (closure.environment != null)
858: return closure.environment;
859: return NIL;
860: }
861: return signal(new TypeError(arg, "closure"));
862: }
863: };
864:
865: private static class Parameter {
866: private final Symbol var;
867: private final LispObject initForm;
868: private final LispObject initVal;
869: private final LispObject svar;
870: private final int type;
871: private final Symbol keyword;
872:
873: public Parameter(Symbol var) {
874: this .var = var;
875: this .initForm = null;
876: this .initVal = null;
877: this .svar = NIL;
878: this .type = REQUIRED;
879: this .keyword = null;
880: }
881:
882: public Parameter(Symbol var, LispObject initForm, int type)
883: throws ConditionThrowable {
884: this .var = var;
885: this .initForm = initForm;
886: this .initVal = processInitForm(initForm);
887: this .svar = NIL;
888: this .type = type;
889: keyword = type == KEYWORD ? PACKAGE_KEYWORD.intern(var
890: .getName()) : null;
891: }
892:
893: public Parameter(Symbol var, LispObject initForm,
894: LispObject svar, int type) throws ConditionThrowable {
895: this .var = var;
896: this .initForm = initForm;
897: this .initVal = processInitForm(initForm);
898: this .svar = (svar != NIL) ? checkSymbol(svar) : NIL;
899: this .type = type;
900: keyword = type == KEYWORD ? PACKAGE_KEYWORD.intern(var
901: .getName()) : null;
902: }
903:
904: public Parameter(Symbol keyword, Symbol var,
905: LispObject initForm, LispObject svar)
906: throws ConditionThrowable {
907: this .var = var;
908: this .initForm = initForm;
909: this .initVal = processInitForm(initForm);
910: this .svar = (svar != NIL) ? checkSymbol(svar) : NIL;
911: type = KEYWORD;
912: this .keyword = keyword;
913: }
914:
915: public String toString() {
916: if (type == REQUIRED)
917: return var.toString();
918: StringBuffer sb = new StringBuffer();
919: if (keyword != null) {
920: sb.append(keyword);
921: sb.append(' ');
922: }
923: sb.append(var.toString());
924: sb.append(' ');
925: sb.append(initForm);
926: sb.append(' ');
927: sb.append(type);
928: return sb.toString();
929: }
930:
931: private static final LispObject processInitForm(
932: LispObject initForm) throws ConditionThrowable {
933: if (initForm.constantp()) {
934: if (initForm instanceof Symbol)
935: return initForm.getSymbolValue();
936: if (initForm instanceof Cons) {
937: Debug.assertTrue(initForm.car() == Symbol.QUOTE);
938: return initForm.cadr();
939: }
940: return initForm;
941: }
942: return null;
943: }
944: }
945: }
|