[CEDET-devel] Re: no-next-method in SemanticDB
Brought to you by:
zappo
From: drkm <dar...@ya...> - 2005-07-09 02:22:54
|
"Eric M. Ludlam" writes: >>>> drkm seems to think that: >> But having real objects representing methods could be of >>interest, too. They can be stored in the plist of the >>same-name-of-the-class-symbols in the obarrays in the >>'eieio-method-obarray' property of the generic function symbol, >>for example. > [...] > That said, your suggestion of grafting a method object onto the side > of the existing system has some merit and may actually be possible > without a full re-write. Doing so may provide additional flexibility > in the future. I wrote a piece of code to see what it can look like. It's based (from far) on MOP <URL:http://www.lisp.org/mop/index.html>. So I included all the ancestor classes of the two I used, 'eieio-standard-generic-function' and 'eieio-standard-method'. I don't really know MOP, so my (mis)understanding can be buggy. The code is not verry robust (not tested), but I don't have a lot of time to work on. So I post it here, to see your comments. I still have a problem related to bootstrap issue. But, again, I don't have a lot of time, and it's just a prototype. So, at this time, in EIEIO, methods and generic functions are represented like the following (let me know if I misunderstood something). The generic function name (a symbol in the default obarray) have the properties 'eieio-method-tree' and 'eieio-method-obarray'. I don't really understand what the 'eieio-method-tree' is used for. The 'eieio-method-obarray' is used as a container of the method implementations. Because EIEIO dispatches only on the first parameter, a single symbol can specify the implementation for a given call: the symbol of the class of the first parameter. So a symbol is created in the obarray for each implementation, whose the name is the same as the class symbol. This newly interned symbol is 'fset'ed to the implementation. It's a little bit more complex, because the qualifiers (:BEFORE, :PRIMARY, etc.). So there is an obarray for each existing qualifier (all the obarrays are in a vector, the real value of the 'eieio-method-obarray' property). What I done is just putting a property on these symbols (those in the obarrays). The property name is ':eieio-method', and the value is the method object. I put also a property on the generic function symbols, whose name is ':eieio-generic-function', and the value is the generic function object. I also changed 'no-next-method' to something more closely related to the ANSI CL, IMHO. Maybe the infos it passes to 'signal' may be improved. I think this kind of code can be usefull. But it need improvments. Unfortunately, I can't spend a lot of time on this during July and August. Maybe after (so after the CEDET 1.0 release :-p). Thanks, --drkm --- eieio.el-old 2005-06-30 05:08:02.000000000 +0200 +++ eieio.el 2005-07-09 02:54:20.000000000 +0200 @@ -869,7 +869,7 @@ calls defgeneric for you. With this implementation the arguments are currently ignored. You can use `defgeneric' to apply specialized top level documentation to a method." - `(eieio-defgeneric (quote ,method) ,doc-string)) + `(eieio-defgeneric (quote ,method) ,doc-string (quote ,args))) (defun eieio-defgeneric-form (method doc-string) "The lambda form that would be used as the function defined on METHOD. @@ -879,7 +879,7 @@ ,doc-string (eieio-generic-call (quote ,method) local-args))) -(defun eieio-defgeneric (method doc-string) +(defun eieio-defgeneric (method doc-string &optional args) "Engine part to `defgeneric' macro defining METHOD with DOC-STRING." (if (and (fboundp method) (not (generic-p method)) (or (byte-code-function-p (symbol-function method)) @@ -896,8 +896,13 @@ (fset method (eieio-defgeneric-form method doc-string)) ;; Make sure the method tables are installed. (eieiomt-install method) + (put method :eieio-generic-function + (make-instance 'eieio-standard-generic-function + :name method + :lambda-list args + :documentation doc-string)) ;; Return the method - 'method)) + method)) (defun eieio-unbind-method-implementations (method) "Make the generic method METHOD have no implementations.. @@ -1656,7 +1661,7 @@ (returnval nil) ) (if (or (not next) (not (car next))) - (no-next-method (car newargs)) + (no-next-method-trempoline newargs) (let* ((eieio-generic-call-next-method-list (cdr eieio-generic-call-next-method-list)) (scoped-class (cdr next)) @@ -1727,8 +1732,25 @@ ;; said symbol in the correct obarray, otherwise use the ;; other array to keep this stuff (if (< key method-num-lists) - (let ((nsym (intern (symbol-name class) (aref emto key)))) - (fset nsym method))) + (let ((nsym (intern (symbol-name class) (aref emto key))) + (generic (get method-name :eieio-generic-function)) + (qual (cond ((eq key method-before) :BEFORE) + ((eq key method-after) :AFTER) + ((eq key method-primary) :PRIMARY) + ((eq key method-static) :STATIC) + (t (error "eieiomt-add: Unknown qualifier %s" key))))) + (put nsym :eieio-method + (make-instance + 'eieio-standard-method + :function method + :generic-function generic + ;; FIXME: Bootstrap problem. + :lambda-list (when (fboundp 'generic-function-lambda-list) + (generic-function-lambda-list generic)) + :lambda-list `(,class) + :specializers `(,class) ;; EIEIO is special + :qualifiers `(,qual))) + (fset nsym method))) ;; Now optimize the entire obarray (if (< key method-num-lists) (let ((eieiomt-optimizing-obarray (aref emto key))) @@ -1917,6 +1939,59 @@ (defalias 'standard-class 'eieio-default-superclass) +;; Classes from MOP (see http://www.lisp.org/mop/index.html) +;; +(defclass eieio-standard-object () + () + "TODO: not implemented.") + +(defclass eieio-funcallable-standard-object (eieio-standard-object) + () + "TODO: not implemented.") + +(defclass eieio-generic-function (eieio-funcallable-standard-object) + () + "TODO: not implemented.") + +(defclass eieio-standard-generic-function (eieio-generic-function) + ((name :initarg :name) + (methods :initform nil) + ;; TODO: The default class for this generic function's method + ;; metaobjects is available as a class metaobject. + (lambda-list :initarg :lambda-list) + ;; TODO: The method combination is available as a method + ;; combination metaobject. + (documentation :initarg :documentation) + ;; TODO: The argument precedence order is available as a + ;; permutation of those symbols from the lambda list which name the + ;; required arguments of the generic function. + ;; TODO: The declarations are available as a list of declarations. + ) + "TODO: write docstring.") + +(defclass eieio-metaobject (eieio-standard-object) + () + "TODO: not implemented.") + +(defclass eieio-method (eieio-metaobject) + () + "TODO: not implemented.") + +(defclass eieio-standard-method (eieio-method) + ((function :initarg :function) + (generic-function :initarg :generic-function) + (lambda-list :initarg :lambda-list) + (specializers :initarg :specializers) + (qualifiers :initarg :qualifiers)) + "TODO: write docstring.") + +(defclass eieio-standard-accessor-method (eieio-standard-method) + ((slot-definition :initarg :slot-definition)) + "TODO: write docstring.") + +(flet ((make-instance (class &rest initargs) + (message "DEBUG: `make-instance' deactivated..."))) + (defmethod constructor :STATIC ((class eieio-default-superclass) newname &rest fields) "Default constructor for CLASS `eieio-defualt-superclass'. @@ -1971,6 +2046,8 @@ ;; Shared initialize will parse our fields for us. (shared-initialize this fields)) +) ;; flet + (defmethod slot-missing ((object eieio-default-superclass) slot-name operation &optional new-value) "Slot missing is invoked when an attempt to access a slot in OBJECT fails. @@ -1999,16 +2076,43 @@ (signal 'no-method-definition (list method (object-name object))) ) -(defmethod no-next-method ((object eieio-default-superclass) - &rest args) +(defun eieio-get-generic-function-object (generic-sym) + "..." + (get generic-sym :eieio-generic-function)) + +;; TODO: What to do if the first argument to defmethod is not typed? +;; +(defun eieio-get-method-object (generic-sym class key) + "..." + (get (intern (symbol-name (if (object-p class) (object-class class) class)) + (aref (get generic-sym 'eieio-method-obarray) key)) + :eieio-method)) + +(defun no-next-method-trempoline (newargs) + "..." + (apply 'no-next-method + (eieio-get-generic-function-object eieio-generic-call-methodname) + (eieio-get-method-object eieio-generic-call-methodname + (car newargs) + eieio-generic-call-key) + newargs)) + +(defmethod no-next-method ((generic eieio-generic-function) + (method eieio-method) + &rest args) "Called from `call-next-method' when no additional methods are available. OBJECT is othe object being called on `call-next-method'. ARGS are the arguments it is called by. This method throws `no-next-method' by default. Override this method to not throw an error, and it's return value becomes the return value of `call-next-method'." - (signal 'no-next-method (list (object-name object) args)) -) + (signal 'no-next-method + `(,(object-class (car args)) + ,(eieio-generic-function-name generic) + ,(eieio-method-qualifiers method) + ,(eieio-method-lambda-list method) + ,(object-name (car args)) + ,@(cdr args)))) (defmethod clone ((obj eieio-default-superclass) &rest params) "Make a deep copy of OBJ, and then apply PARAMS. @@ -2123,6 +2227,158 @@ (princ (make-string (* eieio-print-depth 2) ? )) (princ ")"))) +(defgeneric eieio-generic-function-argument-precedence-order + (generic-function) + "Returns the argument precedence order of the generic +function. This value is a list of symbols, a permutation of the +required parameters in the lambda list of the generic +function. This is the defaulted value of +the :argument-precedence-order initialization argument that was +associated with the generic function metaobject during +initialization or reinitialization.") + +(defgeneric eieio-generic-function-declarations (generic-function) + "Returns a possibly empty list of the declarations of the +generic function. The elements of this list are +declarations. This list is the defaulted value of +the :declarations initialization argument that was associated +with the generic function metaobject during initialization or +reinitialization.") + +(defgeneric eieio-generic-function-lambda-list (generic-function) + "Returns the lambda list of the generic function. This is the +defaulted value of the :lambda-list initialization argument that +was associated with the generic function metaobject during +initialization or reinitialization. An error is signaled if the +lambda list has yet to be supplied.") + +(defgeneric eieio-generic-function-method-class (generic-function) + "Returns the default method class of the generic function. This +class must be a subclass of the class method. This is the +defaulted value of the :method-class initialization argument that +was associated with the generic function metaobject during +initialization or reinitialization.") + +(defgeneric eieio-generic-function-method-combination (generic-function) + "Returns the method combination of the generic function. This +is a method combination metaobject. This is the defaulted value +of the :method-combination initialization argument that was +associated with the generic function metaobject during +initialization or reinitialization.") + +(defgeneric eieio-generic-function-methods (generic-function) + "Returns the set of methods currently connected to the generic +function. This is a set of method metaobjects. This value is +maintained by the generic functions ADD-METHOD and +REMOVE-METHOD.") + +;; TODO: The SETF form... +;; +(defgeneric eieio-generic-function-name (generic-function) + "Returns the name of the generic function, or nil if the +generic function has no name. This is the defaulted value of +the :name initialization argument that was associated with the +generic function metaobject during initialization or +reinitialization. (Also see (setf generic-function-name) [EIEIO: +not implemented yet].)") + +(defmethod eieio-generic-function-argument-precedence-order + ((gf eieio-standard-generic-function)) + "TODO: write docstring." + (error "`eieio-generic-function-argument-precedence-order': not implemented yet!")) + +(defmethod eieio-generic-function-declarations + ((gf eieio-standard-generic-function)) + "TODO: write docstring." + (error "`eieio-generic-function-declarations': not implemented yet!")) + +(defmethod eieio-generic-function-lambda-list + ((gf eieio-standard-generic-function)) + "TODO: write docstring." + (oref gf lambda-list)) + +(defmethod eieio-generic-function-method-class + ((gf eieio-standard-generic-function)) + "TODO: write docstring." + (error "`eieio-generic-function-method-class': not implemented yet!")) + +(defmethod eieio-generic-function-method-combination + ((gf eieio-standard-generic-function)) + "TODO: write docstring." + (error "`eieio-generic-function-method-combination': not implemented yet!")) + +(defmethod eieio-generic-function-methods + ((gf eieio-standard-generic-function)) + "TODO: write docstring." + (oref gf methods)) + +(defmethod eieio-generic-function-name + ((gf eieio-standard-generic-function)) + "TODO: write docstring." + (oref gf name)) + +(defgeneric eieio-method-function (method) + "Returns the method function of method. This is the defaulted +value of the :function initialization argument that was +associated with the method during initialization.") + +(defgeneric eieio-method-generic-function (method) + "Returns the generic function that method is currently +connected to, or nil if it is not currently connected to any +generic function. This value is either a generic function +metaobject or nil. When a method is first created it is not +connected to any generic function. This connection is maintained +by the generic functions ADD-METHOD and REMOVE-METHOD.") + +(defgeneric eieio-method-lambda-list (method) + "Returns the (unspecialized) lambda list of method. This value +is a Common Lisp lambda list. This is the defaulted value of +the :lambda-list initialization argument that was associated with +the method during initialization.") + +(defgeneric eieio-method-specializers (method) + "Returns a list of the specializers of method. This value is a +list of specializer metaobjects. This is the defaulted value of +the :specializers initialization argument that was associated +with the method during initialization.") + +(defgeneric eieio-method-qualifiers (method) + "Returns a (possibly empty) list of the qualifiers of +method. This value is a list of non-nil atoms. This is the +defaulted value of the :qualifiers initialization argument that +was associated with the method during initialization.") + +(defgeneric eieio-accessor-method-slot-definition (method) + "This accessor can only be called on accessor methods. It +returns the direct slot definition metaobject that defined this +method. This is the value of the :slot-definition initialization +argument associated with the method during initialization.") + +(defmethod eieio-method-function ((m eieio-standard-method)) + "TODO: write docstring." + (oref m function)) + +(defmethod eieio-method-lambda-list ((m eieio-standard-method)) + "TODO: write docstring." + (oref m lambda-list)) + +(defmethod eieio-method-specializers ((m eieio-standard-method)) + "TODO: write docstring." + (oref m specializers)) + +(defmethod eieio-method-qualifiers ((m eieio-standard-method)) + "TODO: write docstring." + (oref m qualifiers)) + +(defmethod eieio-method-generic-function ((m eieio-standard-method)) + "TODO: write docstring." + (oref m generic-function)) + +(defmethod eieio-accessor-method-slot-definition + ((m eieio-standard-accessor-method)) + "TODO: write docstring." + (error "`eieio-accessor-method-slot-definition': not implemented yet!")) + ;;; Unimplemented functions from CLOS ;; |