Changeset 14503


Ignore:
Timestamp:
05/17/13 20:50:55 (10 years ago)
Author:
rschlatte
Message:

Move initial initialization of generic functions Lisp-side

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

Legend:

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

    r14497 r14503  
    194194                               + arg.princToString() + ".");
    195195        }
    196         FuncallableStandardObject o = new FuncallableStandardObject((Layout)l);
    197         if (Symbol.SUBTYPEP.execute(arg, LispClass.findClass(Symbol.STANDARD_GENERIC_FUNCTION)) != NIL) {
    198           // KLUDGE: this initialization should be moved Lisp-side
    199           o.setInstanceSlotValue(Symbol.NAME, NIL);
    200           o.setInstanceSlotValue(Symbol.LAMBDA_LIST, NIL);
    201           o.setInstanceSlotValue(Symbol.REQUIRED_ARGS, NIL);
    202           o.setInstanceSlotValue(Symbol.OPTIONAL_ARGS, NIL);
    203           o.setInstanceSlotValue(Symbol.INITIAL_METHODS, NIL);
    204           o.setInstanceSlotValue(Symbol.METHODS, NIL);
    205           o.setInstanceSlotValue(Symbol.METHOD_CLASS, StandardClass.STANDARD_METHOD);
    206           // method combination class set by clos.lisp:shared-initialize :after
    207           o.setInstanceSlotValue(Symbol._METHOD_COMBINATION, list(Symbol.STANDARD));
    208           o.setInstanceSlotValue(Symbol.ARGUMENT_PRECEDENCE_ORDER, NIL);
    209           o.setInstanceSlotValue(Symbol.DECLARATIONS, NIL);
    210           o.setInstanceSlotValue(Symbol._DOCUMENTATION, NIL);
    211         }
    212         return o;
     196        return new FuncallableStandardObject((Layout)l);
    213197      }
    214198      return type_error(arg, Symbol.FUNCALLABLE_STANDARD_CLASS);
  • trunk/abcl/src/org/armedbear/lisp/clos.lisp

    r14501 r14503  
    815815(defun allocate-funcallable-instance (class)
    816816  (let ((instance (sys::%allocate-funcallable-instance class)))
     817    ;; KLUDGE: without this, the build fails with unbound-slot
     818    (when (or (eq class +the-standard-generic-function-class+)
     819              (subtypep class +the-standard-generic-function-class+))
     820      (setf (std-slot-value instance 'sys::method-class)
     821            +the-standard-method-class+))
    817822    (set-funcallable-instance-function
    818823     instance
Note: See TracChangeset for help on using the changeset viewer.