Re: EIEIO with lexical scoping

[Stefan Monnier <monnier@iro.umontreal.ca>]

> 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."