source: trunk/abcl/src/org/armedbear/lisp/ArgumentListProcessor.java

Last change on this file was 15362, checked in by Mark Evenson, 4 years ago

Refined serialization of local functions and closures (still doesn't work for compiled closures)

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 36.9 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.io.Serializable;
38import java.util.List;
39import java.util.ArrayList;
40import 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 */
47public 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}
Note: See TracBrowser for help on using the repository browser.