From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Stefan Monnier Newsgroups: gmane.emacs.devel Subject: Re: EIEIO with lexical scoping Date: Tue, 14 May 2013 08:42:43 -0400 Message-ID: References: <51917EA1.50403@siege-engine.com> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: text/plain X-Trace: ger.gmane.org 1368535378 16160 80.91.229.3 (14 May 2013 12:42:58 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Tue, 14 May 2013 12:42:58 +0000 (UTC) Cc: "Eric M. Ludlam" , emacs-devel@gnu.org To: "Eric M. Ludlam" Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Tue May 14 14:42:56 2013 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1UcEZE-0001r6-7e for ged-emacs-devel@m.gmane.org; Tue, 14 May 2013 14:42:56 +0200 Original-Received: from localhost ([::1]:34304 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1UcEZD-0000ev-Fp for ged-emacs-devel@m.gmane.org; Tue, 14 May 2013 08:42:55 -0400 Original-Received: from eggs.gnu.org ([208.118.235.92]:42020) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1UcEZ8-0000e0-0m for emacs-devel@gnu.org; Tue, 14 May 2013 08:42:52 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1UcEZ3-0002SX-Sw for emacs-devel@gnu.org; Tue, 14 May 2013 08:42:49 -0400 Original-Received: from ironport2-out.teksavvy.com ([206.248.154.182]:37078) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1UcEZ3-0002SQ-M0; Tue, 14 May 2013 08:42:45 -0400 X-IronPort-Anti-Spam-Filtered: true X-IronPort-Anti-Spam-Result: Av8EABK/CFG4rwb8/2dsb2JhbABEuzWDWRdzgh4BAQQBViMFCws0EhQYDSSIHgaxH5AOkQoDklqSIIFegxOBTCQ X-IPAS-Result: Av8EABK/CFG4rwb8/2dsb2JhbABEuzWDWRdzgh4BAQQBViMFCws0EhQYDSSIHgaxH5AOkQoDklqSIIFegxOBTCQ X-IronPort-AV: E=Sophos;i="4.84,565,1355115600"; d="scan'208";a="11981240" Original-Received: from 184-175-6-252.dsl.teksavvy.com (HELO pastel.home) ([184.175.6.252]) by ironport2-out.teksavvy.com with ESMTP/TLS/ADH-AES256-SHA; 14 May 2013 08:42:39 -0400 Original-Received: by pastel.home (Postfix, from userid 20848) id CC280678C8; Tue, 14 May 2013 08:42:43 -0400 (EDT) In-Reply-To: (Stefan Monnier's message of "Mon, 13 May 2013 22:13:57 -0400") User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/24.3.50 (gnu/linux) X-detected-operating-system: by eggs.gnu.org: Genre and OS details not recognized. X-Received-From: 206.248.154.182 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.14 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:159568 Archived-At: > eieiomt-optimizing-obarray is defvarred as well, so it looks fine. > But `scoped-class' indeed looks like it might be a potential source of > problems, I'll take a closer look, thank you. It looks like this was the remaining culprit. I'm using the patch below now, and haven't noticed problems yet. Stefan === modified file 'lisp/emacs-lisp/eieio.el' --- lisp/emacs-lisp/eieio.el 2013-02-27 04:09:50 +0000 +++ lisp/emacs-lisp/eieio.el 2013-05-14 02:50:01 +0000 @@ -1,4 +1,4 @@ -;;; eieio.el --- Enhanced Implementation of Emacs Interpreted Objects +;;; eieio.el --- Enhanced Implementation of Emacs Interpreted Objects -*- lexical-binding:t -*- ;;; or maybe Eric's Implementation of Emacs Interpreted Objects ;; Copyright (C) 1995-1996, 1998-2013 Free Software Foundation, Inc. @@ -54,6 +54,8 @@ (interactive) (message eieio-version)) +(defvar scoped-class) + ;; FIXME: Don't wrap all the code inside `eval-and-compile'! (eval-and-compile ;; About the above. EIEIO must process its own code when it compiles @@ -193,32 +195,31 @@ ;; No check: If eieio gets this far, it's probably been checked already. `(get ,class 'eieio-class-definition)) -(defmacro class-p (class) +(defsubst class-p (class) "Return t if CLASS is a valid class vector. CLASS is a symbol." ;; this new method is faster since it doesn't waste time checking lots of ;; things. - `(condition-case nil - (eq (aref (class-v ,class) 0) 'defclass) + (condition-case nil + (eq (aref (class-v class) 0) 'defclass) (error nil))) -(defmacro eieio-object-p (obj) +(defsubst eieio-object-p (obj) "Return non-nil if OBJ is an EIEIO object." - `(let ((tobj ,obj)) - (and (vectorp tobj) - (eq (aref tobj 0) 'object) - (class-p (eieio--object-class tobj))))) + (and (vectorp obj) + (eq (aref obj 0) 'object) + (class-p (eieio--object-class obj)))) (defalias 'object-p 'eieio-object-p) (defmacro class-constructor (class) "Return the symbol representing the constructor of CLASS." `(eieio--class-symbol (class-v ,class))) -(defmacro generic-p (method) +(defsubst generic-p (method) "Return t if symbol METHOD is a generic function. Only methods have the symbol `eieio-method-obarray' as a property \(which contains a list of all bindings to that method type.)" - `(and (fboundp ,method) (get ,method 'eieio-method-obarray))) + (and (fboundp method) (get method 'eieio-method-obarray))) (defun generic-primary-only-p (method) "Return t if symbol METHOD is a generic function with only primary methods. @@ -261,10 +262,10 @@ Return nil if that option doesn't exist." `(class-option-assoc (eieio--class-options (class-v ,class)) ',option)) -(defmacro class-abstract-p (class) +(defsubst class-abstract-p (class) "Return non-nil if CLASS is abstract. Abstract classes cannot be instantiated." - `(class-option ,class :abstract)) + (class-option class :abstract)) (defmacro class-method-invocation-order (class) "Return the invocation order of CLASS. @@ -501,7 +502,7 @@ (setf (eieio--class-children (class-v (car pname))) (cons cname (eieio--class-children (class-v (car pname)))))) ;; Get custom groups, and store them into our local copy. - (mapc (lambda (g) (add-to-list 'groups g)) + (mapc (lambda (g) (pushnew g groups :test #'equal)) (class-option (car pname) :custom-groups)) ;; save parent in child (setf (eieio--class-parent newc) (cons (car pname) (eieio--class-parent newc)))) @@ -680,7 +681,7 @@ prot initarg alloc 'defaultoverride skip-nil) ;; We need to id the group, and store them in a group list attribute. - (mapc (lambda (cg) (add-to-list 'groups cg)) customg) + (mapc (lambda (cg) (pushnew cg groups :test #'equal)) customg) ;; Anyone can have an accessor function. This creates a function ;; of the specified name, and also performs a `defsetf' if applicable @@ -815,8 +816,7 @@ ;; Save the file location where this class is defined. (let ((fname (if load-in-progress load-file-name - buffer-file-name)) - loc) + buffer-file-name))) (when fname (when (string-match "\\.elc\\'" fname) (setq fname (substring fname 0 (1- (length fname))))) @@ -824,7 +824,7 @@ ;; We have a list of custom groups. Store them into the options. (let ((g (class-option-assoc options :custom-groups))) - (mapc (lambda (cg) (add-to-list 'g cg)) groups) + (mapc (lambda (cg) (pushnew cg g :test #'equal)) groups) (if (memq :custom-groups options) (setcar (cdr (memq :custom-groups options)) g) (setq options (cons :custom-groups (cons g options))))) @@ -856,10 +856,10 @@ (defun eieio-perform-slot-validation-for-default (slot spec value skipnil) "For SLOT, signal if SPEC does not match VALUE. If SKIPNIL is non-nil, then if VALUE is nil return t instead." - (if (and (not (eieio-eval-default-p value)) - (not eieio-skip-typecheck) - (not (and skipnil (null value))) - (not (eieio-perform-slot-validation spec value))) + (if (not (or (eieio-eval-default-p value) + eieio-skip-typecheck + (and skipnil (null value)) + (eieio-perform-slot-validation spec value))) (signal 'invalid-slot-type (list slot spec value)))) (defun eieio-add-new-slot (newc a d doc type cust label custg print prot init alloc @@ -1200,7 +1200,7 @@ (eq (symbol-function name) body)) (defalias name body))) -(defmacro defgeneric (method args &optional doc-string) +(defmacro defgeneric (method _args &optional doc-string) "Create a generic function METHOD. DOC-STRING is the base documentation for this class. A generic function has no body, as its purpose is to decide which method body @@ -1287,6 +1287,7 @@ (apply 'no-applicable-method (car local-args) ',method local-args) + (defvar scoped-class) ;; It is ok, do the call. ;; Fill in inter-call variables then evaluate the method. (let ((scoped-class ',class) @@ -1425,10 +1426,8 @@ (t (let* ((name (symbol-name type)) (namep (intern (concat name "p")))) - (if (fboundp namep) - (funcall `(lambda () (,namep val))) - (funcall `(lambda () - (,(intern (concat name "-p")) val))))))) + (funcall (if (fboundp namep) namep (intern (concat name "-p"))) + val)))) (cond ((get (car type) 'cl-deftype-handler) (eieio--typep val (apply (get (car type) 'cl-deftype-handler) (cdr type)))) @@ -1450,7 +1449,7 @@ ((memq (car type) '(member member*)) (memql val (cdr type))) ((eq (car type) 'satisfies) - (funcall `(lambda () (,(cadr type) val)))) + (funcall (cadr type) val)) (t (error "Bad type spec: %s" type))))) (defun eieio-perform-slot-validation (spec value) @@ -1799,9 +1798,9 @@ `(car (eieio-class-parents ,class))) (define-obsolete-function-alias 'class-parent #'eieio-class-parent "24.4") -(defmacro same-class-fast-p (obj class) +(defsubst same-class-fast-p (obj class) "Return t if OBJ is of class-type CLASS with no error checking." - `(eq (eieio--object-class ,obj) ,class)) + (eq (eieio--object-class obj) class)) (defun same-class-p (obj class) "Return t if OBJ is of class-type CLASS." (eieio--check-type class-p class) @@ -2212,7 +2211,8 @@ ;; Now loop through all occurrences forms which we must execute ;; (which are happily sorted now) and execute them all! - (let ((rval nil) (lastval nil) (rvalever nil) (found nil)) + (let ((rval nil) (lastval nil) ;; (rvalever nil) + (found nil)) (while lambdas (if (car lambdas) (let* ((scoped-class (cdr (car lambdas))) @@ -2230,14 +2230,16 @@ (setq lastval (apply (car (car lambdas)) newargs)) (when has-return-val (setq rval lastval - rvalever t)) + ;; rvalever t + )) )) (setq lambdas (cdr lambdas) keys (cdr keys))) (if (not found) (if (eieio-object-p (car args)) (setq rval (apply 'no-applicable-method (car args) method args) - rvalever t) + ;; rvalever t + ) (signal 'no-method-definition (list method args)))) @@ -2292,7 +2294,7 @@ ;; Now loop through all occurrences forms which we must execute ;; (which are happily sorted now) and execute them all! - (let* ((rval nil) (lastval nil) (rvalever nil) + (let* ((rval nil) (lastval nil) ;; (rvalever nil) (scoped-class (cdr lambdas)) (eieio-generic-call-key method-primary) ;; Use the cdr, as the first element is the fcn @@ -2305,7 +2307,8 @@ ;; No methods found for this impl... (if (eieio-object-p (car args)) (setq rval (apply 'no-applicable-method (car args) method args) - rvalever t) + ;; rvalever t + ) (signal 'no-method-definition (list method args))) @@ -2317,7 +2320,8 @@ (setq lastval (apply (car lambdas) newargs)) (setq rval lastval - rvalever t) + ;; rvalever t + ) ) ;; Right Here... it could be that lastval is returned when @@ -2459,11 +2463,10 @@ buffer-file-name)) loc) (when fname - (when (string-match "\\.elc$" fname) + (when (string-match "\\.elc\\'" fname) (setq fname (substring fname 0 (1- (length fname))))) (setq loc (get method-name 'method-locations)) - (add-to-list 'loc - (list class fname)) + (pushnew (list class fname) loc :test #'equal) (put method-name 'method-locations loc))) ;; Now optimize the entire obarray (if (< key method-num-lists) @@ -2728,7 +2731,7 @@ "Method invoked when an attempt to access a slot in OBJECT fails.") (defmethod slot-missing ((object eieio-default-superclass) slot-name - operation &optional new-value) + _operation &optional _new-value) "Method invoked when an attempt to access a slot in OBJECT fails. SLOT-NAME is the name of the failed slot, OPERATION is the type of access that was requested, and optional NEW-VALUE is the value that was desired @@ -2761,7 +2764,7 @@ "Called if there are no implementations for OBJECT in METHOD.") (defmethod no-applicable-method ((object eieio-default-superclass) - method &rest args) + method &rest _args) "Called if there are no implementations for OBJECT in METHOD. OBJECT is the object which has no method implementation. ARGS are the arguments that were passed to METHOD. @@ -2811,7 +2814,7 @@ (defgeneric destructor (this &rest params) "Destructor for cleaning up any dynamic links to our object.") -(defmethod destructor ((this eieio-default-superclass) &rest params) +(defmethod destructor ((_this eieio-default-superclass) &rest _params) "Destructor for cleaning up any dynamic links to our object. Argument THIS is the object being destroyed. PARAMS are additional ignored parameters."