#|=head1 More About Inside GOLD (version 3)

These pages describes more  details behing Graham's GOLD
system. Those pages (chp 17 of Graham) should be read first.

=head2 Conventions

A function named C<x%> or
C<x%%> is a preliminary version of a function that will be refined,
later.

Anything starting with C<$> is a UNIX shell command; e.g.

 $ ls
 abcd.lisp       counts.lisp     dist.lisp       macros.lisp     nb.lisp
 bounded.lisp    data.lisp       gold.lisp       make.lisp       random.lisp
 class.lisp      deftest.lisp    knn.lisp        misc.lisp       rbst.lisp

Anything starting with C<E<gt>> is a LISP REPL command; e.g.

 > (+ 1 1)
 2

=head1 Load Code

|#

 (defun make ()
   (handler-bind ((style-warning #'muffle-warning))
     (format t "% ~a~%" "gold3.lisp")
     (load "gold3.lisp")))

#|

=head1 Gold (v3)

=head2 Objects

In this version of GOLD, we store all the classes in a global
called  called C<*objs*>.

|#

 (defparameter *objs* nil)

#|

=head2 Object Parents

As before,
objects are hash tables. Parents are stored in a hash table slots.
Parents are stored as a slot content.

We define a C<setf> method for parents so that, as a side-effect
of resetting parent contents, we update the precedence lists
of all our objects.

|#

 (defun parents (obj) (gethash :parents obj))
 
 (defun (setf parents) (val obj)
  (prog1 (setf (gethash :parents obj) val)
    (make-precendence obj)))

#|

Note the use of C<prog1> in the above. The return value of
the first form is what is returned (but we do some processing afterwards
to complete the task).

Here's C<make-precendence>. Note how the precedent list s stored in 
C<:preclist>:

|#

 (defun make-precendence (obj)
   (setf (gethash :preclist obj) (precedence obj))
   (dolist (x *objs*)
     (if (member obj (gethash :preclist x))
	 (setf (gethash :preclist x) (precedence x)))))
 
 ; here's an old friend
 (defun precedence (obj)
   (labels ((traverse (x)
	      (cons x
		    (mapcan #'traverse
			    (gethash :parents x)))))
     (delete-duplicates (traverse obj))))

#|

=head2 Creating Objects

When you create objects, make a new hash-table, store it in the
objects, then set the parents.

|#

(defun obj (&rest parents)
  (let ((obj (make-hash-table)))
    (push obj *objs*)
    (setf (parents obj) parents)
    obj))

#|

Here's the new C<rget>, that uses C<:preclist>.

|#

(defun rget (prop obj)
  (dolist (c (gethash :preclist obj))
    (multiple-value-bind (val in) (gethash prop c)
      (if in (return (values val in))))))

#|

=head2 Batching Up 

Here's a macro that batches up all the processing associated
with creating a new property of an object.

C<Defprop> handles two kinds of properties:

=over 8

=item *

Boring old values are accessed as a dull old C<rget>.

=item *

Methods are handled by a new method called C<new-methods>.

=back

Also, at the end, we define a covenience C<setf> method.

|#

(defmacro defprop (name &optional meth?)
  `(progn
     ,(if meth?
	  `(defun ,name (obj &rest args)
	     (run-methods obj ',name args))
	  `(defun ,name (obj &rest args)
	     (declare (ignore args)) ; declare ignore must be first line
	     (rget ',name obj)))
     (defun (setf ,name) (val obj)
       (setf (gethash ',name obj) val))))

#|

Now we get encapsulation: any property C<X> becomes a function
C<(defun X ..)> which, internally, we will either access
as data or a lamdab body to funcall.

|#

(defun run-methods (obj name args)
  (let ((meth (rget name obj)))
    (if meth
	(apply meth obj args)
	(error "No ~A method for ~A." name obj))))

#|

=head2 Test Methods

|#

(defun !oo3 ()
  (setf *objs* nil)
  (let (circle-class grumpy-circle)
    (defprop area t)
    (defprop radius)
    (setf circle-class           (obj)
	  (area circle-class)    #'(lambda (c) (* pi (expt (radius c) 2)))
	  grumpy-circle          (obj circle-class)
	  (radius grumpy-circle) 10
	  (area grumpy-circle)
	  #'(lambda (c)
	      (format t "how dare you stereotype me!~%")
	      (funcall (some #'(lambda (x) (gethash 'area x))
			     (cdr (gethash :preclist c)))
	      c)))
    (area grumpy-circle)))

#|

The above example defines a super-object called C<circle-class>
that defines things like the area of a circle. It also defines
a sub-object called C<grumpy-circle> which is so lazy an object
that it can't even be bothered to define its own circle.
Instead, it uses the area definition from the parent object. Note
how it does:

=over 8

=item *

It reaches into the precedent list of the parents;

=item *

It pops off the current item (which is this object);

=item *

Then it searchers back through the editted list, looking
for the C<area> method.

=back 

=head2 Comments

=over 8

=item *

Now, we have encapsulation.

=item *

The syntax required to define properties is cumbersome.

=item *

The syntax required to search for methods in the parents is much
more than cumbersome.

=back

We're going to need that parent search- so we will seperate
it out in a function all of its own.

|#

(defun get-next (obj name)
  (some #'(lambda (x) (gethash name x))
	(cdr (gethash :preclist obj))))

#|

=head1 More Functional Abstraction

Here's version one of C<defmeth> (defmethod) which
we'll make better later.      

Note how it does not write a C<defun>. Instead, it
creates a C<lambda> and writes it into an object slot.

|#

(defmacro defmeth% (name obj parms &rest body)
  (let ((gobj (gensym)))
    `(let ((,gobj ,obj))
       (setf (gethash ',name ,gobj)
	     (labels ((next () (get-next ,gobj ',name)))
	       #'(lambda ,parms ,@body))))))

#|

A critical part of the above is the definition of the C<next> method
that hooks into C<get-next>. To understand the above, it is critical to
understand that the lambda generated above encapsulates the C<next>
method  of the label.

Here's how it makes life easier: 

|#

 (defparameter *circle-class* (obj))
 (defparameter  *grumpy-class* (obj *circle-class*))
 
 (defmeth% area *circle-class* (c)
	 (* pi (expt (radius c) 2)))
 
 (defmeth% area *grumpy-class* (c)
	 (format t "How dare you sterotype me!~%")
	 (funcall (next) c))
#|

Observe the use of C<(next)> in the above method.

=head1 On to Gold4

That's enough mucking around. Next time, we mean it.

=head1 Installation

=head2 Download

Source code: 

 $ wget http://unbox.org/wisp/var/timm/11/310/lisp/lib/gold3.lisp

This doco:

 $ wget http://unbox.org/wisp/var/timm/11/310/lisp/gold3.html

=head2 Execute

First load into LISP:

 > (load "gold3.lisp") ; ignore warning messages

Reloads:

 > (make)

|#