Changeset 13781


Ignore:
Timestamp:
01/15/12 19:51:35 (9 years ago)
Author:
ehuelsmann
Message:

Support for the FUNCTION-KEYWORDS protocol, required to implement
keyword argument verification for effective methods.

Location:
trunk/abcl/src/org/armedbear/lisp
Files:
5 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/Autoload.java

    r13775 r13781  
    578578        autoload(PACKAGE_SYS, "%set-method-fast-function", "StandardMethod", true);
    579579        autoload(PACKAGE_SYS, "%set-method-function", "StandardMethod", true);
     580        autoload(PACKAGE_SYS, "%set-function-keywords", "StandardMethod", true);
    580581        autoload(PACKAGE_SYS, "%set-method-generic-function", "StandardMethod", true);
    581582        autoload(PACKAGE_SYS, "%set-method-specializers", "StandardMethod", true);
     
    638639        autoload(PACKAGE_SYS, "float-string", "FloatFunctions", true);
    639640        autoload(PACKAGE_SYS, "function-info", "function_info");
     641        autoload(PACKAGE_SYS, "%function-keywords", "StandardMethod", true);
    640642        autoload(PACKAGE_SYS, "generic-function-argument-precedence-order","StandardGenericFunction", true);
    641643        autoload(PACKAGE_SYS, "generic-function-classes-to-emf-table","StandardGenericFunction", true);
     
    649651        autoload(PACKAGE_SYS, "get-function-info-value", "function_info");
    650652        autoload(PACKAGE_SYS, "gf-required-args", "StandardGenericFunction", true);
     653        autoload(PACKAGE_SYS, "gf-optional-args", "StandardGenericFunction", true);
    651654        autoload(PACKAGE_SYS, "hash-table-entries", "HashTableFunctions");
    652655        autoload(PACKAGE_SYS, "hash-table-entries", "HashTableFunctions");
  • trunk/abcl/src/org/armedbear/lisp/StandardMethod.java

    r13541 r13781  
    5757    slots[StandardMethodClass.SLOT_INDEX_GENERIC_FUNCTION] = gf;
    5858    slots[StandardMethodClass.SLOT_INDEX_LAMBDA_LIST] = lambdaList;
     59    slots[StandardMethodClass.SLOT_INDEX_KEYWORDS] = NIL;
     60    slots[StandardMethodClass.SLOT_INDEX_OTHER_KEYWORDS_P] = NIL;
    5961    slots[StandardMethodClass.SLOT_INDEX_SPECIALIZERS] = specializers;
    6062    slots[StandardMethodClass.SLOT_INDEX_QUALIFIERS] = NIL;
     
    6466  }
    6567
    66   private static final Primitive METHOD_LAMBDA_LIST 
    67     = new pf_method_lambda_list(); 
     68  private static final Primitive METHOD_LAMBDA_LIST
     69    = new pf_method_lambda_list();
    6870  @DocString(name="method-lambda-list",
    6971             args="generic-method")
     
    9698    {
    9799      checkStandardMethod(first).slots[StandardMethodClass.SLOT_INDEX_LAMBDA_LIST] = second;
     100      return second;
     101    }
     102  };
     103
     104  private static final Primitive _FUNCTION_KEYWORDS
     105    = new pf__function_keywords();
     106  @DocString(name="%function-keywords",
     107             args="standard-method")
     108  private static final class pf__function_keywords extends Primitive
     109  {
     110    pf__function_keywords()
     111    {
     112      super("%function-keywords", PACKAGE_SYS, true, "method");
     113    }
     114    @Override
     115    public LispObject execute(LispObject arg)
     116    {
     117      StandardMethod method = checkStandardMethod(arg);
     118      LispThread thread = LispThread.currentThread();
     119
     120      return thread
     121          .setValues(method.slots[StandardMethodClass.SLOT_INDEX_KEYWORDS],
     122                     method.slots[StandardMethodClass.SLOT_INDEX_OTHER_KEYWORDS_P]);
     123    }
     124  };
     125
     126  private static final Primitive _SET_FUNCTION_KEYWORDS
     127    = new pf__set_function_keywords();
     128  @DocString(name="%set-function-keywords",
     129             args="standard-method keywords other-keywords-p")
     130  private static final class pf__set_function_keywords extends Primitive
     131  {
     132    pf__set_function_keywords()
     133    {
     134      super("%set-function-keywords", PACKAGE_SYS, true,
     135            "method keywords");
     136    }
     137    @Override
     138    public LispObject execute(LispObject first, LispObject second,
     139                              LispObject third)
     140    {
     141      StandardMethod method = checkStandardMethod(first);
     142      method.slots[StandardMethodClass.SLOT_INDEX_KEYWORDS] = second;
     143      method.slots[StandardMethodClass.SLOT_INDEX_OTHER_KEYWORDS_P] = third;
    98144      return second;
    99145    }
  • trunk/abcl/src/org/armedbear/lisp/StandardMethodClass.java

    r12288 r13781  
    3838public final class StandardMethodClass extends StandardClass
    3939{
     40  // When changing this list, don't forget to edit
     41  // StandardReaderMethodClass as well
    4042  public static final int SLOT_INDEX_GENERIC_FUNCTION = 0;
    4143  public static final int SLOT_INDEX_LAMBDA_LIST      = 1;
    42   public static final int SLOT_INDEX_SPECIALIZERS     = 2;
    43   public static final int SLOT_INDEX_QUALIFIERS       = 3;
    44   public static final int SLOT_INDEX_FUNCTION         = 4;
    45   public static final int SLOT_INDEX_FAST_FUNCTION    = 5;
    46   public static final int SLOT_INDEX_DOCUMENTATION    = 6;
     44  public static final int SLOT_INDEX_KEYWORDS         = 2;
     45  public static final int SLOT_INDEX_OTHER_KEYWORDS_P = 3;
     46  public static final int SLOT_INDEX_SPECIALIZERS     = 4;
     47  public static final int SLOT_INDEX_QUALIFIERS       = 5;
     48  public static final int SLOT_INDEX_FUNCTION         = 6;
     49  public static final int SLOT_INDEX_FAST_FUNCTION    = 7;
     50  public static final int SLOT_INDEX_DOCUMENTATION    = 8;
    4751
    4852  public StandardMethodClass()
     
    5458        Symbol.GENERIC_FUNCTION,
    5559        pkg.intern("LAMBDA-LIST"),
     60        pkg.intern("KEYWORDS"),
     61        pkg.intern("OTHER_KEYWORDS_P"),
    5662        pkg.intern("SPECIALIZERS"),
    5763        pkg.intern("QUALIFIERS"),
  • trunk/abcl/src/org/armedbear/lisp/StandardReaderMethodClass.java

    r12288 r13781  
    4141  public static final int SLOT_INDEX_GENERIC_FUNCTION = 0;
    4242  public static final int SLOT_INDEX_LAMBDA_LIST      = 1;
    43   public static final int SLOT_INDEX_SPECIALIZERS     = 2;
    44   public static final int SLOT_INDEX_QUALIFIERS       = 3;
    45   public static final int SLOT_INDEX_FUNCTION         = 4;
    46   public static final int SLOT_INDEX_FAST_FUNCTION    = 5;
    47   public static final int SLOT_INDEX_DOCUMENTATION    = 6;
     43  public static final int SLOT_INDEX_KEYWORDS         = 2;
     44  public static final int SLOT_INDEX_OTHER_KEYWORDS_P = 3;
     45  public static final int SLOT_INDEX_SPECIALIZERS     = 4;
     46  public static final int SLOT_INDEX_QUALIFIERS       = 5;
     47  public static final int SLOT_INDEX_FUNCTION         = 6;
     48  public static final int SLOT_INDEX_FAST_FUNCTION    = 7;
     49  public static final int SLOT_INDEX_DOCUMENTATION    = 8;
     50
    4851
    4952  // Added:
    50   public static final int SLOT_INDEX_SLOT_NAME        = 7;
     53  public static final int SLOT_INDEX_SLOT_NAME        = 9;
    5154
    5255  public StandardReaderMethodClass()
     
    5962        Symbol.GENERIC_FUNCTION,
    6063        pkg.intern("LAMBDA-LIST"),
     64        pkg.intern("KEYWORDS"),
     65        pkg.intern("OTHER_KEYWORDS_P"),
    6166        pkg.intern("SPECIALIZERS"),
    6267        pkg.intern("QUALIFIERS"),
  • trunk/abcl/src/org/armedbear/lisp/clos.lisp

    r13779 r13781  
    129129         (apply #',%name args)))))
    130130
     131;;
     132;;  DEFINE PLACE HOLDER FUNCTIONS
     133;;
     134
    131135(define-class->%class-forwarder class-name)
    132136(define-class->%class-forwarder (setf class-name))
     
    156160         generic-function
    157161         args))
     162
     163(defun function-keywords (method)
     164  (%function-keywords method))
    158165
    159166
     
    14201427                 (required-args (getf plist ':required-args)))
    14211428            (%set-gf-required-args gf required-args)
     1429            (%set-gf-optional-args gf (getf plist :optional-args))
    14221430            (when apo-p
    14231431              (setf (generic-function-argument-precedence-order gf)
     
    17581766                                      fast-function)
    17591767  (declare (ignore gf))
    1760   (let ((method (std-allocate-instance +the-standard-method-class+)))
     1768  (let ((method (std-allocate-instance +the-standard-method-class+))
     1769        (analyzed-args (analyze-lambda-list lambda-list))
     1770        )
    17611771    (setf (method-lambda-list method) lambda-list)
    17621772    (setf (method-qualifiers method) qualifiers)
     
    17661776    (%set-method-function method function)
    17671777    (%set-method-fast-function method fast-function)
     1778    (%set-function-keywords method
     1779                            (getf analyzed-args :keywords)
     1780                            (getf analyzed-args :allow-other-keys))
    17681781    method))
    17691782
     
    19281941                        (funcall emfun args)
    19291942                        (slow-method-lookup gf args))))))
     1943;;           (let ((non-key-args (+ number-required
     1944;;                                  (length (gf-optional-args gf))))))
    19301945           #'(lambda (&rest args)
    19311946               (declare (optimize speed))
     
    33293344(defgeneric no-next-method (generic-function method &rest args))
    33303345
    3331 ;; FIXME
    3332 (defgeneric function-keywords (method))
     3346(atomic-defgeneric function-keywords (method)
     3347  (:method ((method standard-method))
     3348    (%function-keywords method)))
    33333349
    33343350
Note: See TracChangeset for help on using the changeset viewer.