Prog. Languages

Notes for WVU cs310, Programming lanuages, Spring 2011.

Gold1 and 2:
Basic OO.

Gold3:
Intermediary OO.

Gold4:
This time, we mean it.

More of Inside GOLD (version 3)

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.

Conventions

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

Anything starting with $ 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 > is a LISP REPL command; e.g.

 > (+ 1 1)
 2

---

Load Code

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

---

Gold (v3)

Objects

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

  (defparameter *objs* nil)

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 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 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 make-precendence. Note how the precedent list s stored in :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))))

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 rget, that uses :preclist.

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

Batching Up

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

Defprop handles two kinds of properties:

• Boring old values are accessed as a dull old rget.

• Methods are handled by a new method called new-methods.

Also, at the end, we define a covenience 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 X becomes a function (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))))

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 circle-class that defines things like the area of a circle. It also defines a sub-object called 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:

• It reaches into the precedent list of the parents;

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

• Then it searchers back through the editted list, looking for the area method.

Comments

• Now, we have encapsulation.

• The syntax required to define properties is cumbersome.

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

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))))

---

More Functional Abstraction

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

Note how it does not write a defun. Instead, it creates a 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 next method that hooks into get-next. To understand the above, it is critical to understand that the lambda generated above encapsulates the 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 (next) in the above method.

---

On to Gold4

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

---

Installation

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

Execute

First load into LISP:

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

Reloads:

 > (make)

---

Author

Tim Menzies (tim@menzies.us)

---

Copyright

Share and enjoy.

This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version.

This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.

You should have received a copy of the GNU General Public License along with this program. If not, see http://www.gnu.org/licenses/.