source: branches/1.1.x/src/org/armedbear/lisp/ArgumentListProcessor.java

Last change on this file was 14131, checked in by ehuelsmann, 12 years ago

Close #219: lambda list keyword checking too lenient for ANSI.

Note: This introduces a new argument to the FUNCTION special form

(LAMBDA and NAMED-LAMBDA were already supported)
(FUNCTION (MACRO-FUNCTION ...))

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 37.1 KB
Line 
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
35package org.armedbear.lisp;
36
37import java.util.List;
38import java.util.ArrayList;
39import 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 */
46public 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}
Note: See TracBrowser for help on using the repository browser.