source: trunk/abcl/src/org/armedbear/lisp/Closure.java @ 12517

Last change on this file since 12517 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.