Path: utzoo!utgpu!watserv1!watmath!att!linac!pacific.mps.ohio-state.edu!zaphod.mps.ohio-state.edu!swrinde!elroy.jpl.nasa.gov!jpl-devvax!ai-jupiter!kandt
From: kandt@ai-jupiter.JPL.NASA.GOV (Kirk Kandt)
Newsgroups: comp.lang.clos
Subject: Need help with modifying slot access behavior
Keywords: PCL, metaclass, persistent objects
Message-ID: <10580@jpl-devvax.JPL.NASA.GOV>
Date: 29 Nov 90 21:19:18 GMT
Sender: news@jpl-devvax.JPL.NASA.GOV
Reply-To: kandt@AI-Cyclops.JPL.NASA.GOV
Organization: NASA/Jet Propulsion Laboratory
Lines: 113
cc: CommonLoops@Xerox.com, Common-Lisp-Object-System@Sail.Stanford.edu, wjp@risc.com

This concerns 5/22/89 Victoria PCL.  I'm running Lucid 3.0.

I have written code in CLOS to add persistence to objects.  Since
a object can point to other objects (i.e., a slot has another object
as its value) the saving/restoration of an object can involve
the saving/restoration of many objects.  Consequently, I have
decided to restore objects on demand (i.e., when they are first 
referenced) because we are saving/restoring some very large networks.

During restoration the basic strategy is to restore the root object
and then to fill every slot whose value is an object with a 
"forwarding pointer" which specifies how to restore the object. Then,
when a slot is reference which contains a forwarding pointer then
that object is restored.

I have written the following code to test the idea.  I implemented
the "Lazy-Class" metaclass to cause slot access to have a different
behavior.  Namely, that anytime an instance is created whose metaclass
is Lazy-Class any slot assigned the value of 4 will be reassigned
the value 5; in the real situation I would check if the value was a
forwarding pointer and then substitute it with the actual value.

;;; -*- Mode: Lisp; Package: Pcl; Base: 10 -*-

(In-Package 'Pcl)

;;; The Lazy-Class meta-class permits the lazy evaluation of instance
variables.  If a slot is a
;;; forwarding hash-file pointer then the actual data item is read from
a hashfile and written to
;;; the slot.

(Defclass Lazy-Class (Standard-Class)
  ()
  )

(Defun Hash-File-Pointer-P (Object)
  "Return non-nil if object is a hash-file pointer."
  (= Object 4)						    ;(Typep Object 'Hash-file-Pointer)
  )

(Defun Update-Lazy-Slot-Using-Hashfile-Pointer (Instance Slot-Name
Hash-File-Pointer)
  "Update a slot of an instance by reading an item from a hash file. 
Hash-file-pointer specifies
   a file and key."
  (Setf (Slot-Value Instance Slot-Name) 5))

(Defmethod Slot-Value-Using-Class :Around ((Class Lazy-Class) Instance
Slot-Name)
  "This cause all references to a slot to be updated correctly if the
slot contains a
   forwarding hash-file pointer."
  (Let ((Slot-Value (Call-Next-Method Class Instance Slot-Name)))
    (Cond ((Hash-File-Pointer-P Slot-Value)
	   (Update-Lazy-Slot-Using-Hashfile-Pointer Instance Slot-Name Slot-Value))
	  (T Slot-Value))))

(Defclass Kirk ()
  ((X :Initform 0 :Initarg :X :Accessor X))
  (:Metaclass Lazy-Class))

(Setq Kirk (Make-Instance 'Kirk :X 1))

;;; End.

After loading this code the following typescript occurs.

Input: (trace slot-value-using-class)
(SLOT-VALUE-USING-CLASS)
Input: (slot-value kirk 'x)
1 Enter SLOT-VALUE-USING-CLASS #<Lazy-Class KIRK 61066146> #<KIRK 55441206> X
1 Exit SLOT-VALUE-USING-CLASS 1
1
Input: (slot-value kirk 'x)
1 Enter SLOT-VALUE-USING-CLASS #<Lazy-Class KIRK 61066146> #<KIRK 61144766> X
1 Exit SLOT-VALUE-USING-CLASS 1
1
Input: (setf (slot-value kirk 'x) 4)
4
Input: (slot-value kirk 'x)
1 Enter SLOT-VALUE-USING-CLASS #<Lazy-Class KIRK 61066146> #<KIRK 61144766> X
1 Exit SLOT-VALUE-USING-CLASS 5
5
Input: (slot-value kirk 'x)
1 Enter SLOT-VALUE-USING-CLASS #<Lazy-Class KIRK 61066146> #<KIRK 61144766> X
1 Exit SLOT-VALUE-USING-CLASS 5
5
Input: (x kirk)
1 Enter SLOT-VALUE-USING-CLASS #<Lazy-Class KIRK 61066146> #<KIRK 61144766> X
1 Exit SLOT-VALUE-USING-CLASS 5
5
Input: (x kirk)
1 Enter SLOT-VALUE-USING-CLASS #<Lazy-Class KIRK 61066146> #<KIRK 61144766> X
1 Exit SLOT-VALUE-USING-CLASS 5
5
Input: (x kirk)
5
Input: (x kirk)
5
Input: 

Calling SLOT-VALUE always does the right thing; calling the X generic fn
does not.
The question is why does (X KIRK) quit calling SLOT-VALUE-USING-CLASS 
after the second time?  More importantly, how can I make sure that it
always calls SLOT-VALUE-USING-CLASS?  Or, how can I change PCL to 
generate accessors that include the COND in SLOT-VALUE-USING-CLASS :AROUND?

Any help is greatly appreciated.  Please respond to comp.lang.clos or
me directly.  Thank you.

-- Kirk Kandt