From c13cf300947c25ad5f7cdeb72a760a9e9b83487d Mon Sep 17 00:00:00 2001 From: AJ Rossini Date: Fri, 4 Jan 2008 22:09:18 +0100 Subject: [PATCH] Whitespace cleanup *self* -> *proto-self* utilities co-located with use. assoc-eq removed. If really useful, bring back, but it looks like premature optimization. --- lsobjects.lsp | 72 +++++++++++++++++++++-------------------------------------- 1 file changed, 26 insertions(+), 46 deletions(-) diff --git a/lsobjects.lsp b/lsobjects.lsp index ff7f45e..1f55adc 100644 --- a/lsobjects.lsp +++ b/lsobjects.lsp @@ -92,35 +92,28 @@ ((slots :initform (list) :type list - :accessor proto-object-slots - ) + :accessor proto-object-slots ) (methods :initform (list) :type list - :accessor proto-object-methods - ) + :accessor proto-object-methods ) (parents :initform (list) :type list - :accessor proto-object-parents - ) + :accessor proto-object-parents ) (preclist ;; precedence list :initform (list) :type list :accessor proto-object-preclist - :documentation "precedence list." - ) + :documentation "precedence list." ) (serial :initform (incf *proto-object-serial*) :type integer - :documentation "Similar idea to serial number." - ) + :documentation "Similar idea to serial number." ) (self2 :initform nil :accessor proto-self - :documentation "can we embed the global within the class structure?" - ) - )) + :documentation "can we embed the global within the class structure?" ))) ;; We denote default-ish proto-object variable names by po or po?. @@ -136,43 +129,17 @@ Returns T if X is an object, NIL otherwise. Do we really need this?" (declare (ignore depth)) (send po :print stream)) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; -;;; Utilities -;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - - ;;; AJR:FIXME:Is this going to cause issues with concurrency/threading? ;;; (need to appropriately handle interrupts). -(defvar *self* nil +(defvar *proto-self* nil "special variable to hold current value of SELF. Assign to current object that we are working with. Local to proto package. Currently working to embed within the object structure rather than a global.") -;; The waz that self works is that we try to make sure that we set +;; The way that self works is that we try to make sure that we set ;; *self* upon message entry and unset at message exit. This is a ;; good strategy provided that concurrency is not in play. -(defun get-self () - "FIXME? better as macro?." - (if (not (proto-object-p *self*)) - (error "not in a method")) - *self*) - -(defun has-duplicates (list) - "predicate: takes a list, and returns true if duplicates. -This should be simpler, right?" - (do ((next list (rest next))) - ((not (consp next)) nil) - (if (member (first next) (rest next)) (return t)))) - -(defun assoc-eq (item alist) - "Version of assoc using eq -- should be faster than regular assoc." - (declare (inline car eq)) - (dolist (i alist) - (if (eq (car i) item) (return i)))) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Predicates for Consistency Checking @@ -303,6 +270,13 @@ predecessors, so only the first position is checked." (let ((parent (check-object (first parents)))) (cons object (proto-object-preclist parent)))))) +(defun has-duplicates (list) + "predicate: takes a list, and returns true if duplicates. +This should be simpler, right? Used in next function only?" + (do ((next list (rest next))) + ((not (consp next)) nil) + (if (member (first next) (rest next)) (return t)))) + (defun check-parents (parents) "Ensure valid parents: They must be null, object, or consp without duplicates." (cond @@ -376,7 +350,7 @@ Returns a new object with parents PARENTS. If PARENTS is NIL, (defsetf slot-entry-value set-slot-entry-value) (defun find-own-slot (x slot) - (if (proto-object-p x) (assoc-eq slot (proto-object-slots x)))) + (if (proto-object-p x) (assoc slot (proto-object-slots x)))) (defun find-slot (x slot) (if (proto-object-p x) @@ -419,6 +393,12 @@ Returns a new object with parents PARENTS. If PARENTS is NIL, (error "object does not own slot ~s" slot) (error "no slot named ~s in this object" slot)))))) +(defun get-self () + "FIXME? better as macro?." + (if (not (proto-object-p *proto-self*)) + (error "not in a method")) + *proto-self*) + (defun proto-slot-value (slot) "Args: (slot) Must be used in a method. Returns the value of current objects slot @@ -444,7 +424,7 @@ named SLOT." (defsetf method-entry-method set-method-entry-method) (defun find-own-method (x selector) - (if (proto-object-p x) (assoc-eq selector (proto-object-methods x)))) ;; prev was assoc not assoc-eq + (if (proto-object-p x) (assoc selector (proto-object-methods x)))) (defun find-lsos-method (x selector) (if (proto-object-p x) @@ -502,7 +482,7 @@ named SLOT." ;; invoke the method (let ((*current-preclist* preclist) (*current-selector* selector) - (*self* object)) + (*proto-self* object)) (multiple-value-prog1 (apply method object args) #+:constrainthooks (check-constraint-hooks object selector nil))))) @@ -519,14 +499,14 @@ OBJECT and ARGS." "Args (&rest args) Funcalls next method for current selector and precedence list. Can only be used in a method." - (sendmsg *self* *current-selector* (rest *current-preclist*) args)) + (sendmsg *proto-self* *current-selector* (rest *current-preclist*) args)) (defun call-proto-method (object selector &rest args) "Args (object selector &rest args) Funcalls method for SELECTOR found in OBJECT to SELF. Can only be used in a method. Call method belonging to another object on current object." - (sendmsg *self* selector (proto-object-preclist object) args)) + (sendmsg *proto-self* selector (proto-object-preclist object) args)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; -- 2.11.4.GIT