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 */ ArgumentListProcessor(Operator fun, int requiredCount, OptionalParam[] optional, KeywordParam[] keyword, boolean key, boolean moreKeys, Symbol rest)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 */ ArgumentListProcessor(Operator fun, LispObject lambdaList, LispObject specials, LambdaListType type)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 setFunction(Operator fun)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 */ match(LispObject[] args, Environment _environment, Environment env, LispThread thread)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 */ bindVars(LispObject[] values, Environment env, LispThread thread)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 freeSpecials(LispObject specials)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 getArity()527 public int getArity() { 528 return arity; 529 } 530 getMinArgs()531 public int getMinArgs() { 532 return minArgs; 533 } 534 getMaxArgs()535 public int getMaxArgs() { 536 return maxArgs; 537 } 538 getVariables()539 public Symbol[] getVariables() { 540 return variables; 541 } 542 invalidParameter(LispObject obj)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 extractVariables()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 { match(LispObject[] args, Environment _environment, Environment env, LispThread thread)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 { _match(LispObject[] args, Environment _environment, Environment env, LispThread thread)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 match(LispObject[] args, Environment _environment, Environment env, LispThread thread)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 match(LispObject[] args, Environment _environment, Environment env, LispThread thread)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 */ createInitForm(LispObject form)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 ArgList(Environment environment, LispObject[] args)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. */ assertRemainderKeywords()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. */ consume()760 LispObject consume() { 761 return (argsConsumed < len) ? args[argsConsumed++] : null; 762 } 763 764 /** Returns 'true' if all arguments have been consumed, false otherwise. */ consumed()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. */ findKeywordArg(Symbol keyword, LispObject def)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 getEnvironment()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. */ rest()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 */ assign(int index, LispObject[] array, ArgList args, Environment ext, LispThread thread)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. */ needsEnvironment()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. */ addVars(List vars)833 abstract void addVars(List vars); 834 } 835 836 837 /** Abstract super class representing initforms. */ 838 private static abstract class InitForm { getValue(Environment ext, LispThread thread)839 abstract LispObject getValue(Environment ext, LispThread thread); needsEnvironment()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 ConstantInitForm(LispObject value)847 ConstantInitForm(LispObject value) { 848 this.value = value; 849 } 850 getValue(Environment ext, LispThread thread)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 NonConstantInitForm(LispObject form)862 NonConstantInitForm(LispObject form) { 863 this.form = form; 864 } 865 getValue(Environment ext, LispThread thread)866 LispObject getValue(Environment ext, LispThread thread) { 867 return eval(form, ext, thread); 868 } 869 870 @Override needsEnvironment()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 EnvironmentParam(Symbol var, boolean special)879 EnvironmentParam(Symbol var, boolean special) { 880 this.var = var; 881 this.special = special; 882 } 883 884 @Override addVars(List vars)885 void addVars(List vars) { 886 vars.add(var); 887 } 888 889 @Override assign(int index, LispObject[] array, ArgList args, Environment ext, LispThread thread)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 RequiredParam()906 public RequiredParam() { 907 this(T, false); 908 } 909 RequiredParam(Symbol var, boolean special)910 public RequiredParam(Symbol var, boolean special) { 911 this.var = var; 912 this.special = special; 913 } 914 915 @Override assign(int index, LispObject[] array, ArgList args, Environment ext, LispThread thread)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 addVars(List vars)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 OptionalParam(boolean suppliedVar, LispObject form)939 public OptionalParam(boolean suppliedVar, LispObject form) { 940 this(T, false, suppliedVar ? T : null, false, form); 941 } 942 OptionalParam(Symbol var, boolean special, Symbol suppliedVar, boolean suppliedSpecial, LispObject form)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 assign(int index, LispObject[] array, ArgList args, Environment ext, LispThread thread)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 assign(int index, LispObject[] array, LispObject value, Environment ext, LispThread thread)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 needsEnvironment()986 boolean needsEnvironment() { 987 return initForm.needsEnvironment(); 988 } 989 addVars(List vars)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 RestParam(Symbol var, boolean special)1003 RestParam(Symbol var, boolean special) { 1004 this.var = var; 1005 this.special = special; 1006 } 1007 1008 @Override assign(int index, LispObject[] array, ArgList args, Environment ext, LispThread thread)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 addVars(List vars)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 KeywordParam(boolean suppliedVar, LispObject form, Symbol keyword)1029 public KeywordParam(boolean suppliedVar, LispObject form, Symbol keyword) { 1030 this(T, false, suppliedVar ? T : null, false, form, keyword); 1031 } 1032 KeywordParam(Symbol var, boolean special, Symbol suppliedVar, boolean suppliedSpecial, LispObject form, Symbol keyword)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 assign(int index, LispObject[] array, ArgList args, Environment ext, LispThread thread)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 AuxParam(Symbol var, boolean special, LispObject form)1057 AuxParam(Symbol var, boolean special, LispObject form) { 1058 this.var = var; 1059 this.special = special; 1060 initform = createInitForm(form); 1061 } 1062 1063 @Override addVars(List vars)1064 void addVars(List vars) { 1065 vars.add(var); 1066 } 1067 1068 @Override assign(int index, LispObject[] array, ArgList args, Environment ext, LispThread thread)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 needsEnvironment()1079 boolean needsEnvironment() { 1080 return initform.needsEnvironment(); 1081 } 1082 1083 } 1084 } 1085