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