source: branches/0.20.x/abcl/src/org/armedbear/lisp/Closure.java

Last change on this file was 12513, checked in by ehuelsmann, 15 years ago

Remove 'private' keyword to eliminate the Java requirement

for the compiler to generate synthetic accessors: functions that
don't appear in the source but do appear in the class file.

Patch by: Douglas Miles <dmiles _at_ users.sf.net>

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 36.6 KB
Line 
1/*
2 * Closure.java
3 *
4 * Copyright (C) 2002-2008 Peter Graves
5 * Copyright (C) 2008 Ville Voutilainen
6 * $Id: Closure.java 12513 2010-03-02 22:35:36Z ehuelsmann $
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., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, 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 static org.armedbear.lisp.Lisp.*;
38
39import java.util.ArrayList;
40
41public class Closure extends Function
42{
43  // Parameter types.
44  public static final int REQUIRED = 0;
45  public static final int OPTIONAL = 1;
46  public static final int KEYWORD  = 2;
47  public static final int REST     = 3;
48  public static final int AUX      = 4;
49
50  // States.
51  private static final int STATE_REQUIRED = 0;
52  private static final int STATE_OPTIONAL = 1;
53  private static final int STATE_KEYWORD  = 2;
54  private static final int STATE_REST     = 3;
55  private static final int STATE_AUX      = 4;
56
57  private Parameter[] requiredParameters = new Parameter[0];
58  private Parameter[] optionalParameters = requiredParameters;
59  private Parameter[] keywordParameters = requiredParameters;
60  private Parameter[] auxVars = requiredParameters;
61  private final LispObject body;
62  private final LispObject executionBody;
63  private final Environment environment;
64  private final boolean andKey;
65  private final boolean allowOtherKeys;
66  private Symbol restVar;
67  private Symbol envVar;
68  private int arity;
69
70  private int minArgs;
71  private int maxArgs;
72
73  private Symbol[] variables = new Symbol[0];
74  private LispObject specials = NIL;
75
76  private boolean bindInitForms;
77
78
79    /** Construct a closure object with a lambda-list described
80     * by these parameters.
81     *
82     *
83     * @param required Required parameters or an empty array for none
84     * @param optional Optional parameters or an empty array for none
85     * @param keyword Keyword parameters or an empty array for none
86     * @param keys NIL if the lambda-list doesn't contain &amp;key, T otherwise
87     * @param rest the &amp;rest parameter, or NIL if none
88     * @param moreKeys NIL if &amp;allow-other-keys not present, T otherwise
89     */
90  public Closure(Parameter[] required,
91                 Parameter[] optional,
92                 Parameter[] keyword,
93                 Symbol keys, Symbol rest, Symbol moreKeys) {
94      minArgs = required.length;
95      maxArgs = (rest == NIL && moreKeys == NIL)
96          ? minArgs + optional.length + 2*keyword.length : -1;
97
98      arity = (rest == NIL && moreKeys == NIL && keys == NIL
99               && optional.length == 0)
100          ? maxArgs : -1;
101
102      requiredParameters = required;
103      optionalParameters = optional;
104      keywordParameters = keyword;
105
106      if (rest != NIL)
107        restVar = rest;
108
109      andKey = keys != NIL;
110      allowOtherKeys = moreKeys != NIL;
111      variables = processVariables();
112      bindInitForms = false;
113
114      // stuff we don't need: we're a compiled function
115      body = null;
116      executionBody = null;
117      environment = null;
118  }
119
120
121  public Closure(LispObject lambdaExpression, Environment env)
122  {
123    this(null, lambdaExpression, env);
124  }
125
126  public Closure(final LispObject name, final LispObject lambdaExpression,
127                 final Environment env)
128
129  {
130    super(name, lambdaExpression.cadr());
131    final LispObject lambdaList = lambdaExpression.cadr();
132    setLambdaList(lambdaList);
133    if (!(lambdaList == NIL || lambdaList instanceof Cons))
134      error(new ProgramError("The lambda list " + lambdaList.writeToString() +
135                           " is invalid."));
136    boolean _andKey = false;
137    boolean _allowOtherKeys = false;
138    if (lambdaList instanceof Cons)
139      {
140        final int length = lambdaList.length();
141        ArrayList<Parameter> required = null;
142        ArrayList<Parameter> optional = null;
143        ArrayList<Parameter> keywords = null;
144        ArrayList<Parameter> aux = null;
145        int state = STATE_REQUIRED;
146        LispObject remaining = lambdaList;
147        while (remaining != NIL)
148          {
149            LispObject obj = remaining.car();
150            if (obj instanceof Symbol)
151              {
152                if (state == STATE_AUX)
153                  {
154                    if (aux == null)
155                      aux = new ArrayList<Parameter>();
156                    aux.add(new Parameter((Symbol)obj, NIL, AUX));
157                  }
158                else if (obj == Symbol.AND_OPTIONAL)
159                  {
160                    state = STATE_OPTIONAL;
161                    arity = -1;
162                  }
163                else if (obj == Symbol.AND_REST || obj == Symbol.AND_BODY)
164                  {
165                    state = STATE_REST;
166                    arity = -1;
167                    maxArgs = -1;
168                    remaining = remaining.cdr();
169                    if (remaining == NIL)
170                      {
171                        error(new ProgramError(
172                          "&REST/&BODY must be followed by a variable."));
173                      }
174                    if (restVar != null) 
175                      {
176                        error(new ProgramError(
177                          "&REST/&BODY may occur only once."));
178                      }
179                    final LispObject remainingcar =  remaining.car();
180                    if (remainingcar instanceof Symbol)
181                      {
182                        restVar = (Symbol) remainingcar;
183                      }
184                    else
185                      {
186                        error(new ProgramError(
187                          "&REST/&BODY must be followed by a variable."));
188                      }
189                  }
190                else if (obj == Symbol.AND_ENVIRONMENT)
191                  {
192                    remaining = remaining.cdr();
193                    envVar = (Symbol) remaining.car();
194                    arity = -1; // FIXME
195                  }
196                else if (obj == Symbol.AND_KEY)
197                  {
198                    state = STATE_KEYWORD;
199                    _andKey = true;
200                    arity = -1;
201                  }
202                else if (obj == Symbol.AND_ALLOW_OTHER_KEYS)
203                  {
204                    _allowOtherKeys = true;
205                    maxArgs = -1;
206                  }
207                else if (obj == Symbol.AND_AUX)
208                  {
209                    // All remaining specifiers are aux variable specifiers.
210                    state = STATE_AUX;
211                    arity = -1; // FIXME
212                  }
213                else
214                  {
215                    if (state == STATE_OPTIONAL)
216                      {
217                        if (optional == null)
218                          optional = new ArrayList<Parameter>();
219                        optional.add(new Parameter((Symbol)obj, NIL, OPTIONAL));
220                        if (maxArgs >= 0)
221                          ++maxArgs;
222                      }
223                    else if (state == STATE_KEYWORD)
224                      {
225                        if (keywords == null)
226                          keywords = new ArrayList<Parameter>();
227                        keywords.add(new Parameter((Symbol)obj, NIL, KEYWORD));
228                        if (maxArgs >= 0)
229                          maxArgs += 2;
230                      }
231                    else
232                      {
233                        if (state != STATE_REQUIRED)
234                          {
235                            error(new ProgramError(
236                              "required parameters cannot appear after &REST/&BODY."));
237                          }
238                        if (required == null)
239                          required = new ArrayList<Parameter>();
240                        required.add(new Parameter((Symbol)obj));
241                        if (maxArgs >= 0)
242                          ++maxArgs;
243                      }
244                  }
245              }
246            else if (obj instanceof Cons)
247              {
248                if (state == STATE_AUX)
249                  {
250                    Symbol sym = checkSymbol(obj.car());
251                    LispObject initForm = obj.cadr();
252                    Debug.assertTrue(initForm != null);
253                    if (aux == null)
254                      aux = new ArrayList<Parameter>();
255                    aux.add(new Parameter(sym, initForm, AUX));
256                  }
257                else if (state == STATE_OPTIONAL)
258                  {
259                    Symbol sym = checkSymbol(obj.car());
260                    LispObject initForm = obj.cadr();
261                    LispObject svar = obj.cdr().cdr().car();
262                    if (optional == null)
263                      optional = new ArrayList<Parameter>();
264                    optional.add(new Parameter(sym, initForm, svar, OPTIONAL));
265                    if (maxArgs >= 0)
266                      ++maxArgs;
267                  }
268                else if (state == STATE_KEYWORD)
269                  {
270                    Symbol keyword;
271                    Symbol var;
272                    LispObject initForm = NIL;
273                    LispObject svar = NIL;
274                    LispObject first = obj.car();
275                    if (first instanceof Cons)
276                      {
277                        keyword = checkSymbol(first.car());
278                        var = checkSymbol(first.cadr());
279                      }
280                    else
281                      {
282                        var = checkSymbol(first);
283                        keyword =
284                          PACKAGE_KEYWORD.intern(var.name);
285                      }
286                    obj = obj.cdr();
287                    if (obj != NIL)
288                      {
289                        initForm = obj.car();
290                        obj = obj.cdr();
291                        if (obj != NIL)
292                          svar = obj.car();
293                      }
294                    if (keywords == null)
295                      keywords = new ArrayList<Parameter>();
296                    keywords.add(new Parameter(keyword, var, initForm, svar));
297                    if (maxArgs >= 0)
298                      maxArgs += 2;
299                  }
300                else
301                  invalidParameter(obj);
302              }
303            else
304              invalidParameter(obj);
305            remaining = remaining.cdr();
306          }
307        if (arity == 0)
308          arity = length;
309        if (required != null)
310          {
311            requiredParameters = new Parameter[required.size()];
312            required.toArray(requiredParameters);
313          }
314        if (optional != null)
315          {
316            optionalParameters = new Parameter[optional.size()];
317            optional.toArray(optionalParameters);
318          }
319        if (keywords != null)
320          {
321            keywordParameters = new Parameter[keywords.size()];
322            keywords.toArray(keywordParameters);
323          }
324        if (aux != null)
325          {
326            auxVars = new Parameter[aux.size()];
327            aux.toArray(auxVars);
328          }
329      }
330    else
331      {
332        // Lambda list is empty.
333        Debug.assertTrue(lambdaList == NIL);
334        arity = 0;
335        maxArgs = 0;
336      }
337    this.body = lambdaExpression.cddr();
338    LispObject bodyAndDecls = parseBody(this.body, false);
339    this.executionBody = bodyAndDecls.car();
340    this.specials = parseSpecials(bodyAndDecls.NTH(1));
341
342    this.environment = env;
343    this.andKey = _andKey;
344    this.allowOtherKeys = _allowOtherKeys;
345    minArgs = requiredParameters.length;
346    if (arity >= 0)
347      Debug.assertTrue(arity == minArgs);
348    variables = processVariables();
349  }
350
351  private final void processParameters(ArrayList<Symbol> vars,
352                                       final Parameter[] parameters)
353  {
354    for (Parameter parameter : parameters)
355      {
356        vars.add(parameter.var);
357        if (parameter.svar != NIL)
358          vars.add((Symbol)parameter.svar);
359        if (!bindInitForms)
360          if (!parameter.initForm.constantp())
361            bindInitForms = true;
362      }
363  }
364
365  // Also sets bindInitForms.
366  private final Symbol[] processVariables()
367  {
368    ArrayList<Symbol> vars = new ArrayList<Symbol>();
369    for (Parameter parameter : requiredParameters)
370      vars.add(parameter.var);
371    processParameters(vars, optionalParameters);
372    if (restVar != null)
373      {
374        vars.add(restVar);
375      }
376    processParameters(vars, keywordParameters);
377    Symbol[] array = new Symbol[vars.size()];
378    vars.toArray(array);
379    return array;
380  }
381
382  private static final void invalidParameter(LispObject obj)
383
384  {
385    error(new ProgramError(obj.writeToString() +
386                         " may not be used as a variable in a lambda list."));
387  }
388
389  @Override
390  public LispObject typep(LispObject typeSpecifier)
391  {
392    if (typeSpecifier == Symbol.COMPILED_FUNCTION)
393      return NIL;
394    return super.typep(typeSpecifier);
395  }
396
397  public final LispObject getVariableList()
398  {
399    LispObject result = NIL;
400    for (int i = variables.length; i-- > 0;)
401      result = new Cons(variables[i], result);
402    return result;
403  }
404
405  // Returns body as a list.
406  public final LispObject getBody()
407  {
408    return body;
409  }
410
411  public final Environment getEnvironment()
412  {
413    return environment;
414  }
415
416  @Override
417  public LispObject execute()
418  {
419    if (arity == 0)
420      {
421        return progn(executionBody, environment, 
422                     LispThread.currentThread());
423      }
424    else
425      return execute(new LispObject[0]);
426  }
427   
428  private final LispObject bindParametersAndExecute(LispObject... objects)
429
430  {
431    final LispThread thread = LispThread.currentThread();
432    final SpecialBindingsMark mark = thread.markSpecialBindings();
433    Environment ext = new Environment(environment);
434    bindRequiredParameters(ext, thread, objects);
435    if (arity != minArgs)
436      {
437        bindParameterDefaults(optionalParameters, ext, thread);
438        if (restVar != null)
439          bindArg(specials, restVar, NIL, ext, thread);
440        bindParameterDefaults(keywordParameters, ext, thread);
441      }
442    bindAuxVars(ext, thread);
443    declareFreeSpecials(ext);
444    try
445      {
446        return progn(executionBody, ext, thread);
447      }
448    finally
449      {
450        thread.resetSpecialBindings(mark);
451      }
452  }
453
454  private final void bindRequiredParameters(Environment ext,
455                                            LispThread thread,
456                                            LispObject[] objects)
457
458  {
459    // &whole and &environment before anything
460    if (envVar != null)
461      bindArg(specials, envVar, environment, ext, thread);
462    for (int i = 0; i < objects.length; ++i)
463      {
464        bindArg(specials, requiredParameters[i].var, objects[i], ext, thread);
465      }
466  }
467
468  public final LispObject invokeArrayExecute(LispObject... objects)
469
470  {
471    return execute(objects);
472  }
473
474  @Override
475  public LispObject execute(LispObject arg)
476  {
477    if (minArgs == 1)
478      {
479        return bindParametersAndExecute(arg);
480      }
481    else
482      {
483        return invokeArrayExecute(arg);
484      }
485  }
486
487  @Override
488  public LispObject execute(LispObject first, LispObject second)
489
490  {
491    if (minArgs == 2)
492      {
493        return bindParametersAndExecute(first, second);
494      }
495    else
496      {
497        return invokeArrayExecute(first, second);
498      }
499  }
500
501  @Override
502  public LispObject execute(LispObject first, LispObject second,
503                            LispObject third)
504
505  {
506    if (minArgs == 3)
507      {
508        return bindParametersAndExecute(first, second, third);
509      }
510    else
511      {
512        return invokeArrayExecute(first, second, third);
513      }
514  }
515
516  @Override
517  public LispObject execute(LispObject first, LispObject second,
518                            LispObject third, LispObject fourth)
519
520  {
521    if (minArgs == 4)
522      {
523        return bindParametersAndExecute(first, second, third, fourth);
524      }
525    else
526      {
527        return invokeArrayExecute(first, second, third, fourth);
528      }
529  }
530
531  @Override
532  public LispObject execute(LispObject first, LispObject second,
533                            LispObject third, LispObject fourth,
534                            LispObject fifth)
535
536  {
537    if (minArgs == 5)
538      {
539        return bindParametersAndExecute(first, second, third, fourth,
540                                        fifth);
541      }
542    else
543      {
544        return invokeArrayExecute(first, second, third, fourth, fifth);
545      }
546  }
547
548  @Override
549  public LispObject execute(LispObject first, LispObject second,
550                            LispObject third, LispObject fourth,
551                            LispObject fifth, LispObject sixth)
552
553  {
554    if (minArgs == 6)
555      {
556        return bindParametersAndExecute(first, second, third, fourth,
557                                        fifth, sixth);
558      }
559    else
560      {
561        return invokeArrayExecute(first, second, third, fourth, fifth,
562                                  sixth);
563      }
564  }
565
566  @Override
567  public LispObject execute(LispObject first, LispObject second,
568                            LispObject third, LispObject fourth,
569                            LispObject fifth, LispObject sixth,
570                            LispObject seventh)
571
572  {
573    if (minArgs == 7)
574      {
575        return bindParametersAndExecute(first, second, third, fourth,
576                               fifth, sixth, seventh);
577      }
578    else
579      {
580        return invokeArrayExecute(first, second, third, fourth, fifth,
581                                  sixth, seventh);
582      }
583  }
584
585  @Override
586  public LispObject execute(LispObject first, LispObject second,
587                            LispObject third, LispObject fourth,
588                            LispObject fifth, LispObject sixth,
589                            LispObject seventh, LispObject eighth)
590
591  {
592    if (minArgs == 8)
593      {
594        return bindParametersAndExecute(first, second, third, fourth,
595                               fifth, sixth, seventh, eighth);
596      }
597    else
598      {
599        return invokeArrayExecute(first, second, third, fourth, fifth,
600                                  sixth, seventh, eighth);
601      }
602  }
603
604  private final void declareFreeSpecials(Environment ext)
605
606  {
607    LispObject s = specials;
608    special:
609    while (s != NIL) {
610      Symbol special = (Symbol)s.car();
611      s = s.cdr();
612      for (Symbol var : variables)
613  if (special == var)
614          continue special;
615      for (Parameter parameter : auxVars)
616        if (special == parameter.var)
617          continue special;
618      ext.declareSpecial(special);
619    }
620  }
621
622  @Override
623  public LispObject execute(LispObject[] args)
624  {
625    final LispThread thread = LispThread.currentThread();
626    final SpecialBindingsMark mark = thread.markSpecialBindings();
627    Environment ext = new Environment(environment);
628    if (optionalParameters.length == 0 && keywordParameters.length == 0)
629      args = fastProcessArgs(args);
630    else
631      args = processArgs(args, thread);
632    Debug.assertTrue(args.length == variables.length);
633    if (envVar != null)
634      {
635        bindArg(specials, envVar, environment, ext, thread);
636      }
637    for (int i = 0; i < variables.length; i++)
638      {
639        Symbol sym = variables[i];
640        bindArg(specials, sym, args[i], ext, thread);
641      }
642    bindAuxVars(ext, thread);
643    declareFreeSpecials(ext);
644    try
645      {
646        return progn(executionBody, ext, thread);
647      }
648    finally
649      {
650        thread.resetSpecialBindings(mark);
651      }
652  }
653
654  protected final LispObject[] processArgs(LispObject[] args, LispThread thread)
655
656  {
657    if (optionalParameters.length == 0 && keywordParameters.length == 0)
658      return fastProcessArgs(args);
659    final int argsLength = args.length;
660    if (arity >= 0)
661      {
662        // Fixed arity.
663        if (argsLength != arity)
664          error(new WrongNumberOfArgumentsException(this));
665        return args;
666      }
667    // Not fixed arity.
668    if (argsLength < minArgs)
669      error(new WrongNumberOfArgumentsException(this));
670    final LispObject[] array = new LispObject[variables.length];
671    int index = 0;
672    // The bindings established here (if any) are lost when this function
673    // returns. They are used only in the evaluation of initforms for
674    // optional and keyword arguments.
675    final SpecialBindingsMark mark = thread.markSpecialBindings();
676    Environment ext = new Environment(environment);
677    // Section 3.4.4: "...the &environment parameter is bound along with
678    // &whole before any other variables in the lambda list..."
679    try {
680        if (bindInitForms)
681          if (envVar != null)
682            bindArg(specials, envVar, environment, ext, thread);
683        // Required parameters.
684        for (int i = 0; i < minArgs; i++)
685          {
686            if (bindInitForms)
687              bindArg(specials, requiredParameters[i].var, args[i], ext, thread);
688            array[index++] = args[i];
689          }
690        int i = minArgs;
691        int argsUsed = minArgs;
692        // Optional parameters.
693        for (Parameter parameter : optionalParameters)
694          {
695            if (i < argsLength)
696              {
697                if (bindInitForms)
698                  bindArg(specials, parameter.var, args[i], ext, thread);
699                array[index++] = args[i];
700                ++argsUsed;
701                if (parameter.svar != NIL)
702                  {
703                    if (bindInitForms)
704                      bindArg(specials, (Symbol)parameter.svar, T, ext, thread);
705                    array[index++] = T;
706                  }
707              }
708            else
709              {
710                // We've run out of arguments.
711                LispObject value;
712                if (parameter.initVal != null)
713                  value = parameter.initVal;
714                else
715                  value = eval(parameter.initForm, ext, thread);
716                if (bindInitForms)
717                  bindArg(specials, parameter.var, value, ext, thread);
718                array[index++] = value;
719                if (parameter.svar != NIL)
720                  {
721                    if (bindInitForms)
722                      bindArg(specials, (Symbol)parameter.svar, NIL, ext, thread);
723                    array[index++] = NIL;
724                  }
725              }
726            ++i;
727          }
728        // &rest parameter.
729        if (restVar != null)
730          {
731            LispObject rest = NIL;
732            for (int j = argsLength; j-- > argsUsed;)
733              rest = new Cons(args[j], rest);
734            if (bindInitForms)
735                bindArg(specials, restVar, rest, ext, thread);
736            array[index++] = rest;
737          }
738        // Keyword parameters.
739        if (keywordParameters.length > 0)
740          {
741            int argsLeft = argsLength - argsUsed;
742            if (argsLeft == 0)
743              {
744                // No keyword arguments were supplied.
745                // Bind all keyword parameters to their defaults.
746                for (int k = 0; k < keywordParameters.length; k++)
747                  {
748                    Parameter parameter = keywordParameters[k];
749                    LispObject value;
750                    if (parameter.initVal != null)
751                      value = parameter.initVal;
752                    else
753                      value = eval(parameter.initForm, ext, thread);
754                    if (bindInitForms)
755                        bindArg(specials, parameter.var, value, ext, thread);
756                    array[index++] = value;
757                    if (parameter.svar != NIL)
758                      {
759                        if (bindInitForms)
760                            bindArg(specials, (Symbol)parameter.svar, NIL, ext, thread);
761                        array[index++] = NIL;
762                      }
763                  }
764              }
765            else
766              {
767                if ((argsLeft % 2) != 0)
768                  error(new ProgramError("Odd number of keyword arguments."));
769                LispObject allowOtherKeysValue = null;
770                for (Parameter parameter : keywordParameters)
771                  {
772                    Symbol keyword = parameter.keyword;
773                    LispObject value = null;
774                    boolean unbound = true;
775                    for (int j = argsUsed; j < argsLength; j += 2)
776                      {
777                        if (args[j] == keyword)
778                          {
779                            if (bindInitForms)
780                                bindArg(specials, parameter.var, args[j+1], ext, thread);
781                            value = array[index++] = args[j+1];
782                            if (parameter.svar != NIL)
783                              {
784                                if (bindInitForms)
785                                    bindArg(specials,(Symbol)parameter.svar, T, ext, thread);
786                                array[index++] = T;
787                              }
788                            args[j] = null;
789                            args[j+1] = null;
790                            unbound = false;
791                            break;
792                          }
793                      }
794                    if (unbound)
795                      {
796                        if (parameter.initVal != null)
797                          value = parameter.initVal;
798                        else
799                          value = eval(parameter.initForm, ext, thread);
800                        if (bindInitForms)
801                            bindArg(specials, parameter.var, value, ext, thread);
802                        array[index++] = value;
803                        if (parameter.svar != NIL)
804                          {
805                            if (bindInitForms)
806                                bindArg(specials, (Symbol)parameter.svar, NIL, ext, thread);
807                            array[index++] = NIL;
808                          }
809                      }
810                    if (keyword == Keyword.ALLOW_OTHER_KEYS)
811                      {
812                        if (allowOtherKeysValue == null)
813                          allowOtherKeysValue = value;
814                      }
815                  }
816                if (!allowOtherKeys)
817                  {
818                    if (allowOtherKeysValue == null || allowOtherKeysValue == NIL)
819                      {
820                        LispObject unrecognizedKeyword = null;
821                        for (int j = argsUsed; j < argsLength; j += 2)
822                          {
823                            LispObject keyword = args[j];
824                            if (keyword == null)
825                              continue;
826                            if (keyword == Keyword.ALLOW_OTHER_KEYS)
827                              {
828                                if (allowOtherKeysValue == null)
829                                  {
830                                    allowOtherKeysValue = args[j+1];
831                                    if (allowOtherKeysValue != NIL)
832                                      break;
833                                  }
834                                continue;
835                              }
836                            // Unused keyword argument.
837                            boolean ok = false;
838                            for (Parameter parameter : keywordParameters)
839                              {
840                                if (parameter.keyword == keyword)
841                                  {
842                                    // Found it!
843                                    ok = true;
844                                    break;
845                                  }
846                              }
847                            if (ok)
848                              continue;
849                            // Unrecognized keyword argument.
850                            if (unrecognizedKeyword == null)
851                              unrecognizedKeyword = keyword;
852                          }
853                        if (unrecognizedKeyword != null)
854                          {
855                            if (!allowOtherKeys &&
856                                (allowOtherKeysValue == null || allowOtherKeysValue == NIL))
857                              error(new ProgramError("Unrecognized keyword argument " +
858                                                      unrecognizedKeyword.writeToString()));
859                          }
860                      }
861                  }
862              }
863          }
864        else if (argsUsed < argsLength)
865          {
866            // No keyword parameters.
867            if (argsUsed + 2 <= argsLength)
868              {
869                // Check for :ALLOW-OTHER-KEYS.
870                LispObject allowOtherKeysValue = NIL;
871                int n = argsUsed;
872                while (n < argsLength)
873                  {
874                    LispObject keyword = args[n];
875                    if (keyword == Keyword.ALLOW_OTHER_KEYS)
876                      {
877                        allowOtherKeysValue = args[n+1];
878                        break;
879                      }
880                    n += 2;
881                  }
882                if (allowOtherKeys || allowOtherKeysValue != NIL)
883                  {
884                    // Skip keyword/value pairs.
885                    while (argsUsed + 2 <= argsLength)
886                      argsUsed += 2;
887                  }
888                else if (andKey)
889                  {
890                    LispObject keyword = args[argsUsed];
891                    if (keyword == Keyword.ALLOW_OTHER_KEYS)
892                      {
893                        // Section 3.4.1.4: "Note that if &KEY is present, a
894                        // keyword argument of :ALLOW-OTHER-KEYS is always
895                        // permitted---regardless of whether the associated
896                        // value is true or false."
897                        argsUsed += 2;
898                      }
899                  }
900              }
901            if (argsUsed < argsLength)
902              {
903                if (restVar == null)
904                  error(new WrongNumberOfArgumentsException(this));
905              }
906          }
907    }
908    finally {
909        thread.resetSpecialBindings(mark);
910    }
911    return array;
912  }
913
914  // No optional or keyword parameters.
915  protected final LispObject[] fastProcessArgs(LispObject[] args)
916
917  {
918    final int argsLength = args.length;
919    if (arity >= 0)
920      {
921        // Fixed arity.
922        if (argsLength != arity)
923          error(new WrongNumberOfArgumentsException(this));
924        return args;
925      }
926    // Not fixed arity.
927    if (argsLength < minArgs)
928      error(new WrongNumberOfArgumentsException(this));
929    final LispObject[] array = new LispObject[variables.length];
930    int index = 0;
931    // Required parameters.
932    for (int i = 0; i < minArgs; i++)
933      {
934        array[index++] = args[i];
935      }
936    int argsUsed = minArgs;
937    // &rest parameter.
938    if (restVar != null)
939      {
940        LispObject rest = NIL;
941        for (int j = argsLength; j-- > argsUsed;)
942          rest = new Cons(args[j], rest);
943        array[index++] = rest;
944      }
945    else if (argsUsed < argsLength)
946      {
947        // No keyword parameters.
948        if (argsUsed + 2 <= argsLength)
949          {
950            // Check for :ALLOW-OTHER-KEYS.
951            LispObject allowOtherKeysValue = NIL;
952            int n = argsUsed;
953            while (n < argsLength)
954              {
955                LispObject keyword = args[n];
956                if (keyword == Keyword.ALLOW_OTHER_KEYS)
957                  {
958                    allowOtherKeysValue = args[n+1];
959                    break;
960                  }
961                n += 2;
962              }
963            if (allowOtherKeys || allowOtherKeysValue != NIL)
964              {
965                // Skip keyword/value pairs.
966                while (argsUsed + 2 <= argsLength)
967                  argsUsed += 2;
968              }
969            else if (andKey)
970              {
971                LispObject keyword = args[argsUsed];
972                if (keyword == Keyword.ALLOW_OTHER_KEYS)
973                  {
974                    // Section 3.4.1.4: "Note that if &key is present, a
975                    // keyword argument of :allow-other-keys is always
976                    // permitted---regardless of whether the associated
977                    // value is true or false."
978                    argsUsed += 2;
979                  }
980              }
981          }
982        if (argsUsed < argsLength)
983          {
984            if (restVar == null)
985              error(new WrongNumberOfArgumentsException(this));
986          }
987      }
988    return array;
989  }
990
991  private final void bindParameterDefaults(Parameter[] parameters,
992                                           Environment env,
993                                           LispThread thread)
994
995  {
996    for (Parameter parameter : parameters)
997      {
998        LispObject value;
999        if (parameter.initVal != null)
1000          value = parameter.initVal;
1001        else
1002          value = eval(parameter.initForm, env, thread);
1003        bindArg(specials, parameter.var, value, env, thread);
1004        if (parameter.svar != NIL)
1005    bindArg(specials, (Symbol)parameter.svar, NIL, env, thread);
1006      }
1007  }
1008
1009  private final void bindAuxVars(Environment env, LispThread thread)
1010
1011  {
1012    // Aux variable processing is analogous to LET* processing.
1013    for (Parameter parameter : auxVars)
1014      {
1015        Symbol sym = parameter.var;
1016        LispObject value;
1017
1018        if (parameter.initVal != null)
1019          value = parameter.initVal;
1020        else
1021          value = eval(parameter.initForm, env, thread);
1022
1023        bindArg(specials, sym, value, env, thread);
1024      }
1025  }
1026
1027  public static class Parameter
1028  {
1029    final Symbol var;
1030    final LispObject initForm;
1031    final LispObject initVal;
1032    final LispObject svar;
1033    private final int type;
1034    final Symbol keyword;
1035
1036    public Parameter(Symbol var)
1037    {
1038      this.var = var;
1039      this.initForm = null;
1040      this.initVal = null;
1041      this.svar = NIL;
1042      this.type = REQUIRED;
1043      this.keyword = null;
1044    }
1045
1046    public Parameter(Symbol var, LispObject initForm, int type)
1047
1048    {
1049      this.var = var;
1050      this.initForm = initForm;
1051      this.initVal = processInitForm(initForm);
1052      this.svar = NIL;
1053      this.type = type;
1054      keyword =
1055        type == KEYWORD ? PACKAGE_KEYWORD.intern(var.name) : null;
1056    }
1057
1058    public Parameter(Symbol var, LispObject initForm, LispObject svar,
1059                     int type)
1060
1061    {
1062      this.var = var;
1063      this.initForm = initForm;
1064      this.initVal = processInitForm(initForm);
1065      this.svar = (svar != NIL) ? checkSymbol(svar) : NIL;
1066      this.type = type;
1067      keyword =
1068        type == KEYWORD ? PACKAGE_KEYWORD.intern(var.name) : null;
1069    }
1070
1071    public Parameter(Symbol keyword, Symbol var, LispObject initForm,
1072                     LispObject svar)
1073
1074    {
1075      this.var = var;
1076      this.initForm = initForm;
1077      this.initVal = processInitForm(initForm);
1078      this.svar = (svar != NIL) ? checkSymbol(svar) : NIL;
1079      type = KEYWORD;
1080      this.keyword = keyword;
1081    }
1082
1083    @Override
1084    public String toString()
1085    {
1086      if (type == REQUIRED)
1087        return var.toString();
1088      StringBuffer sb = new StringBuffer();
1089      if (keyword != null)
1090        {
1091          sb.append(keyword);
1092          sb.append(' ');
1093        }
1094      sb.append(var.toString());
1095      sb.append(' ');
1096      sb.append(initForm);
1097      sb.append(' ');
1098      sb.append(type);
1099      return sb.toString();
1100    }
1101
1102    private static final LispObject processInitForm(LispObject initForm)
1103
1104    {
1105      if (initForm.constantp())
1106        {
1107          if (initForm instanceof Symbol)
1108            return initForm.getSymbolValue();
1109          if (initForm instanceof Cons)
1110            {
1111              Debug.assertTrue(initForm.car() == Symbol.QUOTE);
1112              return initForm.cadr();
1113            }
1114          return initForm;
1115        }
1116      return null;
1117    }
1118  }
1119
1120  // ### lambda-list-names
1121  private static final Primitive LAMBDA_LIST_NAMES =
1122      new Primitive("lambda-list-names", PACKAGE_SYS, true)
1123    {
1124      @Override
1125      public LispObject execute(LispObject arg)
1126      {
1127        Closure closure = new Closure(list(Symbol.LAMBDA, arg, NIL), new Environment());
1128        return closure.getVariableList();
1129      }
1130    };
1131}
Note: See TracBrowser for help on using the repository browser.