1 | /* |
---|
2 | * ArgumentListProcessor.java |
---|
3 | * |
---|
4 | * Copyright (C) 2012 Erik Huelsmann |
---|
5 | * Copyright (C) 2002-2008 Peter Graves |
---|
6 | * Copyright (C) 2008 Ville Voutilainen |
---|
7 | * |
---|
8 | * This program is free software; you can redistribute it and/or |
---|
9 | * modify it under the terms of the GNU General Public License |
---|
10 | * as published by the Free Software Foundation; either version 2 |
---|
11 | * of the License, or (at your option) any later version. |
---|
12 | * |
---|
13 | * This program is distributed in the hope that it will be useful, |
---|
14 | * but WITHOUT ANY WARRANTY; without even the implied warranty of |
---|
15 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
---|
16 | * GNU General Public License for more details. |
---|
17 | * |
---|
18 | * You should have received a copy of the GNU General Public License |
---|
19 | * along with this program; if not, write to the Free Software |
---|
20 | * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. |
---|
21 | * |
---|
22 | * As a special exception, the copyright holders of this library give you |
---|
23 | * permission to link this library with independent modules to produce an |
---|
24 | * executable, regardless of the license terms of these independent |
---|
25 | * modules, and to copy and distribute the resulting executable under |
---|
26 | * terms of your choice, provided that you also meet, for each linked |
---|
27 | * independent module, the terms and conditions of the license of that |
---|
28 | * module. An independent module is a module which is not derived from |
---|
29 | * or based on this library. If you modify this library, you may extend |
---|
30 | * this exception to your version of the library, but you are not |
---|
31 | * obligated to do so. If you do not wish to do so, delete this |
---|
32 | * exception statement from your version. |
---|
33 | */ |
---|
34 | |
---|
35 | package org.armedbear.lisp; |
---|
36 | |
---|
37 | import java.util.List; |
---|
38 | import java.util.ArrayList; |
---|
39 | import static org.armedbear.lisp.Lisp.*; |
---|
40 | |
---|
41 | /** A class to parse a lambda list and match function call arguments with it. |
---|
42 | * |
---|
43 | * The lambda list may either be of type ORDINARY or MACRO lambda list. |
---|
44 | * All other lambda lists are parsed elsewhere in our code base. |
---|
45 | */ |
---|
46 | public class ArgumentListProcessor { |
---|
47 | |
---|
48 | public enum LambdaListType { |
---|
49 | ORDINARY, |
---|
50 | MACRO |
---|
51 | } |
---|
52 | |
---|
53 | // States. |
---|
54 | private static final int STATE_REQUIRED = 0; |
---|
55 | private static final int STATE_OPTIONAL = 1; |
---|
56 | private static final int STATE_KEYWORD = 2; |
---|
57 | private static final int STATE_REST = 3; |
---|
58 | private static final int STATE_AUX = 4; |
---|
59 | |
---|
60 | private Param[] requiredParameters = new Param[0]; |
---|
61 | private Param[] optionalParameters = requiredParameters; |
---|
62 | private KeywordParam[] keywordParameters = new KeywordParam[0]; |
---|
63 | private Param[] auxVars = requiredParameters; |
---|
64 | private Param[] positionalParameters = requiredParameters; |
---|
65 | |
---|
66 | private Symbol restVar; |
---|
67 | private Param restParam; |
---|
68 | private Symbol envVar; |
---|
69 | private Param envParam; |
---|
70 | private int arity; |
---|
71 | |
---|
72 | private int minArgs; |
---|
73 | private int maxArgs; |
---|
74 | |
---|
75 | /** The variables in the lambda list, including &aux and 'supplied-p' */ |
---|
76 | private Symbol[] variables = new Symbol[0]; |
---|
77 | |
---|
78 | /** Array of booleans of value 'true' if the associated variable in the |
---|
79 | * variables array is a special variable */ |
---|
80 | private boolean[] specials = new boolean[0]; |
---|
81 | |
---|
82 | private boolean andKey; |
---|
83 | private boolean allowOtherKeys; |
---|
84 | |
---|
85 | /** The parser to be used to match function call arguments with the lambda list */ |
---|
86 | final private ArgumentMatcher matcher; |
---|
87 | |
---|
88 | /** Holds the value 'true' if the matcher needs an evaluation environment to |
---|
89 | * evaluate the initforms of variales in the &optional, &key or &aux categories */ |
---|
90 | private boolean matcherNeedsEnv; |
---|
91 | |
---|
92 | /** Used when generating errors during function call argument matching */ |
---|
93 | private Operator function; |
---|
94 | |
---|
95 | /** Constructor to be used from compiled code |
---|
96 | * |
---|
97 | * The compiler hands in pre-parsed lambda lists. The process of matching |
---|
98 | * function call arguments with lambda lists which are constructed this |
---|
99 | * way don't support non-constant initforms for &optional, &key and &aux |
---|
100 | * parameters. As a result, there's no need to create an evaluation |
---|
101 | * environment which in turn eliminates the need to know which variables |
---|
102 | * are special. |
---|
103 | * |
---|
104 | * @param fun The function to report function call argument matching errors on |
---|
105 | * @param required The list of required arguments |
---|
106 | * @param optional The list of optional arguments |
---|
107 | * @param keyword The list of keyword parameters |
---|
108 | * @param key Indicates whether &key was specified (optionally without naming keys) |
---|
109 | * @param moreKeys Indicates whether &allow-other-keys was specified |
---|
110 | * @param rest Specifies the &rest variable name, if one was specified, or 'null' if none |
---|
111 | */ |
---|
112 | public ArgumentListProcessor(Operator fun, int requiredCount, |
---|
113 | OptionalParam[] optional, KeywordParam[] keyword, |
---|
114 | boolean key, boolean moreKeys, Symbol rest) { |
---|
115 | |
---|
116 | function = fun; |
---|
117 | |
---|
118 | requiredParameters = new RequiredParam[requiredCount]; |
---|
119 | positionalParameters = new Param[requiredCount + optional.length |
---|
120 | + ((rest != null) ? 1 : 0)]; |
---|
121 | |
---|
122 | // the same anonymous required parameter can be used any number of times |
---|
123 | RequiredParam r = new RequiredParam(); |
---|
124 | for (int i = 0; i < requiredCount; i++) { |
---|
125 | requiredParameters[i] = r; |
---|
126 | positionalParameters[i] = r; |
---|
127 | } |
---|
128 | |
---|
129 | optionalParameters = optional; |
---|
130 | System.arraycopy(optional, 0, |
---|
131 | positionalParameters, requiredCount, optional.length); |
---|
132 | |
---|
133 | restVar = rest; |
---|
134 | if (restVar != null) |
---|
135 | positionalParameters[requiredCount + optional.length] = |
---|
136 | restParam = new RestParam(rest, false); |
---|
137 | |
---|
138 | andKey = key; |
---|
139 | allowOtherKeys = moreKeys; |
---|
140 | keywordParameters = keyword; |
---|
141 | |
---|
142 | |
---|
143 | auxVars = new Param[0]; |
---|
144 | |
---|
145 | |
---|
146 | variables = extractVariables(); |
---|
147 | specials = new boolean[variables.length]; // default values 'false' -- leave that way |
---|
148 | |
---|
149 | minArgs = requiredParameters.length; |
---|
150 | maxArgs = (rest == null && ! allowOtherKeys) |
---|
151 | ? minArgs + optionalParameters.length + 2*keywordParameters.length : -1; |
---|
152 | arity = (rest == null && ! allowOtherKeys && ! andKey && optionalParameters.length == 0) |
---|
153 | ? maxArgs : -1; |
---|
154 | |
---|
155 | if (keyword.length == 0) |
---|
156 | matcher = new FastMatcher(); |
---|
157 | else |
---|
158 | matcher = new SlowMatcher(); |
---|
159 | } |
---|
160 | |
---|
161 | |
---|
162 | /** Instantiates an ArgumentListProcessor by parsing the lambda list specified |
---|
163 | * in 'lambdaList'. |
---|
164 | * |
---|
165 | * This constructor sets up the object to support evaluation of non-constant |
---|
166 | * initforms. |
---|
167 | * |
---|
168 | * @param fun Function to use when reporting errors |
---|
169 | * @param lambdaList Lambda list to parse and use for function call |
---|
170 | * @param specials A list of symbols specifying which variables to |
---|
171 | * bind as specials during initform evaluation |
---|
172 | */ |
---|
173 | public ArgumentListProcessor(Operator fun, LispObject lambdaList, |
---|
174 | LispObject specials, LambdaListType type) { |
---|
175 | function = fun; |
---|
176 | |
---|
177 | boolean _andKey = false; |
---|
178 | boolean _allowOtherKeys = false; |
---|
179 | if (lambdaList instanceof Cons) |
---|
180 | { |
---|
181 | final int length = lambdaList.length(); |
---|
182 | ArrayList<Param> required = null; |
---|
183 | ArrayList<Param> optional = null; |
---|
184 | ArrayList<Param> keywords = null; |
---|
185 | ArrayList<Param> aux = null; |
---|
186 | int state = STATE_REQUIRED; |
---|
187 | LispObject remaining = lambdaList; |
---|
188 | |
---|
189 | if (remaining.car() == Symbol.AND_WHOLE) { |
---|
190 | if (type == LambdaListType.ORDINARY) { |
---|
191 | error(new ProgramError("&WHOLE not allowed in ordinary lambda lists.")); |
---|
192 | } else { |
---|
193 | // skip the &WHOLE <var> part of the lambda list |
---|
194 | remaining = remaining.cdr().cdr(); |
---|
195 | } |
---|
196 | } |
---|
197 | |
---|
198 | |
---|
199 | while (remaining != NIL) |
---|
200 | { |
---|
201 | LispObject obj = remaining.car(); |
---|
202 | if (obj instanceof Symbol) |
---|
203 | { |
---|
204 | if (obj == Symbol.AND_WHOLE) { |
---|
205 | if (type == LambdaListType.ORDINARY) |
---|
206 | error(new ProgramError("&WHOLE not allowed in ordinary lambda lists.")); |
---|
207 | else |
---|
208 | error(new ProgramError("&WHOLE must appear first in macro lambda list.")); |
---|
209 | } |
---|
210 | if (state == STATE_AUX) |
---|
211 | { |
---|
212 | if (aux == null) |
---|
213 | aux = new ArrayList<Param>(); |
---|
214 | aux.add(new AuxParam((Symbol)obj, |
---|
215 | isSpecial((Symbol)obj, specials), NIL)); |
---|
216 | } |
---|
217 | else if (obj == Symbol.AND_OPTIONAL) |
---|
218 | { |
---|
219 | state = STATE_OPTIONAL; |
---|
220 | arity = -1; |
---|
221 | } |
---|
222 | else if (obj == Symbol.AND_REST || obj == Symbol.AND_BODY) |
---|
223 | { |
---|
224 | if (_andKey) |
---|
225 | { |
---|
226 | error(new ProgramError( |
---|
227 | "&REST/&BODY must precede &KEY.")); |
---|
228 | } |
---|
229 | if (type == LambdaListType.ORDINARY && obj == Symbol.AND_BODY) |
---|
230 | error(new ProgramError("&BODY not allowed in ordinary lambda lists.")); |
---|
231 | state = STATE_REST; |
---|
232 | arity = -1; |
---|
233 | maxArgs = -1; |
---|
234 | remaining = remaining.cdr(); |
---|
235 | if (remaining == NIL) |
---|
236 | { |
---|
237 | error(new ProgramError( |
---|
238 | "&REST/&BODY must be followed by a variable.")); |
---|
239 | } |
---|
240 | if (restVar != null) |
---|
241 | { |
---|
242 | error(new ProgramError( |
---|
243 | "&REST/&BODY may occur only once.")); |
---|
244 | } |
---|
245 | final LispObject remainingcar = remaining.car(); |
---|
246 | if (remainingcar instanceof Symbol) |
---|
247 | { |
---|
248 | restVar = (Symbol) remainingcar; |
---|
249 | restParam = new RestParam(restVar, isSpecial(restVar, specials)); |
---|
250 | } |
---|
251 | else |
---|
252 | { |
---|
253 | error(new ProgramError( |
---|
254 | "&REST/&BODY must be followed by a variable.")); |
---|
255 | } |
---|
256 | } |
---|
257 | else if (obj == Symbol.AND_ENVIRONMENT) |
---|
258 | { |
---|
259 | if (type == LambdaListType.ORDINARY) |
---|
260 | error(new ProgramError("&ENVIRONMENT not allowed in ordinary lambda lists.")); |
---|
261 | remaining = remaining.cdr(); |
---|
262 | envVar = (Symbol) remaining.car(); |
---|
263 | envParam = new EnvironmentParam(envVar, isSpecial(envVar, specials)); |
---|
264 | arity = -1; // FIXME |
---|
265 | } |
---|
266 | else if (obj == Symbol.AND_KEY) |
---|
267 | { |
---|
268 | state = STATE_KEYWORD; |
---|
269 | _andKey = true; |
---|
270 | arity = -1; |
---|
271 | } |
---|
272 | else if (obj == Symbol.AND_ALLOW_OTHER_KEYS) |
---|
273 | { |
---|
274 | _allowOtherKeys = true; |
---|
275 | maxArgs = -1; |
---|
276 | } |
---|
277 | else if (obj == Symbol.AND_AUX) |
---|
278 | { |
---|
279 | // All remaining specifiers are aux variable specifiers. |
---|
280 | state = STATE_AUX; |
---|
281 | arity = -1; // FIXME |
---|
282 | } |
---|
283 | else |
---|
284 | { |
---|
285 | if (state == STATE_OPTIONAL) |
---|
286 | { |
---|
287 | if (optional == null) |
---|
288 | optional = new ArrayList<Param>(); |
---|
289 | optional.add(new OptionalParam((Symbol)obj, |
---|
290 | isSpecial((Symbol)obj, specials), null, false, NIL)); |
---|
291 | if (maxArgs >= 0) |
---|
292 | ++maxArgs; |
---|
293 | } |
---|
294 | else if (state == STATE_KEYWORD) |
---|
295 | { |
---|
296 | if (keywords == null) |
---|
297 | keywords = new ArrayList<Param>(); |
---|
298 | keywords.add(new KeywordParam((Symbol)obj, |
---|
299 | isSpecial((Symbol)obj, specials), null, false, NIL, null)); |
---|
300 | if (maxArgs >= 0) |
---|
301 | maxArgs += 2; |
---|
302 | } |
---|
303 | else |
---|
304 | { |
---|
305 | if (state != STATE_REQUIRED) |
---|
306 | { |
---|
307 | error(new ProgramError( |
---|
308 | "required parameters cannot appear after &REST/&BODY.")); |
---|
309 | } |
---|
310 | if (required == null) |
---|
311 | required = new ArrayList<Param>(); |
---|
312 | required.add(new RequiredParam((Symbol)obj, |
---|
313 | isSpecial((Symbol)obj, specials))); |
---|
314 | if (maxArgs >= 0) |
---|
315 | ++maxArgs; |
---|
316 | } |
---|
317 | } |
---|
318 | } |
---|
319 | else if (obj instanceof Cons) |
---|
320 | { |
---|
321 | if (state == STATE_AUX) |
---|
322 | { |
---|
323 | Symbol sym = checkSymbol(obj.car()); |
---|
324 | LispObject initForm = obj.cadr(); |
---|
325 | Debug.assertTrue(initForm != null); |
---|
326 | if (aux == null) |
---|
327 | aux = new ArrayList<Param>(); |
---|
328 | aux.add(new AuxParam(sym, isSpecial(sym, specials), initForm)); |
---|
329 | } |
---|
330 | else if (state == STATE_OPTIONAL) |
---|
331 | { |
---|
332 | Symbol sym = checkSymbol(obj.car()); |
---|
333 | LispObject initForm = obj.cadr(); |
---|
334 | Symbol svar = checkSymbol(obj.cdr().cdr().car()); |
---|
335 | if (optional == null) |
---|
336 | optional = new ArrayList<Param>(); |
---|
337 | optional.add(new OptionalParam(sym, isSpecial(sym, specials), |
---|
338 | svar == NIL ? null : svar, isSpecial(svar, specials), initForm)); |
---|
339 | if (maxArgs >= 0) |
---|
340 | ++maxArgs; |
---|
341 | } |
---|
342 | else if (state == STATE_KEYWORD) |
---|
343 | { |
---|
344 | Symbol keyword; |
---|
345 | Symbol var; |
---|
346 | LispObject initForm = NIL; |
---|
347 | Symbol svar = NIL; |
---|
348 | LispObject first = obj.car(); |
---|
349 | if (first instanceof Cons) |
---|
350 | { |
---|
351 | keyword = checkSymbol(first.car()); |
---|
352 | var = checkSymbol(first.cadr()); |
---|
353 | } |
---|
354 | else |
---|
355 | { |
---|
356 | var = checkSymbol(first); |
---|
357 | keyword = |
---|
358 | PACKAGE_KEYWORD.intern(var.name); |
---|
359 | } |
---|
360 | obj = obj.cdr(); |
---|
361 | if (obj != NIL) |
---|
362 | { |
---|
363 | initForm = obj.car(); |
---|
364 | obj = obj.cdr(); |
---|
365 | if (obj != NIL) |
---|
366 | svar = checkSymbol(obj.car()); |
---|
367 | } |
---|
368 | if (keywords == null) |
---|
369 | keywords = new ArrayList<Param>(); |
---|
370 | keywords.add(new KeywordParam(var, isSpecial(var, specials), |
---|
371 | svar == NIL ? null : svar, isSpecial(svar, specials), |
---|
372 | initForm, keyword)); |
---|
373 | if (maxArgs >= 0) |
---|
374 | maxArgs += 2; |
---|
375 | } |
---|
376 | else |
---|
377 | invalidParameter(obj); |
---|
378 | } |
---|
379 | else |
---|
380 | invalidParameter(obj); |
---|
381 | remaining = remaining.cdr(); |
---|
382 | } |
---|
383 | if (arity == 0) |
---|
384 | arity = length; |
---|
385 | ArrayList<Param> positional = new ArrayList<Param>(); |
---|
386 | |
---|
387 | if (envParam != null) |
---|
388 | positional.add(envParam); |
---|
389 | if (required != null) |
---|
390 | { |
---|
391 | requiredParameters = new Param[required.size()]; |
---|
392 | required.toArray(requiredParameters); |
---|
393 | positional.addAll(required); |
---|
394 | } |
---|
395 | if (optional != null) |
---|
396 | { |
---|
397 | optionalParameters = new Param[optional.size()]; |
---|
398 | optional.toArray(optionalParameters); |
---|
399 | positional.addAll(optional); |
---|
400 | } |
---|
401 | if (restParam != null) |
---|
402 | positional.add(restParam); |
---|
403 | if (keywords != null) |
---|
404 | { |
---|
405 | keywordParameters = new KeywordParam[keywords.size()]; |
---|
406 | keywords.toArray(keywordParameters); |
---|
407 | } |
---|
408 | if (aux != null) |
---|
409 | { |
---|
410 | auxVars = new Param[aux.size()]; |
---|
411 | auxVars = aux.toArray(auxVars); |
---|
412 | } |
---|
413 | |
---|
414 | positionalParameters = positional.toArray(positionalParameters); |
---|
415 | } |
---|
416 | else |
---|
417 | { |
---|
418 | // Lambda list is empty. |
---|
419 | Debug.assertTrue(lambdaList == NIL); |
---|
420 | arity = 0; |
---|
421 | maxArgs = 0; |
---|
422 | } |
---|
423 | |
---|
424 | this.andKey = _andKey; |
---|
425 | this.allowOtherKeys = _allowOtherKeys; |
---|
426 | minArgs = requiredParameters.length; |
---|
427 | if (arity >= 0) |
---|
428 | Debug.assertTrue(arity == minArgs); |
---|
429 | variables = extractVariables(); |
---|
430 | this.specials = new boolean[variables.length]; |
---|
431 | for (int i = 0; i < variables.length; i++) |
---|
432 | this.specials[i] = isSpecial(variables[i], specials); |
---|
433 | |
---|
434 | |
---|
435 | for (Param p : positionalParameters) |
---|
436 | if (p.needsEnvironment()) { |
---|
437 | matcherNeedsEnv = true; |
---|
438 | break; |
---|
439 | } |
---|
440 | if (! matcherNeedsEnv) |
---|
441 | for (Param p : keywordParameters) |
---|
442 | if (p.needsEnvironment()) { |
---|
443 | matcherNeedsEnv = true; |
---|
444 | break; |
---|
445 | } |
---|
446 | if (! matcherNeedsEnv) |
---|
447 | for (Param p : auxVars) |
---|
448 | if (p.needsEnvironment()) { |
---|
449 | matcherNeedsEnv = true; |
---|
450 | break; |
---|
451 | } |
---|
452 | |
---|
453 | |
---|
454 | if (keywordParameters.length == 0) { |
---|
455 | matcher = new FastMatcher(); |
---|
456 | } else { |
---|
457 | matcher = new SlowMatcher(); |
---|
458 | } |
---|
459 | |
---|
460 | |
---|
461 | |
---|
462 | } |
---|
463 | |
---|
464 | public void setFunction(Operator fun) { |
---|
465 | function = fun; |
---|
466 | } |
---|
467 | |
---|
468 | /** Matches the function call arguments 'args' with the lambda list, |
---|
469 | * returning an array with variable values to be used. The array is sorted |
---|
470 | * the same way as the variables returned by the 'extractVariables' function. |
---|
471 | * |
---|
472 | * @param args Funcion call arguments to be matched |
---|
473 | * @param _environment Environment to be used for the &environment variable |
---|
474 | * @param env Environment to evaluate initforms in |
---|
475 | * @param thread Thread to be used for binding special variables |
---|
476 | * -- must be LispThread.currentThread() |
---|
477 | * @return An array of LispObjects corresponding to the values to be bound |
---|
478 | * to the variables in the lambda list |
---|
479 | */ |
---|
480 | public LispObject[] match(LispObject[] args, Environment _environment, |
---|
481 | Environment env, LispThread thread) { |
---|
482 | if (matcherNeedsEnv) { |
---|
483 | if (thread == null) |
---|
484 | thread = LispThread.currentThread(); |
---|
485 | |
---|
486 | env = new Environment((env == null) ? _environment : env); |
---|
487 | } |
---|
488 | LispObject[] rv = matcher.match(args, _environment, env, thread); |
---|
489 | for (int i = 0; i < rv.length; i++) |
---|
490 | Debug.assertTrue(rv[i] != null); |
---|
491 | return rv; |
---|
492 | } |
---|
493 | |
---|
494 | /** Binds the variable values returned from 'match' to their corresponding |
---|
495 | * variables in the environment 'env', with specials bound in thread 'thread'. |
---|
496 | * |
---|
497 | * @param values Values to be bound |
---|
498 | * @param env |
---|
499 | * @param thread |
---|
500 | */ |
---|
501 | public void bindVars(LispObject[] values, Environment env, LispThread thread) { |
---|
502 | for (int i = 0; i < variables.length; i++) { |
---|
503 | Symbol var = variables[i]; |
---|
504 | // If a symbol is declared special after a function is defined, |
---|
505 | // the interpreter binds a lexical variable instead of a dynamic |
---|
506 | // one if we don't check isSpecialVariable() |
---|
507 | bindArg(specials[i] || var.isSpecialVariable(), |
---|
508 | var, values[i], env, thread); |
---|
509 | } |
---|
510 | } |
---|
511 | |
---|
512 | public Symbol[] freeSpecials(LispObject specials) { |
---|
513 | ArrayList<Symbol> list = new ArrayList<Symbol>(); |
---|
514 | |
---|
515 | next_special: |
---|
516 | while (specials != NIL) { |
---|
517 | Symbol special = (Symbol)specials.car(); |
---|
518 | specials = specials.cdr(); |
---|
519 | |
---|
520 | for (Symbol v : variables) |
---|
521 | if (v == special) |
---|
522 | continue next_special; |
---|
523 | |
---|
524 | list.add(special); |
---|
525 | } |
---|
526 | |
---|
527 | Symbol[] rv = new Symbol[list.size()]; |
---|
528 | return list.toArray(rv); |
---|
529 | } |
---|
530 | |
---|
531 | public int getArity() { |
---|
532 | return arity; |
---|
533 | } |
---|
534 | |
---|
535 | public int getMinArgs() { |
---|
536 | return minArgs; |
---|
537 | } |
---|
538 | |
---|
539 | public int getMaxArgs() { |
---|
540 | return maxArgs; |
---|
541 | } |
---|
542 | |
---|
543 | public Symbol[] getVariables() { |
---|
544 | return variables; |
---|
545 | } |
---|
546 | |
---|
547 | private static void invalidParameter(LispObject obj) { |
---|
548 | error(new ProgramError(obj.princToString() + |
---|
549 | " may not be used as a variable in a lambda list.")); |
---|
550 | } |
---|
551 | |
---|
552 | private Symbol[] extractVariables() |
---|
553 | { |
---|
554 | ArrayList<Symbol> vars = new ArrayList<Symbol>(); |
---|
555 | for (Param parameter : positionalParameters) |
---|
556 | parameter.addVars(vars); |
---|
557 | for (Param parameter : keywordParameters) |
---|
558 | parameter.addVars(vars); |
---|
559 | for (Param parameter : auxVars) |
---|
560 | parameter.addVars(vars); |
---|
561 | Symbol[] array = new Symbol[vars.size()]; |
---|
562 | vars.toArray(array); |
---|
563 | return array; |
---|
564 | } |
---|
565 | |
---|
566 | /** Internal class implementing the argument list to lambda list matcher. |
---|
567 | * Because we have two implementations - a fast one and a slower one - we |
---|
568 | * need this abstract super class */ |
---|
569 | private static abstract class ArgumentMatcher { |
---|
570 | abstract LispObject[] match(LispObject[] args, Environment _environment, |
---|
571 | Environment env, LispThread thread); |
---|
572 | } |
---|
573 | |
---|
574 | /** ArgumentMatcher class which implements full-blown argument matching, |
---|
575 | * including validation of the keywords passed. */ |
---|
576 | private class SlowMatcher extends ArgumentMatcher { |
---|
577 | private LispObject[] _match(LispObject[] args, Environment _environment, |
---|
578 | Environment env, LispThread thread) { |
---|
579 | final ArgList argslist = new ArgList(_environment, args); |
---|
580 | final LispObject[] array = new LispObject[variables.length]; |
---|
581 | int index = 0; |
---|
582 | |
---|
583 | |
---|
584 | for (Param p : positionalParameters) |
---|
585 | index = p.assign(index, array, argslist, env, thread); |
---|
586 | |
---|
587 | if (andKey) { |
---|
588 | argslist.assertRemainderKeywords(); |
---|
589 | |
---|
590 | for (Param p : keywordParameters) |
---|
591 | index = p.assign(index, array, argslist, env, thread); |
---|
592 | } |
---|
593 | for (Param p : auxVars) |
---|
594 | index = p.assign(index, array, argslist, env, thread); |
---|
595 | |
---|
596 | if (andKey) { |
---|
597 | if (allowOtherKeys) |
---|
598 | return array; |
---|
599 | |
---|
600 | if (!argslist.consumed()) // verify keywords |
---|
601 | { |
---|
602 | LispObject allowOtherKeysValue = |
---|
603 | argslist.findKeywordArg(Keyword.ALLOW_OTHER_KEYS, NIL); |
---|
604 | |
---|
605 | if (allowOtherKeysValue != NIL) |
---|
606 | return array; |
---|
607 | |
---|
608 | // verify keywords |
---|
609 | next_key: |
---|
610 | while (! argslist.consumed()) { |
---|
611 | LispObject key = argslist.consume(); |
---|
612 | argslist.consume(); // consume value |
---|
613 | |
---|
614 | if (key == Keyword.ALLOW_OTHER_KEYS) |
---|
615 | continue next_key; |
---|
616 | |
---|
617 | for (KeywordParam k : keywordParameters) |
---|
618 | if (k.keyword == key) |
---|
619 | continue next_key; |
---|
620 | |
---|
621 | error(new ProgramError("Unrecognized keyword argument " + |
---|
622 | key.printObject())); |
---|
623 | } |
---|
624 | } |
---|
625 | } |
---|
626 | |
---|
627 | if (restVar == null && !argslist.consumed()) |
---|
628 | error(new WrongNumberOfArgumentsException(function)); |
---|
629 | |
---|
630 | return array; |
---|
631 | } |
---|
632 | |
---|
633 | @Override |
---|
634 | LispObject[] match(LispObject[] args, Environment _environment, |
---|
635 | Environment env, LispThread thread) { |
---|
636 | |
---|
637 | if (arity >= 0) |
---|
638 | { |
---|
639 | // Fixed arity. |
---|
640 | if (args.length != arity) |
---|
641 | error(new WrongNumberOfArgumentsException(function, list(args), arity)); |
---|
642 | return args; |
---|
643 | } |
---|
644 | // Not fixed arity. |
---|
645 | if (args.length < minArgs) |
---|
646 | error(new WrongNumberOfArgumentsException(function, minArgs, -1)); |
---|
647 | |
---|
648 | if (thread == null) |
---|
649 | return _match(args, _environment, env, thread); |
---|
650 | |
---|
651 | final SpecialBindingsMark mark = thread.markSpecialBindings(); |
---|
652 | try { |
---|
653 | return _match(args, _environment, env, thread); |
---|
654 | } |
---|
655 | finally { |
---|
656 | thread.resetSpecialBindings(mark); |
---|
657 | } |
---|
658 | } |
---|
659 | } |
---|
660 | |
---|
661 | /** Slimmed down ArgumentMatcher which doesn't implement keyword verification. */ |
---|
662 | private class FastMatcher extends ArgumentMatcher { |
---|
663 | @Override |
---|
664 | LispObject[] match(LispObject[] args, Environment _environment, |
---|
665 | Environment env, LispThread thread) { |
---|
666 | final int argsLength = args.length; |
---|
667 | if (arity >= 0) |
---|
668 | { |
---|
669 | // Fixed arity. |
---|
670 | if (argsLength != arity) |
---|
671 | error(new WrongNumberOfArgumentsException(function, list(args), arity)); |
---|
672 | return args; |
---|
673 | } |
---|
674 | // Not fixed arity. |
---|
675 | if (argsLength < minArgs) |
---|
676 | error(new WrongNumberOfArgumentsException(function, minArgs, -1)); |
---|
677 | |
---|
678 | final ArgList arglist = new ArgList(_environment, args); |
---|
679 | final LispObject[] array = new LispObject[variables.length]; |
---|
680 | int index = 0; |
---|
681 | |
---|
682 | // Required parameters. |
---|
683 | for (Param p : positionalParameters) |
---|
684 | index = p.assign(index, array, arglist, env, thread); |
---|
685 | for (Param p : auxVars) |
---|
686 | index = p.assign(index, array, arglist, env, thread); |
---|
687 | |
---|
688 | if (andKey && !arglist.consumed()) |
---|
689 | { |
---|
690 | // remaining arguments must be keyword/value pairs |
---|
691 | arglist.assertRemainderKeywords(); |
---|
692 | |
---|
693 | if (allowOtherKeys) |
---|
694 | return array; |
---|
695 | |
---|
696 | LispObject allowOtherKeysValue = |
---|
697 | arglist.findKeywordArg(Keyword.ALLOW_OTHER_KEYS, null); |
---|
698 | |
---|
699 | if (allowOtherKeysValue == NIL) { |
---|
700 | // the argument is there. |
---|
701 | LispObject key = arglist.consume(); |
---|
702 | arglist.consume(); |
---|
703 | |
---|
704 | if (key != Keyword.ALLOW_OTHER_KEYS) |
---|
705 | error(new ProgramError("Invalid keyword argument " + key.printObject())); |
---|
706 | |
---|
707 | allowOtherKeysValue = null; |
---|
708 | } |
---|
709 | |
---|
710 | if (allowOtherKeysValue != null) |
---|
711 | return array; |
---|
712 | |
---|
713 | } |
---|
714 | if (!arglist.consumed()) |
---|
715 | { |
---|
716 | if (restVar == null) |
---|
717 | error(new WrongNumberOfArgumentsException(function)); |
---|
718 | } |
---|
719 | return array; |
---|
720 | } |
---|
721 | } |
---|
722 | |
---|
723 | /** Function which creates initform instances. |
---|
724 | * |
---|
725 | * @param form |
---|
726 | * @return Either a ConstantInitform or NonConstantInitForm instance |
---|
727 | */ |
---|
728 | private static InitForm createInitForm(LispObject form) { |
---|
729 | if (form.constantp()) |
---|
730 | { |
---|
731 | if (form instanceof Symbol) |
---|
732 | return new ConstantInitForm(form.getSymbolValue()); |
---|
733 | if (form instanceof Cons) |
---|
734 | { |
---|
735 | Debug.assertTrue(form.car() == Symbol.QUOTE); |
---|
736 | return new ConstantInitForm(form.cadr()); |
---|
737 | } |
---|
738 | return new ConstantInitForm(form); |
---|
739 | } |
---|
740 | return new NonConstantInitForm(form); |
---|
741 | } |
---|
742 | |
---|
743 | /** Class to be passed around, allowing arguments to be 'consumed' from it. */ |
---|
744 | final private static class ArgList { |
---|
745 | final LispObject[] args; |
---|
746 | int argsConsumed = 0; |
---|
747 | final int len; |
---|
748 | final Environment env; |
---|
749 | |
---|
750 | ArgList(Environment environment, LispObject[] args) { |
---|
751 | this.args = args; |
---|
752 | len = args.length; |
---|
753 | env = environment; |
---|
754 | } |
---|
755 | |
---|
756 | /** Asserts the number of remaining arguments is even. */ |
---|
757 | void assertRemainderKeywords() { |
---|
758 | if (((len - argsConsumed) & 1) == 1) |
---|
759 | error(new ProgramError("Odd number of keyword arguments.")); |
---|
760 | } |
---|
761 | |
---|
762 | /** Returns the next unconsumed value from the argument set, or 'null' |
---|
763 | * if all arguments have been consumed. */ |
---|
764 | LispObject consume() { |
---|
765 | return (argsConsumed < len) ? args[argsConsumed++] : null; |
---|
766 | } |
---|
767 | |
---|
768 | /** Returns 'true' if all arguments have been consumed, false otherwise. */ |
---|
769 | boolean consumed() { |
---|
770 | return (len == argsConsumed); |
---|
771 | } |
---|
772 | |
---|
773 | /** Returns the value associated with 'keyword', or 'def' if the keyword |
---|
774 | * isn't in the remaining arguments. Assumes the remainder is a valid property list. */ |
---|
775 | LispObject findKeywordArg(Symbol keyword, LispObject def) { |
---|
776 | int i = argsConsumed; |
---|
777 | while (i < len) |
---|
778 | { |
---|
779 | if (args[i] == keyword) |
---|
780 | return args[i+1]; |
---|
781 | i += 2; |
---|
782 | } |
---|
783 | return def; |
---|
784 | } |
---|
785 | |
---|
786 | Environment getEnvironment() { |
---|
787 | // ### here to satisfy the need of the EnvironmentParam, but this |
---|
788 | // is a slight abuse of the abstraction. Don't want to solve more complex, |
---|
789 | // but don't really like it this way... |
---|
790 | return env; |
---|
791 | } |
---|
792 | |
---|
793 | /** Returns a list of all values not consumed so far. */ |
---|
794 | LispObject rest() { |
---|
795 | LispObject rest = NIL; |
---|
796 | for (int j = len; j-- > argsConsumed;) |
---|
797 | rest = new Cons(args[j], rest); |
---|
798 | |
---|
799 | return rest; |
---|
800 | } |
---|
801 | } |
---|
802 | |
---|
803 | /** Abstract parent of the classes used to represent the different argument types: |
---|
804 | * |
---|
805 | * - EnvironmentParam |
---|
806 | * - RequiredParam |
---|
807 | * - OptionalParam |
---|
808 | * - RestParam |
---|
809 | * - KeywordParam |
---|
810 | * - AuxParam |
---|
811 | * */ |
---|
812 | public static abstract class Param { |
---|
813 | |
---|
814 | /** Assigns values to be bound to the correcsponding variables to the |
---|
815 | * array, using 'index' as the next free slot, consuming any required |
---|
816 | * values from 'args'. Uses 'ext' both as the evaluation environment |
---|
817 | * for initforms. |
---|
818 | * |
---|
819 | * The environment 'ext' is prepared for evaluating any initforms of |
---|
820 | * further arguments by binding the variables to their values in it. |
---|
821 | * |
---|
822 | * The environment 'ext' may be null, indicating none of the arguments |
---|
823 | * need an evaluation environment. No attempt should be made to bind |
---|
824 | * any variables in this case. |
---|
825 | * |
---|
826 | * Returns the index of the next-unused slot in the 'array'. |
---|
827 | */ |
---|
828 | abstract int assign(int index, LispObject[] array, ArgList args, |
---|
829 | Environment ext, LispThread thread); |
---|
830 | |
---|
831 | /** Returns 'true' if the parameter requires an evaluation environment |
---|
832 | * in order to be able to determine the value of its initform. */ |
---|
833 | boolean needsEnvironment() { return false; } |
---|
834 | |
---|
835 | /** Adds the variables to be bound to 'vars' in the same order as they |
---|
836 | * will be assigned to the output array by the 'assign' method. */ |
---|
837 | abstract void addVars(List vars); |
---|
838 | } |
---|
839 | |
---|
840 | |
---|
841 | /** Abstract super class representing initforms. */ |
---|
842 | private static abstract class InitForm { |
---|
843 | abstract LispObject getValue(Environment ext, LispThread thread); |
---|
844 | boolean needsEnvironment() { return false; } |
---|
845 | } |
---|
846 | |
---|
847 | /** Constant init forms will be represented using this class. */ |
---|
848 | private static class ConstantInitForm extends InitForm { |
---|
849 | LispObject value; |
---|
850 | |
---|
851 | ConstantInitForm(LispObject value) { |
---|
852 | this.value = value; |
---|
853 | } |
---|
854 | |
---|
855 | LispObject getValue(Environment ext, LispThread thread) { |
---|
856 | return value; |
---|
857 | } |
---|
858 | } |
---|
859 | |
---|
860 | |
---|
861 | /** Non-constant initforms will be represented using this class. |
---|
862 | * Callers need to know these need an evaluation environment. */ |
---|
863 | private static class NonConstantInitForm extends InitForm { |
---|
864 | LispObject form; |
---|
865 | |
---|
866 | NonConstantInitForm(LispObject form) { |
---|
867 | this.form = form; |
---|
868 | } |
---|
869 | |
---|
870 | LispObject getValue(Environment ext, LispThread thread) { |
---|
871 | return eval(form, ext, thread); |
---|
872 | } |
---|
873 | |
---|
874 | @Override |
---|
875 | boolean needsEnvironment() { return true; } |
---|
876 | } |
---|
877 | |
---|
878 | /** Class used to match &environment arguments */ |
---|
879 | private static class EnvironmentParam extends Param { |
---|
880 | Symbol var; |
---|
881 | boolean special; |
---|
882 | |
---|
883 | EnvironmentParam(Symbol var, boolean special) { |
---|
884 | this.var = var; |
---|
885 | this.special = special; |
---|
886 | } |
---|
887 | |
---|
888 | @Override |
---|
889 | void addVars(List vars) { |
---|
890 | vars.add(var); |
---|
891 | } |
---|
892 | |
---|
893 | @Override |
---|
894 | int assign(int index, LispObject[] array, ArgList args, Environment ext, LispThread thread) { |
---|
895 | array[index++] = args.getEnvironment(); |
---|
896 | if (ext != null) |
---|
897 | bindArg(special, var, args.getEnvironment(), ext, thread); |
---|
898 | |
---|
899 | return index; |
---|
900 | } |
---|
901 | } |
---|
902 | |
---|
903 | |
---|
904 | /** Class used to match required parameters */ |
---|
905 | public static class RequiredParam extends Param { |
---|
906 | Symbol var; |
---|
907 | boolean special; |
---|
908 | |
---|
909 | // Used above to create anonymous required parameters |
---|
910 | public RequiredParam() { |
---|
911 | this(T, false); |
---|
912 | } |
---|
913 | |
---|
914 | public RequiredParam(Symbol var, boolean special) { |
---|
915 | this.var = var; |
---|
916 | this.special = special; |
---|
917 | } |
---|
918 | |
---|
919 | @Override |
---|
920 | int assign(int index, LispObject[] array, ArgList args, |
---|
921 | Environment ext, LispThread thread) { |
---|
922 | LispObject value = args.consume(); |
---|
923 | if (ext != null) |
---|
924 | bindArg(special, var, value, ext, thread); |
---|
925 | array[index++] = value; |
---|
926 | return index; |
---|
927 | } |
---|
928 | |
---|
929 | void addVars(List vars) { |
---|
930 | vars.add(var); |
---|
931 | } |
---|
932 | } |
---|
933 | |
---|
934 | /** Class used to match optional parameters, or, if not provided, |
---|
935 | * evaluate the initform. Also assigns the 'supplied-p' parameter if requested. */ |
---|
936 | public static class OptionalParam extends Param { |
---|
937 | Symbol var; |
---|
938 | boolean special; |
---|
939 | Symbol suppliedVar; |
---|
940 | boolean suppliedSpecial; |
---|
941 | InitForm initForm; |
---|
942 | |
---|
943 | public OptionalParam(boolean suppliedVar, LispObject form) { |
---|
944 | this(T, false, suppliedVar ? T : null, false, form); |
---|
945 | } |
---|
946 | |
---|
947 | public OptionalParam(Symbol var, boolean special, |
---|
948 | Symbol suppliedVar, boolean suppliedSpecial, |
---|
949 | LispObject form) { |
---|
950 | this.var = var; |
---|
951 | this.special = special; |
---|
952 | |
---|
953 | this.suppliedVar = suppliedVar; |
---|
954 | this.suppliedSpecial = suppliedSpecial; |
---|
955 | |
---|
956 | initForm = createInitForm(form); |
---|
957 | } |
---|
958 | |
---|
959 | @Override |
---|
960 | int assign(int index, LispObject[] array, ArgList args, |
---|
961 | Environment ext, LispThread thread) { |
---|
962 | LispObject value = args.consume(); |
---|
963 | |
---|
964 | return assign(index, array, value, ext, thread); |
---|
965 | } |
---|
966 | |
---|
967 | int assign(int index, LispObject[] array, LispObject value, |
---|
968 | Environment ext, LispThread thread) { |
---|
969 | if (value == null) { |
---|
970 | value = array[index++] = initForm.getValue(ext, thread); |
---|
971 | if (suppliedVar != null) |
---|
972 | array[index++] = NIL; |
---|
973 | } else { |
---|
974 | array[index++] = value; |
---|
975 | if (suppliedVar != null) |
---|
976 | array[index++] = T; |
---|
977 | } |
---|
978 | |
---|
979 | if (ext != null) { |
---|
980 | bindArg(special, var, value, ext, thread); |
---|
981 | if (suppliedVar != null) |
---|
982 | bindArg(suppliedSpecial, suppliedVar, array[index-1], ext, thread); |
---|
983 | } |
---|
984 | |
---|
985 | return index; |
---|
986 | } |
---|
987 | |
---|
988 | |
---|
989 | @Override |
---|
990 | boolean needsEnvironment() { |
---|
991 | return initForm.needsEnvironment(); |
---|
992 | } |
---|
993 | |
---|
994 | void addVars(List vars) { |
---|
995 | vars.add(var); |
---|
996 | if (suppliedVar != null) |
---|
997 | vars.add(suppliedVar); |
---|
998 | } |
---|
999 | } |
---|
1000 | |
---|
1001 | |
---|
1002 | /** Class used to model the &rest parameter */ |
---|
1003 | private static class RestParam extends Param { |
---|
1004 | Symbol var; |
---|
1005 | boolean special; |
---|
1006 | |
---|
1007 | RestParam(Symbol var, boolean special) { |
---|
1008 | this.var = var; |
---|
1009 | this.special = special; |
---|
1010 | } |
---|
1011 | |
---|
1012 | @Override |
---|
1013 | int assign(int index, LispObject[] array, ArgList args, |
---|
1014 | Environment ext, LispThread thread) { |
---|
1015 | array[index++] = args.rest(); |
---|
1016 | |
---|
1017 | if (ext != null) |
---|
1018 | bindArg(special, var, array[index-1], ext, thread); |
---|
1019 | |
---|
1020 | return index; |
---|
1021 | } |
---|
1022 | |
---|
1023 | @Override |
---|
1024 | void addVars(List vars) { |
---|
1025 | vars.add(var); |
---|
1026 | } |
---|
1027 | } |
---|
1028 | |
---|
1029 | /** Class used to represent optional parameters and their initforms */ |
---|
1030 | public static class KeywordParam extends OptionalParam { |
---|
1031 | public Symbol keyword; |
---|
1032 | |
---|
1033 | public KeywordParam(boolean suppliedVar, LispObject form, Symbol keyword) { |
---|
1034 | this(T, false, suppliedVar ? T : null, false, form, keyword); |
---|
1035 | } |
---|
1036 | |
---|
1037 | public KeywordParam(Symbol var, boolean special, |
---|
1038 | Symbol suppliedVar, boolean suppliedSpecial, |
---|
1039 | LispObject form, Symbol keyword) { |
---|
1040 | super(var, special, suppliedVar, suppliedSpecial, form); |
---|
1041 | |
---|
1042 | this.keyword = (keyword == null) |
---|
1043 | ? PACKAGE_KEYWORD.intern(var.getName()) : keyword; |
---|
1044 | } |
---|
1045 | |
---|
1046 | @Override |
---|
1047 | int assign(int index, LispObject[] array, ArgList args, |
---|
1048 | Environment ext, LispThread thread) { |
---|
1049 | return super.assign(index, array, args.findKeywordArg(keyword, null), |
---|
1050 | ext, thread); |
---|
1051 | } |
---|
1052 | } |
---|
1053 | |
---|
1054 | |
---|
1055 | /** Class used to represent &aux parameters and their initforms */ |
---|
1056 | private static class AuxParam extends Param { |
---|
1057 | Symbol var; |
---|
1058 | boolean special; |
---|
1059 | InitForm initform; |
---|
1060 | |
---|
1061 | AuxParam(Symbol var, boolean special, LispObject form) { |
---|
1062 | this.var = var; |
---|
1063 | this.special = special; |
---|
1064 | initform = createInitForm(form); |
---|
1065 | } |
---|
1066 | |
---|
1067 | @Override |
---|
1068 | void addVars(List vars) { |
---|
1069 | vars.add(var); |
---|
1070 | } |
---|
1071 | |
---|
1072 | @Override |
---|
1073 | int assign(int index, LispObject[] array, ArgList args, Environment ext, LispThread thread) { |
---|
1074 | array[index++] = initform.getValue(ext, thread); |
---|
1075 | |
---|
1076 | if (ext != null) |
---|
1077 | bindArg(special, var, array[index-1], ext, thread); |
---|
1078 | |
---|
1079 | return index; |
---|
1080 | } |
---|
1081 | |
---|
1082 | @Override |
---|
1083 | boolean needsEnvironment() { |
---|
1084 | return initform.needsEnvironment(); |
---|
1085 | } |
---|
1086 | |
---|
1087 | } |
---|
1088 | } |
---|