source: branches/streams/abcl/src/org/armedbear/lisp/ArgumentListProcessor.java

Last change on this file was 14465, checked in by rschlatte, 12 years ago

new method program_error, analogous to type_error

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