Permalink
Browse files

Optimization: store locations of RELATIONS.

  • Loading branch information...
1 parent bf3c4e6 commit fc96e8a9bcc6701fb76a32a6a71fffc671a4788c @stassats committed Dec 21, 2012
Showing with 29 additions and 11 deletions.
  1. +7 −0 mop.lisp
  2. +22 −11 storage.lisp
View
@@ -31,6 +31,8 @@
:accessor number-of-bytes-for-slots)
(relations :initform nil
:accessor class-relations)
+ (relations-location :initform nil
+ :accessor relations-location)
(initforms :initform nil
:accessor class-initforms)
(objects :initform nil
@@ -157,6 +159,11 @@
(map 'vector #'slot-definition-initform slots))
(setf (class-relations class)
(slots-with-relations class))
+ (setf (relations-location class)
+ (slot-definition-location
+ (or (find-slot 'relations class)
+ (error "Can't find ~s slot in ~s."
+ 'relations class))))
(compute-search-key class)))
(defmethod finalize-inheritance :after ((class storable-class))
View
@@ -125,8 +125,10 @@
(lambda (class objects)
(let ((relations (class-relations class)))
(when relations
- (loop for object in objects
- do (interlink-objects-first-time object relations)))))))
+ (loop with relations-slot-loc = (relations-location class)
+ for object in objects
+ do (interlink-objects-first-time object relations
+ relations-slot-loc)))))))
(declaim (inline prepend))
(defun prepend (item list)
@@ -139,34 +141,43 @@
when (eq key indicator) return value))
(declaim (inline set-relations))
-(defun set-relations (relation object target-object)
- (let* ((relations (relations target-object))
+(defun set-relations (relation object target-object
+ relations-slot-loc)
+ (let* ((relations (standard-instance-access target-object
+ relations-slot-loc))
(list (fgetf relations relation)))
(cond (list
(prepend object list))
(relations
(prepend (list object) relations)
(prepend relation relations))
(t
- (setf (relations target-object)
+ (setf (standard-instance-access target-object
+ relations-slot-loc)
(list* relation (list object) relations))))))
-(defun link-slot-first-time (relation object target-object)
+(defun link-slot-first-time (relation object target-object
+ relations-slot-loc)
(if (and (consp relation)
(eql (car relation) :slot))
(push object (slot-value target-object (cadr relation)))
- (set-relations relation object target-object)))
+ (set-relations relation object target-object
+ relations-slot-loc)))
-(defun interlink-slots-first-time (object slot-value relation)
+(defun interlink-slots-first-time (object slot-value relation
+ relations-slot-loc)
(do-maybe-list (target slot-value)
- (link-slot-first-time relation object target)))
+ (link-slot-first-time relation object target
+ relations-slot-loc)))
-(defun interlink-objects-first-time (object relations)
+(defun interlink-objects-first-time (object relations
+ relations-slot-loc)
(loop for (loc . relation) in relations
do
(interlink-slots-first-time object
(standard-instance-access object loc)
- relation)))
+ relation
+ relations-slot-loc)))
;;; Data manipulations

0 comments on commit fc96e8a

Please sign in to comment.